File Coverage

blib/lib/Net/Proxy/Type.pm

Criterion	Covered	Total	%
statement	194	269	72.1
branch	81	174	46.5
condition	32	110	29.0
subroutine	28	31	90.3
pod	14	14	100.0
total	349	598	58.3

package Net::Proxy::Type;

use strict;
use Exporter;
use Errno qw(EWOULDBLOCK EAGAIN);
use Carp;
use IO::Socket::INET qw(:DEFAULT :crlf);
use IO::Select;

use constant {
	UNKNOWN_PROXY => 4294967296,
	DEAD_PROXY    => 0,
	HTTP_PROXY    => 1,
	SOCKS4_PROXY  => 2,
	SOCKS5_PROXY  => 4,
	HTTPS_PROXY   => 8,
	CONNECT_PROXY => 16,
};

our $VERSION = '0.08';
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(HTTP_PROXY HTTPS_PROXY CONNECT_PROXY SOCKS4_PROXY SOCKS5_PROXY UNKNOWN_PROXY DEAD_PROXY);
our %EXPORT_TAGS = (types => [qw(HTTP_PROXY HTTPS_PROXY CONNECT_PROXY SOCKS4_PROXY SOCKS5_PROXY UNKNOWN_PROXY DEAD_PROXY)]);

our $CONNECT_TIMEOUT = 5;
our $WRITE_TIMEOUT = 5;
our $READ_TIMEOUT = 5;
our $URL = 'http://www.google.com/';
our $HTTPS_URL = 'https://www.google.com/';
our $KEYWORD = 'google';
our $HTTPS_KEYWORD = 'google';
our $HTTP_VER = '1.1';
our %NAME = (
	UNKNOWN_PROXY, 'UNKNOWN_PROXY',
	DEAD_PROXY, 'DEAD_PROXY',
	HTTP_PROXY, 'HTTP_PROXY',
	HTTPS_PROXY, 'HTTPS_PROXY',
	CONNECT_PROXY, 'CONNECT_PROXY',
	SOCKS4_PROXY, 'SOCKS4_PROXY',
	SOCKS5_PROXY, 'SOCKS5_PROXY',
);

sub new
{
	my ($class, %opts) = @_;
	my $self = bless {}, $class;

	$self->{connect_timeout} = $opts{connect_timeout} || $opts{timeout} || $CONNECT_TIMEOUT;
	$self->{write_timeout} = $opts{write_timeout} || $opts{timeout} || $WRITE_TIMEOUT;
	$self->{read_timeout} = $opts{read_timeout} || $opts{timeout} || $READ_TIMEOUT;
	$self->{http_strict} = $opts{http_strict} || $opts{strict};
	$self->{https_strict} = $opts{https_strict} || $opts{strict};
	$self->{connect_strict} = $opts{connect_strict} || $opts{strict};
	$self->{socks4_strict} = $opts{socks4_strict} || $opts{strict};
	$self->{socks5_strict} = $opts{socks5_strict} || $opts{strict};
	$self->{http_ver} = $opts{http_ver} || $HTTP_VER;
	$self->{keyword} = $opts{keyword} || $KEYWORD;
	$self->{https_keyword} = $opts{https_keyword} || $HTTPS_KEYWORD;
	$self->{noauth} = $opts{noauth};
	$self->url($opts{url} || $URL);
	$self->https_url($opts{https_url} || $HTTPS_URL);

	$self;
}

foreach my $key (qw(
	connect_timeout write_timeout read_timeout http_strict https_strict
	connect_strict socks4_strict socks5_strict keyword https_keyword noauth http_ver
))
{ # generate sub's for get/set object properties using closure
	no strict 'refs';
	*$key = sub
	{
		my $self = shift;

		return $self->{$key} = $_[0] if defined $_[0];
		return $self->{$key};
	}
}

sub timeout
{ # set timeout for all operations
	my ($self, $timeout) = @_;

	$self->{connect_timeout} = $timeout;
	$self->{write_timeout} = $timeout;
	$self->{read_timeout} = $timeout;
}

sub strict
{ # set strict mode for all proxy types
	my ($self, $strict) = @_;

	$self->{http_strict} = $strict;
	$self->{https_strict} = $strict;
	$self->{connect_strict} = $strict;
	$self->{socks4_strict} = $strict;
	$self->{socks5_strict} = $strict;
}

sub url
{ # set or get url
	my $self = shift;

	if(defined($_[0])) {
		($self->{host}) = $_[0] =~ m!^http://([^:/]+)!
			or croak('Incorrect url specified. Should be http://[^:/]+');
		return $self->{url} = $_[0];
	}

	return $self->{url};
}

sub https_url
{ # set or get https url
	my $self = shift;

	if(defined($_[0])) {
		($self->{https_host}, $self->{https_pathquery}) = $_[0] =~ m!^https://([^:/]+)(/.*)?!
			or croak('Incorrect url specified. Should be https://[^:/]+(/.*)?');
		return $self->{https_url} = $_[0];
	}

	return $self->{https_url};
}

my @checkers = (
	CONNECT_PROXY, \&is_connect,
	HTTPS_PROXY, \&is_https,
	HTTP_PROXY, \&is_http,
	SOCKS4_PROXY, \&is_socks4,
	SOCKS5_PROXY, \&is_socks5
);

sub _get
{ # base get method
	my $self = shift;
	my $max  = pop;
	my ($proxyaddr, $proxyport, $checkmask);
	my @found;

	if (@_ == 3) {
		($proxyaddr, $proxyport, $checkmask) = @_;
	}
	elsif (($proxyaddr, $proxyport) = _parse_proxyaddr($_[0])) {
		$checkmask = $_[1];
	}
	elsif (@_ == 2) {
		($proxyaddr, $proxyport) = @_;
	}
	else {
		push @found, [DEAD_PROXY, 0];
		return \@found;
	}

	my ($ok, $con_time);
	for(my $i=0; $i<@checkers; $i+=2) {
		if(defined($checkmask)) {
			unless($checkers[$i] & $checkmask) {
				next;
			}
		}

		($ok, $con_time) = $checkers[$i+1]->($self, $proxyaddr, $proxyport);

		if($ok) {
			push @found, [$checkers[$i], $con_time];
			last if @found == $max;
		}
		elsif(!defined($ok)) {
			push @found, [DEAD_PROXY, 0];
			last;
		}
	}

	unless (@found) {
		push @found, [UNKNOWN_PROXY, $con_time];
	}

	return \@found;
}

sub get
{ # get proxy type
	my $self = shift;

	my $found = $self->_get(@_, 1);
	return wantarray ? @{$found->[0]} : $found->[0][0];
}

sub get_as_string
{ # same as get(), but return string
	my ($self, $proxyaddr, $proxyport, $checkmask) = @_;

	my $type = $self->get($proxyaddr, $proxyport, $checkmask);
	return $NAME{$type};
}

sub get_all
{ # get all proxy types
	my $self = shift;

	my $found = $self->_get(@_, 0);

	my $types = 0;
	my $con_time = 0;

	for my $t (@$found) {
		$types |= $t->[0];
		if ($t->[1] > $con_time) {
			$con_time = $t->[1];
		}
	}

	return wantarray ? ($types, $con_time) : $types;
}

sub get_all_as_string
{ # same as get_all(), but return string array
	my $self = shift;

	my @names = map { $NAME{$_->[0]} } @{$self->_get(@_, 0)};
	return @names;
}

sub is_http
{ # check is this http proxy
	my ($self, $proxyaddr, $proxyport) = @_;

	my ($socket, $con_time) = $self->_create_socket($proxyaddr, $proxyport)
		or return;

	# simply do http request
	unless($self->_http_request($socket)) {
		goto IS_HTTP_ERROR;
	}

	my ($buf, $rc);
	unless($self->{http_strict}) {
		# simple check. does response begins from `HTTP'?
		$rc = $self->_read_from_socket($socket, $buf, 12);
		my ($code) = $buf =~ /(\d+$)/;
		if ($code == 407 && $self->{noauth}) {
			# proxy auth required
			goto IS_HTTP_ERROR;
		}

		if(!$rc || substr($buf, 0, 4) ne 'HTTP') {
			goto IS_HTTP_ERROR;
		}
	}
	else {
		# strict check. does response header contains keyword?
		unless($self->_is_strict_response($socket, $self->{keyword})) {
			goto IS_HTTP_ERROR;
		}
	}

	$socket->close();
	return wantarray ? (1, $con_time) : 1;

	IS_HTTP_ERROR:
		$socket->close();
		return wantarray ? (0, $con_time) : 0;
}

sub is_connect
{ # check is this conenct proxy
	my ($self, $proxyaddr, $proxyport) = @_;

	my ($socket, $con_time) = $self->_create_socket($proxyaddr, $proxyport)
		or return;

	$self->_write_to_socket(
		$socket,
		'CONNECT '.$self->{host}.':80 HTTP/1.1'.CRLF.'Host: '.$self->{host}.':80'.CRLF.CRLF
	) or goto IS_CONNECT_ERROR;

	$self->_read_from_socket($socket, my $headers, CRLF.CRLF, 2000)
		or goto IS_CONNECT_ERROR;
	my ($code) = $headers =~ m!^HTTP/\d.\d (\d{3})!
		or goto IS_CONNECT_ERROR;
	if ($code == 407 && ($self->{noauth} || $self->{connect_strict})) {
		goto IS_CONNECT_ERROR;
	}
	if (($code < 200 || $code >= 300) && $code != 407) {
		goto IS_CONNECT_ERROR;
	}
	if ($self->{connect_strict}) {
		unless($self->_http_request($socket)) {
			goto IS_CONNECT_ERROR;
		}

		unless($self->_is_strict_response($socket, $self->{keyword})) {
			goto IS_CONNECT_ERROR;
		}
	}

	$socket->close();
	return wantarray ? (1, $con_time) : 1;

	IS_CONNECT_ERROR:
		$socket->close();
		return wantarray() ? (0, $con_time) : 0;
}

sub is_https
{ # check is this https proxy
	my ($self, $proxyaddr, $proxyport) = @_;

	my ($socket, $con_time) = $self->_create_socket($proxyaddr, $proxyport)
		or return;

	$self->_write_to_socket(
		$socket, 'CONNECT '.$self->{https_host}.':443 HTTP/1.1'.CRLF.'Host: '.$self->{https_host}.':443'.CRLF.CRLF
	) or goto IS_HTTPS_ERROR;

	$self->_read_from_socket($socket, my $headers, CRLF.CRLF, 2000)
		or goto IS_HTTPS_ERROR;
	my ($code) = $headers =~ m!^HTTP/\d.\d (\d{3})!
		or goto IS_HTTPS_ERROR;
	if ($code == 407 && ($self->{noauth} || $self->{https_strict})) {
		goto IS_HTTPS_ERROR;
	}
	if (($code < 200 || $code >= 300) && $code != 407) {
		goto IS_HTTPS_ERROR;
	}

	if ($self->{https_strict}) {
		require IO::Socket::SSL;
		$socket->blocking(1);

		unless (IO::Socket::SSL->start_SSL($socket, Timeout => $self->{read_timeout})) {
			goto IS_HTTPS_ERROR;
		}

		$socket->blocking(0);
		$self->_write_to_socket(
			$socket,
			'GET ' . ($self->{https_pathquery}||'/') . ' HTTP/' . $self->{http_ver} . CRLF . 'Host: ' . $self->{https_host} .
			CRLF . CRLF
		) or goto IS_HTTPS_ERROR;

		unless ($self->_is_strict_response($socket, $self->{https_keyword})) {
			goto IS_HTTPS_ERROR;
		}
	}

	$socket->close();
	return wantarray ? (1, $con_time) : 1;

	IS_HTTPS_ERROR:
		$socket->close();
		return wantarray ? (0, $con_time) : 0;
}

sub is_socks4
{ # check is this socks4 proxy
  # http://ftp.icm.edu.pl/packages/socks/socks4/SOCKS4.protocol
	my ($self, $proxyaddr, $proxyport) = @_;

	my ($socket, $con_time) = $self->_create_socket($proxyaddr, $proxyport)
		or return;

	unless($self->_write_to_socket($socket, "\x04\x01" . pack('n', 80) . inet_aton($self->{host}) . "\x00")) {
		goto IS_SOCKS4_ERROR;
	}

	my ($buf, $rc);
	$rc = $self->_read_from_socket($socket, $buf, 8);
	if(!$rc || substr($buf, 0, 1) ne "\x00" || substr($buf, 1, 1) ne "\x5a") {
		goto IS_SOCKS4_ERROR;
	}

	if($self->{socks4_strict}) {
		unless($self->_http_request($socket)) {
			goto IS_SOCKS4_ERROR;
		}

		unless($self->_is_strict_response($socket, $self->{keyword})) {
			goto IS_SOCKS4_ERROR;
		}
	}

	$socket->close();
	return wantarray ? (1, $con_time) : 1;

	IS_SOCKS4_ERROR:
		$socket->close();
		return wantarray ? (0, $con_time) : 0;
}

sub is_socks5
{ # check is this socks5 proxy
  # http://tools.ietf.org/search/rfc1928
	my ($self, $proxyaddr, $proxyport) = @_;

	my ($socket, $con_time) = $self->_create_socket($proxyaddr, $proxyport)
		or return;

	unless($self->_write_to_socket($socket, "\x05\x01\x00")) {
		goto IS_SOCKS5_ERROR;
	}

	my ($buf, $rc);
	$rc = $self->_read_from_socket($socket, $buf, 2);
	unless($rc) {
		goto IS_SOCKS5_ERROR;
	}

	my $c = substr($buf, 1, 1);
	if($c eq "\x01" || $c eq "\x02" || $c eq "\xff") {
		# this is socks5 proxy with authentification
		if($self->{noauth} || $self->{socks5_strict}) {
			goto IS_SOCKS5_ERROR;
		}
	}
	else {
		if($c ne "\x00") {
			goto IS_SOCKS5_ERROR;
		}

		unless($self->_write_to_socket($socket, "\x05\x01\x00\x01" . inet_aton($self->{host}) . pack('n', 80))) {
			goto IS_SOCKS5_ERROR;
		}

		# minimum length of response is 10
		# it is not necessarily to read whole response
		$rc = $self->_read_from_socket($socket, $buf, 10);
		if(!$rc || substr($buf, 1, 1) ne "\x00") {
			goto IS_SOCKS5_ERROR;
		}

		if($self->{socks5_strict}) {
			unless($self->_http_request($socket)) {
				goto IS_SOCKS5_ERROR;
			}

			unless($self->_is_strict_response($socket, $self->{keyword})) {
				goto IS_SOCKS5_ERROR;
			}
		}
	}

	$socket->close();
	return wantarray ? (1, $con_time) : 1;

	IS_SOCKS5_ERROR:
		$socket->close();
		return wantarray ? (0, $con_time) : 0;
}

sub _http_request
{ # do http request for some host
	my ($self, $socket) = @_;
	$self->_write_to_socket(
		$socket, 'GET ' . $self->{url} . ' HTTP/' . $self->{http_ver} . CRLF . 'Host: ' . $self->{host} . CRLF . CRLF
	);
}

sub _is_strict_response
{ # to make sure about proxy type we will read response header and try to find keyword
  # without this check most of http servers may be recognized as http proxy, because its response after _http_request() begins from `HTTP'
	my ($self, $socket, $keyword) = @_;

	$self->_read_from_socket($socket, my $headers, CRLF.CRLF, 4096)
		or return 0;
	my ($code) = $headers =~ m!HTTP/\d\.\d (\d{3})!
		or return 0;
	if ((caller(1))[3] eq __PACKAGE__.'::is_http' && $code == 407 && $self->{noauth}) {
		return 0;
	}

	return index($headers, $keyword) != -1;
}

sub _write_to_socket
{ # write data to non-blocking socket; return 1 on success, 0 on failure (timeout or other error)
	my ($self, $socket, $msg) = @_;

	local $SIG{PIPE} = 'IGNORE';

	my $selector = IO::Select->new($socket);
	my $start = time();
	while(time() - $start < $self->{write_timeout}) {
		unless($selector->can_write(1)) {
			# socket couldn't accept data for now, check if timeout expired and try again
			next;
		}

		my $rc = $socket->syswrite($msg);
		if($rc > 0) {
			# reduce our message
			substr($msg, 0, $rc) = '';
			if(length($msg) == 0) {
				# all data successfully writed
				return 1;
			}
		}
		elsif($! != EWOULDBLOCK && $! != EAGAIN) {
			# some error in the socket; will return false
			last;
		}
	}

	return 0;
}

sub _read_from_socket
{ # read $limit bytes from non-blocking socket; return 0 if EOF, undef if error, bytes readed on success ($limit)
	my ($self, $socket) = (shift, shift);
	my $num_limit;
	my $str_limit;
	if (@_ == 2) {
		$num_limit = pop;
	}
	else {
		($str_limit, $num_limit) = @_[1,2];
	}

	my $limit_idx;
	my $selector = IO::Select->new($socket);
	my $start = time();
	$_[0] = ''; # clean buffer variable like sysread() do

	while(time() - $start < $self->{read_timeout}) {
		unless($selector->can_read(1)) {
			# no data in socket for now, check is timeout expired and try again
			next;
		}

		my $rc = $socket->sysread($_[0], $num_limit, length $_[0]);
		if(defined($rc)) {
			# no errors
			if($rc > 0) {
				$num_limit -= $rc;

				if ($num_limit == 0 || (defined $str_limit && ($limit_idx = index($_[0], $str_limit)) != -1)) {
					if (defined $limit_idx && $limit_idx >= 0) {
						# cut off all after $str_limit
						substr($_[0], $limit_idx+length($str_limit)) = '';
					}
					return length($_[0]);
				}
			}
			else {
				# EOF in the socket
				return 0;
			}
		}
		elsif($! != EWOULDBLOCK && $! != EAGAIN) {
			last;
		}
	}

	return undef;
}

sub _create_socket
{ # trying to create non-blocking socket by proxy address; return valid socket on success, 0 or undef on failure
	my ($self, $proxyaddr, $proxyport) = @_;

	unless(defined($proxyport)) {
		($proxyaddr, $proxyport) = _parse_proxyaddr($proxyaddr)
			or return 0;
	}

	my $conn_start = time();
	my $socket = $self->_open_socket($proxyaddr, $proxyport)
		or return;

	return ($socket, time() - $conn_start);
}

sub _open_socket
{ # blocking open for non-blocking socket
	my ($self, $host, $port) = @_;
	my $socket = IO::Socket::INET->new(PeerHost => $host, PeerPort => $port, Timeout => $self->{connect_timeout}, Blocking => 0);

	return $socket;
}

sub _parse_proxyaddr
{ # parse proxy address like this one: localhost:8080 -> host=localhost, port=8080
	my ($proxyaddr) = @_;
	my ($host, $port) = $proxyaddr =~ /^([^:]+):(\d+)$/
		or return;

	return ($host, $port);
}

1;

__END__