Permalink
Browse files

POST/body/headers support for HTTP probe

  • Loading branch information...
1 parent 883edd1 commit 3c029e78c7b0be2b8b0f4739b025edf8ec7348a4 @cosimo committed Jan 7, 2014
Showing with 88 additions and 7 deletions.
  1. +5 −0 Changes
  2. +2 −2 dist.ini
  3. +39 −5 lib/Net/Prober/Probe/HTTP.pm
  4. +42 −0 t/http_post.t
View
@@ -1,5 +1,10 @@
Revision history for Net::Prober
+0.10 - Mon Jan 7 17:05:00 Europe/Oslo 2014
+
+ Added arbitrary HTTP method probing, with POST requests support,
+ including request body and HTTP headers.
+
0.09 - Fri Nov 29 11:03:01 Europe/Oslo 2013
Added "up_status_re" option (regular expression) to HTTP probe class,
View
@@ -2,9 +2,9 @@ name = Net-Prober
author = Cosimo Streppone <cosimo@cpan.org>
license = Perl_5
copyright_holder = Cosimo Streppone
-copyright_year = 2013
+copyright_year = 2014
-version = 0.09
+version = 0.10
[@Basic]
[PkgVersion]
@@ -15,11 +15,14 @@ sub defaults {
my %http_defaults = (
%{ $defaults },
+ headers => undef,
md5 => undef,
+ method => 'GET',
port => 80,
scheme => 'http',
url => '/',
match => undef,
+ body => undef,
up_status_re => '^[23]\d\d$',
);
@@ -36,11 +39,13 @@ sub agent {
return $ua;
}
-sub probe {
+sub _prepare_request {
my ($self, $args) = @_;
- 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));
+ my ($host, $port, $timeout, $scheme, $url, $method, $body, $headers) =
+ $self->parse_args($args, qw(host port timeout scheme url method body headers));
+
+ $method ||= "GET";
if (defined $scheme) {
if ($scheme eq 'http') {
@@ -55,13 +60,42 @@ sub probe {
}
$url =~ s{^/+}{};
-
my $probe_url = "$scheme://$host:$port/$url";
+ my @req_args = ($method, $probe_url);
+
+ if ($headers && ref $headers eq "ARRAY") {
+ my $req_headers = HTTP::Headers->new();
+ $req_headers->header(@{ $headers });
+ push @req_args, $req_headers;
+ }
+
+ if ($body) {
+ push @req_args, $body;
+ }
+
+ return HTTP::Request->new(@req_args);
+}
+
+sub probe {
+ my ($self, $args) = @_;
+
+ my ($expected_md5, $content_match, $up_status_re, $timeout) =
+ $self->parse_args($args, qw(md5 match up_status_re timeout));
+
$self->time_now();
my $ua = $self->agent();
- my $resp = $ua->get($probe_url);
+
+ if (defined $timeout && $timeout > 0) {
+ $ua->timeout($timeout);
+ }
+
+ my $req = $self->_prepare_request($args);
+
+ # Fire in the hole!
+ my $resp = $ua->request($req);
+
my $elapsed = $self->time_elapsed();
my $content = $resp->content();
my $status = $resp->code();
View
@@ -0,0 +1,42 @@
+=pod
+
+=head1 NAME
+
+t/http_post.t - Net::Prober test suite
+
+=head1 DESCRIPTION
+
+Try to probe hosts via HTTP POST requests
+
+=cut
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use LWP::Online ':skip_all';
+use Test::More tests => 3;
+
+use Net::Prober;
+use Net::Prober::Probe::HTTP;
+use URI;
+
+my $probe = Net::Prober::Probe::HTTP->new();
+my $req = $probe->_prepare_request({
+ host => 'www.altavista.com',
+ url => '/ping.html',
+ method => 'POST',
+ headers => [
+ "Content-Type" => "application/json",
+ ],
+});
+
+is $req->method, "POST";
+
+is $req->uri, "http://www.altavista.com:80/ping.html";
+
+#iag(Dumper($req->headers));
+#iag(Dumper($req));
+
+my $h = $req->headers;
+is $h->header("Content-Type"), "application/json";

0 comments on commit 3c029e7

Please sign in to comment.