summaryrefslogtreecommitdiffstats
path: root/lib/probes/Curl.pm
diff options
context:
space:
mode:
authorNiko Tyni <ntyni@iki.fi>2005-02-13 20:23:04 +0100
committerNiko Tyni <ntyni@iki.fi>2005-02-13 20:23:04 +0100
commit6d76521656e91daa160bc8019828f1b68d7aa5dc (patch)
treeaaa27615a0702942fa1606d9a5c89f0a3547467c /lib/probes/Curl.pm
parent6dba1afbe4b475a7d34f5ef867b7b37291cd1484 (diff)
downloadsmokeping-6d76521656e91daa160bc8019828f1b68d7aa5dc.tar.gz
smokeping-6d76521656e91daa160bc8019828f1b68d7aa5dc.tar.xz
Moved probes, matchers and ciscoRttMonMIB modules to lib/Smokeping.
Diffstat (limited to 'lib/probes/Curl.pm')
-rw-r--r--lib/probes/Curl.pm218
1 files changed, 0 insertions, 218 deletions
diff --git a/lib/probes/Curl.pm b/lib/probes/Curl.pm
deleted file mode 100644
index c7aaccb..0000000
--- a/lib/probes/Curl.pm
+++ /dev/null
@@ -1,218 +0,0 @@
-package probes::Curl;
-
-=head1 301 Moved Permanently
-
-This is a Smokeping probe module. Please use the command
-
-C<smokeping -man probes::Curl>
-
-to view the documentation or the command
-
-C<smokeping -makepod probes::Curl>
-
-to generate the POD document.
-
-=cut
-
-use strict;
-use base qw(probes::basefork);
-use Carp;
-
-my $DEFAULTBIN = "/usr/bin/curl";
-
-sub pod_hash {
- return {
- name => "probes::Curl - a curl(1) probe for SmokePing",
- overview => "Fetches an HTTP or HTTPS URL using curl(1).",
- description => "(see curl(1) for details of the options below)",
- authors => <<'DOC',
- Gerald Combs <gerald [AT] ethereal.com>
- Niko Tyni <ntyni@iki.fi>
-DOC
- notes => <<DOC,
-The URL to be tested used to be specified by the variable 'url' in earlier
-versions of Smokeping, and the 'host' setting did not influence it in any
-way. The variable name has now been changed to 'urlformat', and it can
-(and in most cases should) contain a placeholder for the 'host' variable.
-DOC
- see_also => "curl(1), probes::Curl(3pm) etc., http://curl.haxx.se/",
- }
-}
-
-sub probevars {
- my $class = shift;
- my $h = $class->SUPER::probevars;
- delete $h->{timeout};
- return $class->_makevars($h, {
- binary => {
- _doc => "The location of your curl binary.",
- _default => $DEFAULTBIN,
- _sub => sub {
- my $val = shift;
- return "ERROR: Curl 'binary' $val does not point to an executable"
- unless -f $val and -x _;
- return undef;
- },
- },
- });
-}
-
-sub targetvars {
- my $class = shift;
- return $class->_makevars($class->SUPER::targetvars, {
- _mandatory => [ 'urlformat' ],
- agent => {
- _doc => <<DOC,
-The "-A" curl(1) option. This is a full HTTP User-Agent header including
-the words "User-Agent:". It should be enclosed in quotes if it contains
-shell metacharacters.
-DOC
- _example => '"User-Agent: Lynx/2.8.4rel.1 libwww-FM/2.14 SSL-MM/1.4.1 OpenSSL/0.9.6c"',
- },
- timeout => {
- _doc => qq{The "-m" curl(1) option. Maximum timeout in seconds.},
- _re => '\d+',
- _example => 10,
- _default => 5,
- },
- interface => {
- _doc => <<DOC,
-The "--interface" curl(1) option. Bind to a specific interface, IP address or
-host name.
-DOC
- _example => 'eth0',
- },
- ssl2 => {
- _doc => qq{The "-2" curl(1) option. Force SSL2.},
- _example => 1,
- },
- urlformat => {
- _doc => <<DOC,
-The template of the URL to fetch. Can be any one that curl supports.
-Any occurrence of the string '%host%' will be replaced with the
-host to be probed.
-DOC
- _example => "http://%host%/",
- },
- });
-}
-
-# derived class will mess with this through the 'features' method below
-my $featurehash = {
- agent => "-A",
- timeout => "-m",
- interface => "--interface",
-};
-
-sub features {
- my $self = shift;
- my $newval = shift;
- $featurehash = $newval if defined $newval;
- return $featurehash;
-}
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = $class->SUPER::new(@_);
-
- $self->_init if $self->can('_init');
-
- $self->test_usage;
-
- return $self;
-}
-
-# warn about unsupported features
-sub test_usage {
- my $self = shift;
- my $bin = $self->{properties}{binary};
- my @unsupported;
-
- my $arghashref = $self->features;
- my %arghash = %$arghashref;
-
- for my $feature (keys %arghash) {
- if (`$bin $arghash{$feature} 1 127.0.0.1 2>&1` =~ /invalid option|usage/i) {
- push @unsupported, $feature;
- $self->do_log("Note: your curl doesn't support the $feature feature (option $arghash{$feature}), disabling it");
- }
- }
- map { delete $arghashref->{$_} } @unsupported;
-
- return;
-}
-
-sub ProbeDesc($) {
- return "HTTP, HTTPS, and FTP URLs using curl(1)";
-}
-
-# other than host, count and protocol-specific args come from here
-sub make_args {
- my $self = shift;
- my $target = shift;
- my @args;
- my %arghash = %{$self->features};
-
- for (keys %arghash) {
- my $val = $target->{vars}{$_};
- push @args, ($arghash{$_}, $val) if defined $val;
- }
- return @args;
-}
-
-# This is what derived classes will override
-sub proto_args {
- my $self = shift;
- my $target = shift;
- # XXX - It would be neat if curl had a "time_transfer". For now,
- # we take the total time minus the DNS lookup time.
- my @args = ("-o /dev/null", "-w 'Time: %{time_total} DNS time: %{time_namelookup}\\n'");
- my $ssl2 = $target->{vars}{ssl2};
- push (@args, "-2") if defined($ssl2);
- return(@args);
-
-}
-
-sub make_commandline {
- my $self = shift;
- my $target = shift;
- my $count = shift;
-
- my @args = $self->make_args($target);
- my $url = $target->{vars}{urlformat};
- my $host = $target->{addr};
- $url =~ s/%host%/$host/g;
- push @args, $self->proto_args($target);
-
- return ($self->{properties}{binary}, @args, $url);
-}
-
-sub pingone {
- my $self = shift;
- my $t = shift;
-
- my @cmd = $self->make_commandline($t);
-
- my $cmd = join(" ", @cmd);
-
- $self->do_debug("executing cmd $cmd");
-
- my @times;
- my $count = $self->pings($t);
-
- for (my $i = 0 ; $i < $count; $i++) {
- open(P, "$cmd 2>&1 |") or croak("fork: $!");
-
- # what should we do with error messages?
- while (<P>) {
- /^Time: (\d+\.\d+) DNS time: (\d+\.\d+)/ and push @times, $1 - $2;
- }
- close P;
- }
-
- # carp("Got @times") if $self->debug;
- return sort { $a <=> $b } @times;
-}
-
-1;