Implemented up_status_re for custom good health status codes

Changes

@@ -1,5 +1,16 @@
 Revision history for Net::Prober
 
+0.09 - Fri Nov 29 11:03:01 Europe/Oslo 2013
+
+    Added "up_status_re" option (regular expression) to HTTP probe class,
+      to allow custom regular expressions when matching against response HTTP
+      status to determine good health. F.ex. this allows for 404 responses to
+      be considered good health indicators (host up rather than down).
+
+    Added a "reason" value in the HTTP probe results, so you can consult it to
+      know why an HTTP probe failed. Note that this is only available for
+      HTTP probes for now.
+
 0.08 - Sat Mar  9 12:06:20 Europe/Oslo 2013
 
     Disabled log to syslog by default by popular demand.

dist.ini

@@ -2,9 +2,9 @@ name    = Net-Prober
 author  = Cosimo Streppone <cosimo@cpan.org>
 license = Perl_5
 copyright_holder = Cosimo Streppone
-copyright_year   = 2012
+copyright_year   = 2013
 
-version = 0.08
+version = 0.09
 
 [@Basic]
 [PkgVersion]

lib/Net/Prober.pm

@@ -287,6 +287,19 @@ MD5 hash. B<You can calculate the MD5 of a given URL with>:
 
 What URL to download. By default it uses C</>.
 
+=item C<up_status_re>
+
+By default, any HTTP response with status 2xx or 3xx (redirect)
+will be considered successful. However, it is also possible to specify
+your own custom regular expression instead. In this way, you can consider
+"healthy" a host that replies to your HTTP probe with a 404 (not found)
+or other status code.
+
+Example:
+
+    up_status_re => '^[234]'
+    up_status_re => '^30[12]$'
+
 =back
 
 =head3 C<icmp> probe

lib/Net/Prober/Probe/HTTP.pm

@@ -15,11 +15,12 @@ sub defaults {
 
     my %http_defaults = (
         %{ $defaults },
-        md5     => undef,
-        port    => 80,
-        scheme  => 'http',
-        url     => '/',
-        match   => undef,
+        md5          => undef,
+        port         => 80,
+        scheme       => 'http',
+        url          => '/',
+        match        => undef,
+        up_status_re => '^[23]\d\d$',
     );
 
     return \%http_defaults;
@@ -38,8 +39,8 @@ sub agent {
 sub probe {
     my ($self, $args) = @_;
 
-    my ($host, $port, $timeout, $scheme, $url, $expected_md5, $content_match) =
-        $self->parse_args($args, qw(host port timeout scheme url md5 match));
+    my ($host, $port, $timeout, $scheme, $url, $expected_md5, $content_match, $up_status_re) =
+        $self->parse_args($args, qw(host port timeout scheme url md5 match up_status_re));
 
     if (defined $scheme) {
         if ($scheme eq 'http') {
@@ -63,12 +64,35 @@ sub probe {
     my $resp = $ua->get($probe_url);
     my $elapsed = $self->time_elapsed();
     my $content = $resp->content();
-    my $good = $resp->is_redirect() || $resp->is_success();
+    my $status = $resp->code();
+
+    my $good = 0;
+    my $reason;
+
+    if (! $up_status_re || ! defined $status || ! $status) {
+        $good = $resp->is_redirect() || $resp->is_success();
+        if (! $good) {
+            $reason = "Response HTTP status code wasn't successful (2xx or 3xx)";
+        }
+    }
+    elsif ($up_status_re && defined $status) {
+        my $match_re;
+        eval {
+            $match_re = qr{$up_status_re}ms;
+        } or do {
+            Carp::croak("Invalid regex for HTTP status match '$up_status_re'\n");
+        };
+        $good = $status =~ $match_re;
+        if (! $good) {
+            $reason = "Response HTTP status code didn't match the specified regex ('$up_status_re')";
+        }
+    }
 
     if ($good and defined $expected_md5) {
         my $md5 = Digest::MD5::md5_hex($content);
         if ($md5 ne $expected_md5) {
             $good = 0;
+            $reason = "Response body MD5 sum wasn't the expected ($expected_md5)";
         }
     }
 
@@ -81,6 +105,7 @@ sub probe {
         };
         if ($content !~ $match_re) {
             $good = 0;
+            $reason = "Content didn't match the specified '$content_match' regex";
         }
     }
 
@@ -95,6 +120,7 @@ sub probe {
         : undef;
 
     $status{md5} = $md5 if $md5;
+    $status{reason} = $reason if defined $reason;
 
     if ($good) {
         return $self->probe_ok(%status);

t/http.t

@@ -13,6 +13,7 @@ Try to probe hosts via HTTP connections
 use strict;
 use warnings;
 
+use Data::Dumper;
 use LWP::Online ':skip_all';
 use Test::More tests => 7;
 
@@ -34,8 +35,8 @@ ok(exists $result->{time}
 );
 ok(exists $result->{md5}
     && $result->{md5} eq 'f5a3cf5f5891652a2b148d40fb400a84',
-    "Got the correct 'md5' value"
-);
+    "Got the correct 'md5' value")
+    or diag($result->{reason});
 
 $result = Net::Prober::probe({
     class   => 'http',
@@ -45,22 +46,24 @@ $result = Net::Prober::probe({
     timeout => 5.0,
 });
 
-ok($result->{ok});
+ok($result->{ok}) or diag($result->{reason});
 
 my $t0 = time;
 
 $result = Net::Prober::probe_http({
-    host => 'localhost',
-    port => 8433,
-    url  => '/ping.html',
+    host    => 'localhost',
+    port    => 8433,
+    url     => '/ping.html',
     timeout => 1.0,
+    # Any result will be considered successful
+    up_status_re => '^...$',
 });
 
 my $t1 = time;
 
-ok(exists $result->{ok} && $result->{ok} =~ m{^[01]$},
-    "Result status ('ok') shouldn't be a blank string"
-);
+ok(exists $result->{ok} && $result->{ok} == 1,
+    "Result should be successful because of up_status_re")
+    or diag($result->{reason});
 
 ok(($t1 - $t0) <= 2,
     "Probe of unavailable service should honor timeout"