view release on metacpan or  search on metacpan

lib/ASNMTAP/Asnmtap/Plugins/WebTransact.pm  view on Meta::CPAN

  foreach my $url_r ( @{ $self->{urls} } ) {
    if ( defined $url_r->{Timeout} ) {
      $statusTimeout = 1;
      $ua->timeout ( $url_r->{Timeout} );
      $ua->default_headers->push_header ( 'Keep-Alive' => $url_r->{Timeout} ) if ( $parms{keepAlive} );
    } elsif ( defined $statusTimeout ) {
      $statusTimeout = undef;

      if ( defined $parms{timeout} ) {
        $ua->timeout ( $parms{timeout} );
        $ua->default_headers->push_header ( 'Keep-Alive' => $parms{timeout} ) if ( $parms{keepAlive} );
      } else {
        $ua->timeout ( ${$self->{asnmtapInherited}}->timeout () );
        $ua->default_headers->push_header ( 'Keep-Alive' => ${$self->{asnmtapInherited}}->timeout () ) if ( $parms{keepAlive} );
      }
    }

    $self->{_KnownError} = undef;
    ${$self->{asnmtapInherited}}->setEndTime_and_getResponsTime ( ${$self->{asnmtapInherited}}->pluginValue ('endTime') );

    my $url = $url_r->{Url} ? $url_r->{Url} : &_next_url ($response, $response_as_content);
    my $request = $self->_make_request ( $url_r->{Method}, $url, $url_r->{Qs_var}, $url_r->{Qs_fixed}, $cgi_parm_vals_hr );
    $request->protocol ('HTTP/1.1') if ( $parms{protocol} );
    $request->proxy_authorization_basic ( $proxyUsername, $proxyPassword ) if ( defined $proxyServer && defined $proxyUsername && defined $proxyPassword );

    my $request_as_string = $request->as_string;
    print "\n", ref ($self), '::send_request: ', $request_as_string, "\n" if ( $debug );

    if ( defined $triesTiming and $triesTiming ) {
      my (@timing_tries) = ( $triesTiming =~ m<(\d+(?:\.\d+)*)>g );
      LWP::Debug::debug ('My retrial code policy is ['. join(' ', sort keys %triesCodesToDeterminate) .'].');
      LWP::Debug::debug ('My retrial timing policy is ['. $triesTiming .'].');
      my $timing_tries = 0;

      foreach my $pause_if_unsuccessful ( @timing_tries, undef ) {
        $response = $ua->request ($request);
        my $code = $response->code;
        my $message = $response->message;
        $message =~ s/\s+$//s;
        $timing_tries++;

        unless( $triesCodesToDeterminate{$code} ) { # normal case: all is well (or 404, etc)
          LWP::Debug::debug ("It returned a code ($code $message) blocking a retry");
          last;
        }

        if ( defined $pause_if_unsuccessful ) {
          LWP::Debug::debug ("It returned a code ($code $message) that'll make me retry, after $pause_if_unsuccessful seconds.");
          sleep $pause_if_unsuccessful if ( $pause_if_unsuccessful );
          $self->{_timing_tries}++;
        } else {
          LWP::Debug::debug ("I give up.  I'm returning this '$code $message' response.");
        }
      }

      print ref ($self), '::timing_tries: ', $timing_tries, " - $url\n" if ( $onDemand );
    } else {
      $response = $ua->request ($request);
    }

    if ( defined $response->content_encoding and $response->content_encoding =~ /^gzip$/i ) {
      use Compress::Zlib;
      $response_as_content = Compress::Zlib::memGunzip ( $response->content );
    } else {
      $response_as_content = $response->content;
    }

    if ( $debug >= 3 ) {
      print "\n", ref ($self), '::request: ()', "\n", $response->as_string, "\n\n";
    } elsif ( $debug >= 2 ) {
      print "\n", ref ($self), '::content: ()', "\n", $response_as_content, "\n\n";
    }

    my $responseTime = ${$self->{asnmtapInherited}}->setEndTime_and_getResponsTime ( ${$self->{asnmtapInherited}}->pluginValue ('endTime') );
    print ref ($self), '::response_time: ', $responseTime, " - $url\n" if ( $onDemand );
    ${$self->{asnmtapInherited}}->appendPerformanceData ( "'". $url_r->{Perfdata_Label} ."'=". $responseTime .'ms;;;;' ) if ( defined $url_r->{Perfdata_Label} );

    $self->_write_debugfile ( $request_as_string, $response_as_content, $debugfile, $openAppend ) if ( defined $debugfile );

    if ( $parms{fail_if_1} ) {
      unless ( $response->is_success or $response->is_redirect ) {
        my $response_as_request = $response->as_string;

        # Deal with __Can't__ from LWP.
        # Otherwise notification fails because /bin/sh is called to
        # printf '$OUTPUT' and sh cannot deal with nested quotes (eg Can't echo ''')
        $response_as_request =~ s#'#_#g;

        $returnCode = $ERRORS{CRITICAL};
        my $knownError = 0;
        my $errorMessage = "other than HTTP 200";

        for ( $response_as_request ) {
          # ***************************************************************************
          # The 500 series of Web error codes indicate an error with the Web server   *
          # ***************************************************************************

          # The server had some sort of internal error trying to fulfil the request. The client may see a partial page or error message.
          # It's a fault in the server and happens all too frequently.
          /500 Can_t connect to/       && do { $knownError = 1; $errorMessage = "500 Can't connect to ..."; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 Connect failed/         && do { $knownError = 1; $errorMessage = "500 Connect failed"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 proxy connect failed/   && do { $knownError = 1; $errorMessage = "500 Proxy connect failed"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 Server Error/           && do { $knownError = 1; $errorMessage = "500 Server Error"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 SSL negotiation failed/ && do { $knownError = 1; $errorMessage = "500 SSL negotiation failed"; $returnCode = $ERRORS{UNKNOWN}; last; };
          /500 SSL read timeout/       && do { $knownError = 1; $errorMessage = "500 SSL read timeout"; $returnCode = $ERRORS{UNKNOWN}; last; };

          /Internal Server Error/      && do { $knownError = 0; $errorMessage = "500 Internal Server Error"; $returnCode = $ERRORS{UNKNOWN}; last; };

          # Function not implemented in Web server software. The request needs functionality not available on the server
          /501 (?:No Server|Not Implemented)/ && do { $errorMessage = "501 Not Implemented"; last; };

          # Bad Gateway: a server being used by this Web server has sent an invalid response.
          # The response by an intermediary server was invalid. This may happen if there is a problem with the DNS routing tables.
          /502 (?:Bad Gateway|Server Overload)/ && do { $knownError = 1; $errorMessage = "502 Bad Gateway"; last; };

          # Service temporarily unavailable because of currently/temporary overload or maintenance.
          /503 (?:Out of Resources|Service Unavailable)/ && do { $knownError = 1; $errorMessage = "503 Service Unavailable"; last; };

          # The server did not respond back to the gateway within acceptable time period
          /504 Gateway Time-?Out/ && do { $knownError = 1; $errorMessage = "504 Gateway Timeout"; last; };