File Coverage

blib/lib/HealthCheck/Diagnostic/WebRequest.pm

Criterion	Covered	Total	%
statement	104	109	95.4
branch	41	58	70.6
condition	28	42	66.6
subroutine	16	16	100.0
pod	7	7	100.0
total	196	232	84.4

package HealthCheck::Diagnostic::WebRequest;
use parent 'HealthCheck::Diagnostic';

# ABSTRACT: Make HTTP/HTTPS requests to web servers to check connectivity
use version;
our $VERSION = 'v1.4.4'; # VERSION

use strict;
use warnings;

use Carp;
use LWP::UserAgent;
use HTTP::Request;
use Scalar::Util 'blessed';
use Time::HiRes  'gettimeofday';

sub new {
    my ($class, @params) = @_;

    my %params = @params == 1 && ( ref $params[0] || '' ) eq 'HASH'
        ? %{ $params[0] } : @params;

    my @bad_params = grep {
        !/^(  content_regex
            | id
            | label
            | no_follow_redirects
            | options
            | request
            | response_time_threshold
            | status_code
            | status_code_eval
            | tags
            | timeout
            | ua
            | url
        )$/x
    } keys %params;

    carp("Invalid parameter: " . join(", ", @bad_params)) if @bad_params;

    croak "The 'request' and 'url' parameters are mutually exclusive!"
        if $params{url} && $params{request};
    if ($params{url}) {
        # Validation for url can be added here
        $params{request} = HTTP::Request->new('GET', $params{url});
    }
    elsif ($params{request}) {
        croak "request must be an HTTP::Request" unless blessed $params{request} && $params{request}->isa('HTTP::Request');
    }
    else{
        croak "Either url or request is required";
    }

    if ($params{ua}) {
        croak "The 'ua' parameter must be of type LWP::UserAgent if provided" unless blessed $params{ua} && $params{ua}->isa('LWP::UserAgent');
        carp "no_follow_redirects does not do anything when 'ua' is provided" if $params{no_follow_redirects};
    }

    # Process and serialize the status code checker
    $params{status_code} ||= '200';
    my (@and, @or);
    foreach my $part (split qr{\s*,\s*}, $params{status_code}) {
        # Strict validation of each part, since we're throwing these into an eval
        my ($op, $code) = $part =~ m{\A\s*(>=|>|<=|<|!=|!)?\s*(\d{3})\z};

        croak "The 'status_code' condition '$part' is not in the correct format!"
            unless defined $code;
        $op = '!=' if defined $op && $op eq '!';

        unless ($op) { push @or,  '$_ == '.$code;    }
        else         { push @and, '$_ '."$op $code"; }
    }
    push @or, '('.join(' && ', @and).')' if @and;  # merge @and as one big condition into @or
    $params{status_code_eval} = join ' || ', @or;

    $params{options}        //= {};
    $params{options}{agent} //= LWP::UserAgent->_agent .
        " HealthCheck-Diagnostic-WebRequest/" . ( $class->VERSION || '0' );
    $params{options}{timeout} //= 7;    # Decided by committee
    unless ($params{ua}) {
        $params{ua} //= LWP::UserAgent->new( %{$params{options}} );
        $params{ua}->requests_redirectable([]) if $params{'no_follow_redirects'};
    }

    return $class->SUPER::new(
        label => 'web_request',
        %params,
    );
}

sub check {
    my ($self, @args) = @_;

    croak("check cannot be called as a class method")
        unless ref $self;
    return $self->SUPER::check(@args);
}

sub run {
    my ( $self, %params ) = @_;

    my ($response, $elapsed_time);
    {
        my $t1        = gettimeofday;
        $response     = $self->send_request;
        $elapsed_time = gettimeofday - $t1;
    }

    my @results;
    push @results, $self->check_status( $response );
    push @results, $self->check_response_time( $elapsed_time );
    push @results, $self->check_content( $response )
        if $results[0]->{status} eq 'OK';

    my $info = join '; ', grep { length } map { $_->{info} } @results;

    return { info => $info, results => \@results };
}

sub check_status {
    my ( $self, $response ) = @_;
    my $status;

    my $client_warning = $response->header('Client-Warning') // '';
    my $proxy_error    = $response->header('X-Squid-Error')  // '';

    # Eval the status checker
    my $success;
    {
        local $_ = $response->code;
        $success = eval $self->{status_code_eval};
    }

    # An unfortunate post-constructor die, but this would be a validation bug (ie: our fault)
    die "Status code checker eval '".$self->{status_code_eval}."' failed: $@" if $@;

    $status = $success ? 'OK' : 'CRITICAL';

    # Proxy error is an automatic failure
    $status = 'CRITICAL' if $proxy_error;

    my $info  = sprintf( "Requested %s and got%s status code %s",
        $self->{request}->uri,
        $status eq 'OK' ? ' expected' : '',
        $response->code,
    );
    $info .= " from proxy with error '$proxy_error'" if $proxy_error;
    $info .= ", expected ".$self->{status_code}      unless $status eq 'OK' || $proxy_error;

    # If LWP returned 'Internal response', the status code doesn't actually mean anything
    if ($client_warning && $client_warning eq 'Internal response') {
        $status = 'CRITICAL';
        $info   = "User Agent returned: ".$response->message;
    }

    return { status => $status, info => $info };
}

sub check_content {
    my ( $self, $response ) = @_;

    return unless $self->{content_regex};

    my $regex      = $self->{content_regex};
    my $content    = $response->content;
    my $status     = $content =~ /$regex/ ? 'OK' : 'CRITICAL';
    my $successful = $status eq 'OK' ? 'matches' : 'does not match';

    return {
        status => $status,
        info   => "Response content $successful /$regex/",
    };
}

sub check_response_time {
    my ( $self, $elapsed_time ) = @_;

    my $response_time_threshold = $self->{response_time_threshold};
    my $status = 'OK';
    $status = 'WARNING' if defined $response_time_threshold && $elapsed_time > $response_time_threshold;

    return {
        status => $status,
        info   => "Request took $elapsed_time second" . ( $elapsed_time == 1 ? '' : 's' ),
    };
}

sub send_request {
    my ( $self ) = @_;

    return $self->{ua}->request( $self->{request} );
}

1;

__END__