"Fossies" - the Fresh Open Source Software Archive

Member "pandora_server/lib/PandoraFMS/Goliat/GoliatLWP.pm" (15 Sep 2021, 12301 Bytes) of package /linux/misc/pandorafms_server-7.0NG.757.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "GoliatLWP.pm" see the Fossies "Dox" file reference documentation.

    1 ##################################################################################
    2 # Goliath Tools LWP Module
    3 ##################################################################################
    4 # Copyright (c) 2007-2021 Artica Soluciones Tecnologicas S.L
    5 # This code is not free or OpenSource. Please don't redistribute.
    6 ##################################################################################
    7 
    8 package PandoraFMS::Goliat::GoliatLWP;
    9 
   10 use PandoraFMS::Goliat::GoliatTools;
   11 
   12 use strict;
   13 use warnings;
   14 use Data::Dumper;
   15 
   16 use IO::Socket::INET6;
   17 use LWP::UserAgent;
   18 use LWP::ConnCache;
   19 use HTTP::Request::Common;
   20 use HTTP::Response;
   21 use HTML::TreeBuilder;
   22 use HTML::Element;
   23 use HTTP::Cookies;
   24 use URI::URL;
   25 use Time::Local;
   26 use Time::HiRes qw ( gettimeofday );
   27 
   28 # For IPv6 support in Net::HTTP.
   29 BEGIN {
   30     $Net::HTTP::SOCKET_CLASS = 'IO::Socket::INET6';
   31     require Net::HTTP;
   32 }
   33 
   34 # Japanese encoding support
   35 use Encode::Guess qw/euc-jp shiftjis iso-2022-jp/;
   36 
   37 require Exporter;
   38 
   39 our @ISA = ("Exporter");
   40 our %EXPORT_TAGS = ( 'all' => [ qw() ] );
   41 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
   42 our @EXPORT = qw(
   43     g_http_task
   44     @task_requests
   45     @task_reqsec
   46     @task_fails
   47     @task_time
   48     @task_end
   49     @task_sessions
   50     @task_ssec
   51     @task_get_string
   52     @task_get_content
   53     @task_session_fails
   54 );
   55 
   56 our @task_requests;
   57 our @task_reqsec;
   58 our @task_fails;
   59 our @task_time;
   60 our @task_end;
   61 our @task_sessions;
   62 our @task_ssec;
   63 our @task_get_string;
   64 our @task_get_content;
   65 our @task_session_fails;
   66 our $goliat_abort;
   67 
   68 sub parse_html ($;$)
   69 {
   70     my $p = $_[1];
   71     $p = _new_tree_maker() unless $p;
   72     $p->parse($_[0]);
   73 }
   74 
   75 
   76 sub parse_htmlfile ($;$)
   77 {
   78     my($file, $p) = @_;
   79     local(*HTML);
   80     open(HTML, $file) or return undef;
   81     $p = _new_tree_maker() unless $p;
   82     $p->parse_file(\*HTML);
   83 }
   84 
   85 sub _new_tree_maker
   86 {
   87     my $p = HTML::TreeBuilder->new(implicit_tags  => 1,
   88                        ignore_unknown => 1,
   89                        ignore_text  => 0,
   90                    'warn'        => 0,
   91                   );
   92     $p->strict_comment(1);
   93     $p;
   94 }
   95 
   96 
   97 sub g_http_task {
   98     my ( $config, $thread_id, @work_list ) = @_;
   99     my ( $ax, $bx, $cx ); # used in FOR loop
  100     my ( $ttime1, $ttime2, $ttime_tot );
  101     
  102     my $resp; # HTTP Response
  103     my $total_requests = 0;
  104     my $total_valid_requests = 0;
  105     my $total_invalid_request = 0;
  106     my $cookie_file = "/tmp/gtc_".$thread_id."_".g_trash_ascii (3);
  107     my $check_string = 1;
  108     my $get_string = "";
  109     my $get_content = "";
  110     my $get_content_advanced = "";
  111 
  112     my $ua = new LWP::UserAgent;
  113     $task_requests [$thread_id] = 0 ;
  114     $task_sessions [$thread_id] = 0 ;
  115     $task_reqsec[$thread_id] = 0;
  116     $task_fails[$thread_id] = 0;
  117     $task_session_fails[$thread_id] = 0;
  118     $task_ssec[$thread_id] = 0;
  119     $task_end[$thread_id] = 0;
  120     $task_time[$thread_id] = 0;
  121     $task_get_string[$thread_id] = "";
  122     $task_get_content[$thread_id] = "";
  123     
  124     $ua->agent($config->{"agent"});
  125     $ua->protocols_allowed( ['http', 'https'] );
  126     $ua->default_headers->push_header('pragma' => "no-cache");
  127     $ua->timeout ($config->{"timeout"});
  128     $ua->max_size($config->{"maxsize"});
  129     $ua->use_alarm($config->{"alarm"});
  130     
  131     # Disable SSL certificate host verification
  132     if ($ua->can ('ssl_opts')) {
  133         $ua->ssl_opts("verify_hostname" => 0);
  134     }
  135 
  136     # Set proxy
  137 
  138     if ($config->{'proxy'} ne ""){
  139         $ua->proxy(['http','https'], $config->{'proxy'});
  140     }
  141 
  142     # Set HTTP Proxy auth
  143     if ($config->{'auth_user'} ne "") {
  144         $ua->credentials(  
  145             $config->{'auth_server'},
  146             $config->{'auth_realm'},
  147             $config->{'auth_user'} => $config->{'auth_pass'} );
  148     }
  149 
  150     if ( -e $cookie_file){
  151         unlink ($cookie_file);
  152     }
  153     my $cookies =  HTTP::Cookies->new ('file' => $cookie_file, 'autosave' => '0');
  154     
  155     $ttime1 = Time::HiRes::gettimeofday();
  156     for ($ax = 0; $ax != $config->{'retries'}; $ax++){
  157         for ($bx = 0; $bx < $config->{"work_items"}; $bx++){
  158             if ($config->{'con_delay'} > 0){
  159                 sleep ($config->{'con_delay'});
  160             }
  161             $total_requests++;
  162             # Start to count!
  163             $check_string = 1;
  164             # Prepare parameters
  165             my $params = "";
  166             $cx = 0;
  167             while (defined($work_list[$bx]->{'variable_name'}[$cx])){
  168                 if ($cx > 0){
  169                     $params = $params."&";
  170                 }
  171                 $params = $params . $work_list[$bx]->{'variable_name'}[$cx] . "=" . $work_list[$bx]->{'variable_value'}[$cx];
  172                 $cx++;
  173             }
  174 
  175             if ( (defined($work_list[$bx]->{'http_auth_realm'})) && (defined($work_list[$bx]->{'http_auth_serverport'}))&& (defined($work_list[$bx]->{'http_auth_user'})) && (defined($work_list[$bx]->{'http_auth_pass'}))) {
  176                 if ($work_list[$bx]->{'http_auth_realm'} ne "") {
  177                     $ua->credentials(
  178                         $work_list[$bx]->{'http_auth_serverport'},
  179                         $work_list[$bx]->{'http_auth_realm'},
  180                         $work_list[$bx]->{'http_auth_user'} => $work_list[$bx]->{'http_auth_pass'} 
  181                     );
  182                 }
  183             }
  184 
  185             # GET
  186             if ($work_list[$bx]->{'type'} eq "GET"){
  187                 if ($cx > 0){
  188                     $params = $work_list[$bx]->{'url'} . "?" . $params;
  189                 } else {
  190                     $params = $work_list[$bx]->{'url'};
  191                 }
  192                 $resp = g_get_page ( $ua, $params, $work_list[$bx]->{'headers'}, $work_list[$bx]->{'debug'});
  193 
  194             # POST
  195             } elsif ($work_list[$bx]->{'type'} eq "POST") {
  196                 $resp = g_post_page ( $ua, $work_list[$bx]->{'url'}, $params, $work_list[$bx]->{'headers'}, $work_list[$bx]->{'debug'});
  197 
  198             # HEAD
  199             } else {
  200                 if ($cx > 0){
  201                     $params = $work_list[$bx]->{'url'} . "?" . $params;
  202                 } else {
  203                     $params = $work_list[$bx]->{'url'};
  204                 }
  205                 $resp = g_head_page ( $ua, $params, $work_list[$bx]->{'headers'}, $work_list[$bx]->{'debug'});
  206             }
  207 
  208             # Check for errors.
  209             if ($resp->code() == 500) {
  210                 $total_invalid_request++;
  211                 $bx = $config->{"work_items"};
  212                 $check_string=0;
  213                 last;
  214             }
  215 
  216             # Get string ?
  217             if (defined($work_list[$bx]->{'get_string'})) {
  218                 my $as_string = $resp->as_string;
  219                 my $temp = $work_list[$bx]->{'get_string'};
  220                 if ($as_string =~ m/($temp)/) {
  221                          $task_get_string[$thread_id] = $1;
  222                 }
  223             }
  224 
  225             # Get response ?
  226             if ($work_list[$bx]->{'get_content_advanced'} ne "") {
  227                 my $content = $resp->decoded_content;
  228                 my $temp = $work_list[$bx]->{'get_content_advanced'};
  229                 if ($content =~ m/$temp/) {
  230                     $task_get_content[$thread_id] = $1 if defined ($1);
  231                 }
  232             } elsif ($work_list[$bx]->{'get_content'} ne "") {
  233                 my $content = $resp->decoded_content;
  234                 my $temp = $work_list[$bx]->{'get_content'};
  235                 if ($content =~ m/($temp)/) {
  236                     $task_get_content[$thread_id] = $1;
  237                 }
  238             }
  239                          
  240             # Resource bashing
  241             if ((defined($work_list[$bx]->{'get_resources'})) && ($work_list[$bx]->{'get_resources'} == 1)){    
  242                 $total_requests = g_get_all_links ($config, $ua, $resp, $total_requests, $work_list[$bx]->{'url'}, $work_list[$bx]->{'headers'}, $work_list[$bx]->{'debug'});
  243             }
  244             
  245             # CHECKSTRING check
  246             $cx = 0;
  247             while (defined($work_list[$bx]->{'checkstring'}[$cx]))  {
  248                 my $match_string = $work_list[$bx]->{'checkstring'}[$cx];
  249                 my $as_string = $resp->as_string;
  250 
  251                 my $guess = Encode::Guess::guess_encoding($as_string);
  252                 if (ref $guess) {
  253                     $as_string = $guess->decode($as_string);
  254                 }
  255                 unless (utf8::is_utf8($match_string)) {
  256                     utf8::decode($match_string);
  257                 }
  258 
  259                 if ( $as_string =~ m/$match_string/i ){
  260                     $total_valid_requests++;
  261                 } else {
  262                     $total_invalid_request++;
  263                     $bx = $config->{"work_items"}; # Abort session remaining request
  264                     $check_string=0;
  265                 }
  266                 $cx++;
  267             }
  268 
  269             # CHECKNOTSTRING check
  270             $cx = 0;
  271             while (defined($work_list[$bx]->{'checknotstring'}[$cx]))  {
  272                 my $match_string = $work_list[$bx]->{'checknotstring'}[$cx];
  273                 my $as_string = $resp->as_string;
  274 
  275                 my $guess = Encode::Guess::guess_encoding($as_string);
  276                 if (ref $guess) {
  277                     $as_string = $guess->decode($as_string);
  278                 }
  279                 unless (utf8::is_utf8($match_string)) {
  280                     utf8::decode($match_string);
  281                 }
  282 
  283                 if ( $as_string !~ m/$match_string/i ){
  284                     $total_valid_requests++;
  285                 } else {
  286                     $total_invalid_request++;
  287                     $bx = $config->{"work_items"}; # Abort session remaining request
  288                     $check_string=0;
  289                 }
  290                 $cx++;
  291             }
  292 
  293             # Cookie carry on       
  294             if (defined ($work_list[$bx]->{'cookie'}) && $work_list[$bx]->{'cookie'} == 1){
  295                 $cookies->extract_cookies($resp);
  296                 $ua->cookie_jar($cookies);
  297             }
  298 
  299             # End just now by pressing CTRL-C or Kill Signal !
  300             #if ($goliat_abort == 1){
  301                 #$ax = $config->{'retries'};
  302                 #$bx = $config->{'items'};
  303                 #goto END_LOOP;
  304             #}
  305         } #main work_detail loop
  306         $ttime2 = Time::HiRes::gettimeofday();
  307 
  308         $ttime_tot = $ttime2 - $ttime1; # Total time for this task
  309         $task_time[$thread_id] = $ttime_tot; 
  310         $task_requests [$thread_id] = $total_requests;
  311         if ($ttime_tot > 0 ){
  312             $task_reqsec[$thread_id] = $total_requests / $ttime_tot;
  313         } else {
  314             $task_reqsec[$thread_id] = $total_requests;
  315         }
  316         $task_fails[$thread_id] = $total_invalid_request;
  317         if ($check_string == 0){
  318             $task_session_fails[$thread_id]++
  319         }
  320         $task_sessions [$thread_id]++;
  321         if ($task_sessions [$thread_id] > 0 ){
  322             $task_ssec[$thread_id]  = $ttime_tot / $task_sessions [$thread_id];
  323         } else {
  324             $task_ssec[$thread_id] = $task_sessions[$thread_id];
  325         }
  326         sleep $config->{'ses_delay'};
  327     }
  328 END_LOOP:
  329 
  330     $cookies->clear;
  331 
  332     if ( -f $cookie_file){
  333         unlink ($cookie_file);
  334     }
  335 
  336     $task_end[$thread_id] = 1;
  337 }
  338 
  339 
  340 sub g_get_all_links  {
  341     my ($config, $ua, $response, $counter, $myurl, $headers, $debug) = @_;
  342     my $html;
  343     
  344     if ($response->is_success) {
  345         $html = $response->content;
  346     } else {
  347         return $counter;
  348     }
  349     # Beware this funcion, needs to be destroyed after use it !!!
  350     my $parsed_html = parse_html($html);
  351     #$ua->conn_cache(LWP::ConnCache->new());
  352     
  353     my @url_list;
  354     my $url = "";
  355     my $link;
  356     my $full_url;
  357     
  358     for (@{ $parsed_html->extract_links( ) }) {
  359         $link=$_->[0];
  360         if (($link =~ m/.png/i) || ($link =~ m/.gif/i) || ($link =~ m/.htm/i) ||
  361              ($link =~ m/.html/i) || ($link =~ m/.pdf/i) || ($link =~ m/.jpg/i)
  362              || ($link =~ m/.ico/i)){
  363             $url = new URI::URL $link;
  364             $full_url = $url->abs($myurl);
  365             @url_list = $full_url;
  366         }
  367 
  368     }
  369     $parsed_html->delete;
  370     my $ax = 0;
  371     while ($full_url = pop(@url_list)) {
  372         g_get_page ($ua, $full_url, $headers, $debug);
  373         $counter++;
  374         $ax++;
  375         if ($ax > $config->{"max_depth"}){
  376             return $counter;
  377         }
  378     }
  379     return $counter;
  380 }
  381 
  382 sub g_get_page  {
  383     my $ua = $_[0];
  384     my $url = $_[1];
  385     my $headers = $_[2];
  386     my $debug = $_[3];
  387 
  388     my $req = HTTP::Request->new(GET => $url);
  389     $req->header('Accept' => 'text/html');
  390     while (my ($header, $value) = each %{$headers}) {
  391         $req->header($header => $value);
  392     }
  393     my $response = $ua->request($req);
  394     return $response if ($debug eq '');
  395 
  396     # Debug
  397     if (open (DEBUG, '>>', $debug . '.req')) {
  398         print DEBUG "[Goliat debug " . time () . "]\n";
  399         print DEBUG $req->as_string ();
  400         print "\n";
  401         close (DEBUG);
  402     }
  403     if (open (DEBUG, '>>', $debug . '.res')) {
  404         print DEBUG "[Goliat debug " . time () . "]\n";
  405         print DEBUG $response->as_string ();
  406         print "\n";
  407         close (DEBUG);
  408     }
  409     return $response;
  410 }
  411 
  412 sub g_head_page  {
  413     my $ua = $_[0];
  414     my $url = $_[1];
  415     my $headers = $_[2];
  416     my $debug = $_[3];
  417 
  418     my $req = HTTP::Request->new(HEAD => $url);
  419     $req->header('Accept' => 'text/html');
  420     while (my ($header, $value) = each %{$headers}) {
  421         $req->header($header => $value);
  422     }
  423     my $response = $ua->request($req);
  424     return $response if ($debug eq '');
  425 
  426     # Debug
  427     if (open (DEBUG, '>>', $debug . '.req')) {
  428         print DEBUG "[Goliat debug " . time () . "]\n";
  429         print DEBUG $req->as_string ();
  430         print "\n";
  431         close (DEBUG);
  432     }
  433     if (open (DEBUG, '>>', $debug . '.res')) {
  434         print DEBUG "[Goliat debug " . time () . "]\n";
  435         print DEBUG $response->as_string ();
  436         print "\n";
  437         close (DEBUG);
  438     }
  439     return $response;
  440 }
  441 
  442 sub g_post_page  {
  443     my $ua = $_[0];
  444     my $url = $_[1];
  445     my $content = $_[2];
  446     my $headers = $_[3];
  447     my $debug = $_[4];
  448 
  449     my $req = HTTP::Request->new(POST => $url);
  450     $req->content_type('application/x-www-form-urlencoded');
  451     $req->content ($content);
  452     while (my ($header, $value) = each %{$headers}) {
  453         $req->header($header => $value);
  454     }
  455     my $response = $ua->request($req);
  456     return $response if ($debug eq '');
  457 
  458     # Debug
  459     if (open (DEBUG, '>>', $debug . '.req')) {
  460         print DEBUG "[Goliat debug " . time () . "]\n";
  461         print DEBUG $req->as_string ();
  462         print "\n";
  463         close (DEBUG);
  464     }
  465     if (open (DEBUG, '>>', $debug . '.res')) {
  466         print DEBUG "[Goliat debug " . time () . "]\n";
  467         print DEBUG $response->as_string ();
  468         print "\n";
  469         close (DEBUG);
  470     }
  471     return $response;
  472 }
  473 
  474 # End of function declaration
  475 # End of defined Code
  476 
  477 1;
  478 __END__