package ProxyCheck;


#====================================================================#
# ProxyCheck tests a HTTP proxy by getting a given URL through it.   #
#====================================================================#


use strict;
use base qw(Class::Default);

use Validate::Net;
use IO::Socket;
use Carp;

# Globals
use vars qw($VERSION $errstr $reason $answer %DEFAULT);

$VERSION = 0.1;
$errstr = '';
$reason = '';
%DEFAULT = ();

# get version
sub getVersion {
	return $VERSION;
}


#====================================================================#
# Constructor                                                        #
#====================================================================#

sub new {
	my $class = shift;

	my $self = {};
	bless $self,$class;

	return $self;
}


#====================================================================#
# Checking                                                           #
#====================================================================#

sub check {
	my $self = shift->_self;
	my %args = @_;
	my $return;
	my $dochost;
	
	$reason = '';

	# check wether proxy address is specified
	if (!$args{proxy}) {
		return $self->setReason("Proxy address: None specified");
	}
	# check proxy address
	else {
		$return = $self->check_proxyaddress($args{proxy});
		if ($return != 1) {
			return $return;
		}
	}

	# check wether URL is specified
	if (!$args{url}) {
		return $self->setReason("URL: None specified");
	}

	# check URL
	if( $args{url} =~ m#^http://([^:/]+)(:\d+?/.*)?# ) {
		$dochost = $1;
	}
	else {
		return $self->setReason
		("URL: Doesn't comply with the pattern of a valid URL for ProxyCheck e.g. 'http://www.cpan.org/index.html'");
	}

	# do proxy check
	my $buff = $self->check_proxy(%args, dochost=>$dochost);

	if ($self->getReason()) {
		return 0;
	}
	else {
		$return = 1;
	}

	return $return;
}

sub check_proxyaddress {
	my $self = shift->_self;
	my $proxyaddress = shift;

	$reason = '';
	
	# Proxy address format
	if ($proxyaddress !~ /.*:\d{1,5}\b/) {
		return $self->setReason("Proxy address: Doesn't comply with the pattern 'host:port' e.g. 'proxy:8080'");
	}

	$proxyaddress =~ m/(.*):(\d{1,5})\b/;

	my $proxyhost = $1;

	my $proxyport = $2;

	if (!(Validate::Net->host($proxyhost) && Validate::Net->port($proxyport))) {
		return $self->setReason("Proxy address: ".Validate::Net->reason());
	}

	# Else: OK
	return 1;
}

sub check_proxy {
	my $self = shift->_self;
	my %args = @_;

	$reason = '';

  	my ($buff, $tmp, $line, $EOL);
	my ($proxy,$url,$dochost) = ($args{proxy},$args{url},$args{dochost});

  	$EOL = "\015\012";

  	my $socket=IO::Socket::INET->new(
  		PeerAddr => $proxy,
  		Proto => "tcp",
  		Timeout => 5,
  		Type => SOCK_STREAM);

	if ($@) {
		return $self->setReason("ProxyCheck: $@");
	} 

  	$tmp = <<"REQUEST";
GET $url HTTP/1.0
Referer: http://www.perl.org/
User-Agent: ProxyCheck/0.1
Host: $dochost
Pragma: no-cache
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*
Accept-Encoding: gzip
Accept-Language: en
Accept-Charset: iso-8859-1

REQUEST

  	$tmp =~ s/\n/\015\012/g;

  	select($socket); $| = 1 ; select(STDOUT);
  	print $socket $tmp;

  	while (defined($line = <$socket>)) {
     		$line =~ s#<.?>##g;
     		$buff .= "\n$line";
  	}
  
  	$buff =~ m#.+\n?#;
  	$buff = $&;
	$buff =~ s/\n//g;

	close ($socket);
  	return $self->setAnswer($buff);
}


#====================================================================#
# Message handling                                                   #
#====================================================================#

sub setAnswer {
	$answer = $_[1];
	undef;
}

sub setReason {
	$reason = $_[1];
	return 0;
}

sub getAnswer {
	return $answer;
}

sub getReason {
	return $reason;
}


1;