From 6d76521656e91daa160bc8019828f1b68d7aa5dc Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@iki.fi>
Date: Sun, 13 Feb 2005 19:23:04 +0000
Subject: Moved probes, matchers and ciscoRttMonMIB modules to lib/Smokeping.

---
 lib/probes/Curl.pm | 218 -----------------------------------------------------
 1 file changed, 218 deletions(-)
 delete mode 100644 lib/probes/Curl.pm

(limited to 'lib/probes/Curl.pm')

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;
-- 
cgit v1.2.3-24-g4f1b