package Smokeping::probes::WebProxyFilter;

=head1 301 Moved Permanently

This is a Smokeping probe module. Please use the command 

C<smokeping -man Smokeping::probes::WebProxyFilter>

to view the documentation or the command

C<smokeping -makepod Smokeping::probes::WebProxyFilter>

to generate the POD document.

=cut

use strict;
use base qw(Smokeping::probes::basefork);
use LWP::UserAgent;
use Time::HiRes qw(gettimeofday sleep);
use Carp;

my $DEFAULTINTERVAL = 1;

sub pod_hash {
	return {
		name => <<DOC,
Smokeping::probes::WebProxyFilter - tests webproxy filter performance and function.
DOC
		overview => <<DOC,
This probe tests if your filtering webproxy is working properly. Drawing from
a list of forbidden websites, it tries to establish a connection to
each one of them and registers a 'loss' when it succeeds.

If you want to test availability of a website, use the EchoPingHttp probe.
DOC
		description => <<DOC,
The probe uses the LWP::UserAgent module to retrieve a series of webpages. It
expects to get the firewalls 'site-prohibited' page. Any other response (or
a real loss) gets logged as a loss and can be used to trigger an alarm.

The probe tries to be nice to the firewall and waits at least X seconds
between starting filetransfers, where X is the value of the probe 
specific `min_interval' variable ($DEFAULTINTERVAL by default).

Many variables can be specified either in the probe or in the target definition,
the target-specific variable will override the prove-specific variable.
DOC
		authors => <<'DOC',
Tobias Oetiker <tobi@oetiker.ch> sponsored by Virtela
DOC
		bugs => <<DOC,
This probe is somewhat unortodox, since it regards the successful retrieval
of a banned webpage as a loss.
DOC
	}
}

sub ProbeDesc ($) {
        my $self = shift;  
	return sprintf("HTTP GETs");
}

sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self = $class->SUPER::new(@_);
        return $self;
}

sub pingone {
	my $self = shift;
	my $target = shift;
	my $host = $target->{addr};
	my $vars = $target->{vars};
	my $mininterval = $self->{properties}{min_interval};
	my @times;
	my $elapsed;
	my $ua = LWP::UserAgent->new;
	$ua->agent($vars->{useragent});
	$ua->timeout($vars->{timeout});
	$ua->max_size($vars->{max_size});
	my @targets = ($host, split /\s*,\s*/, $vars->{more_hosts});
	my $targcount = scalar @targets;
	my $pingcount = $self->pings($target);
	my $deny_re = $vars->{deny_re};
	if ($targcount > $self->pings($target)) {
		$self->do_log("ERROR There are more host addresses ($targcount) than ping slots ($pingcount), either increase the pings or reduce the targets.\n");
		return;
	}
	
	for (1..$pingcount) {
		if (defined $elapsed) {
			my $timeleft = $mininterval - $elapsed;
			sleep $timeleft if $timeleft > 0;
		}
		my $target = shift @targets;
		push @targets,$target;
		my $start = gettimeofday();
		my $response = $ua->get("http://$target");
		my $end = gettimeofday();
	        if ($response->is_success){
		    if ($response->content =~ /$deny_re/ism){
			    push @times,($end-$start);
		    } else {
			my $content = substr($response->content,0,80)." ...";
			$content =~ s/[\n\r]/ /g;
			$self->do_log("Warning: Problem with target $host: got unexpected content from $target: $content");
		    }
        	} else {
	            $self->do_log("Warning: Problem with target $host: got this error from $target: ".$response->status_line);
		}
        }
	return sort { $a <=> $b } @times;
}

sub probevars {
	my $class = shift;
	my $h = $class->SUPER::probevars;
	return $class->_makevars($h, {
		_mandatory => ['deny_re'],
		min_interval => {
                        _default => $DEFAULTINTERVAL,
                        _doc => "The minimum interval between each starting GETs in seconds.",
                        _re => '(\d*\.)?\d+',
			_example => '0.1'
		},
		useragent => {
			_default => "SmokePing/2.x (WebProxyFilter Probe)",
			_doc => "The web browser we claim to be, just in case the FW is interested"
		},
		maxsize => {
			_default => 2000,
			_doc => "How much of the webpage should be retrieved."
		},			
			
	});	
}
		
sub targetvars {
	my $class = shift;
	return $class->_makevars($class->SUPER::targetvars, {
		timeout => {
			_default => 2,
			_doc => "Timeout in seconds for the test complete.",
			_re => '\d+',
			_example => 2,
		},
		deny_re => {
			_doc => "Regular expression, matching the 'deny' response from the firewall",
			_example => 'Access Prohibited',
		},
		more_hosts => {
			_doc => <<DOC,
A comma separated list of banned websites to test in addition to the one
specified in the I<host> variable. The websites will be tested one after the
other in one round, this means that while normal probes do run the same test
several times in a row, this one will alter the webpage with each round.
The reason for this is, that even though we try to retrieve remote webpages,
the answer will come from the firewall every time, so we kill two birds in
one go. First we test the firewalls latency and second we make sure its
filter works properly.
DOC
			_re => '[^\s.]+(?:\.[^\s.]+)*(\s*,[^\s.]+(?:\.[^\s.]+)*)*',
			_example => 'www.playboy.com, www.our-competition.com',
		},
		
	});
}

1;
