File Coverage

blib/lib/Net/SC.pm

Criterion	Covered	Total	%
statement	33	544	6.0
branch	0	258	0.0
condition	0	136	0.0
subroutine	11	68	16.1
pod	8	52	15.3
total	52	1058	4.9

#######################################################################
#
# $Id: SC.pm,v 1.22 2009-11-14 10:18:40 gosha Exp $
#
#              Socks Chain ( TCP only )
#
# Copyright (C)  Okunev Igor [e-mail] 2002-2006
#
#      All rights reserved. This program is free software;
#      you can redistribute it and/or modify it under the
#               same terms as Perl itself.
#
########################################################################
package Net::SC;

use strict;
use vars qw( @ISA @EXPORT $VERSION );

use Fcntl qw(:DEFAULT :flock);
use Symbol;
use Config;
use Exporter;
use IO::Socket;
use MIME::Base64;

local $[ = 0;

($VERSION='$Revision: 1.21 $')=~s/^\S+\s+(\S+)\s+.*/$1/;

@ISA = qw( Exporter );

@EXPORT = qw(	socks_error

				SOCKS_GENERAL_SOCKS_SERVER_FAILURE
				SOCKS_CONNECTION_NOT_ALLOWED_BY_RUL
				SOCKS_NETWORK_UNREACHABLE
				SOCKS_HOST_UNREACHABLE
				SOCKS_CONNECTION_REFUSED
				SOCKS_TTL_EXPIRED
				SOCKS_COMMAND_NOT_SUPPORTED
				SOCKS_ADDRESS_TYPE_NOT_SUPPORTED
				SOCKS_OKAY
				SOCKS_FAILED
				SOCKS_NO_IDENT
				SOCKS_USER_MISMATCH
				SOCKS_INCOMPLETE_AUTH
				SOCKS_BAD_AUTH
				SOCKS_SERVER_DENIES_AUTH_METHOD
				SOCKS_MISSING_SOCKS_SERVER_NET_DATA
				SOCKS_MISSING_PEER_NET_DATA
				SOCKS_SOCKS_SERVER_UNAVAILABLE
				SOCKS_TIMEOUT
				SOCKS_UNSUPPORTED_PROTOCOL_VERSION
				SOCKS_UNSUPPORTED_ADDRESS_TYPE
				SOCKS_HOSTNAME_LOOKUP_FAILURE
		);

#
# òÁÓÛÉÒÅÎÎÙÅ ÓÏÏÂÝÅÎÉÑ ÏÂ ÏÛÉÂËÁÈ
#
use constant SOCKS_MSG => {
	1	=>	'general SOCKS server failure',			# SOCKS5
	2	=>	'connection not allowed by ruleset',
	3	=>	'network unreachable',
	4	=>	'host unreachable',
	5	=>	'connection refused',
	6	=>	'TTL expired',
	7	=>	'command not supported',
	8	=>	'address type not supported',
	90	=>	'okay',									# SOCKS4
	91	=>	'failed',
	92	=>	'no ident',
	93	=>	'user mismatch',
	100	=>	'incomplete auth',						# generic
	101	=>	'bad auth',
	102	=>	'server denies auth method',
	202	=>	'missing SOCKS server net data',
	203	=>	'missing peer net data',
	204	=>	'SOCKS server unavailable',
	205	=>	'timeout',
	206	=>	'unsupported protocol version',
	207	=>	'unsupported address type',
	208	=>	'hostname lookup failure'
};

#
# äÏÓÔ×ÐÎÙÅ ÐÁÒÁÍÅÔÒÙ ËÏÎÆÉÇÕÒÁÃÉÉ ÓÏËÓ ÓÅÒ×ÅÒÏ×
#
use constant SOCKS_PARAM => {
	addr				=> 1,
	port				=> 2,
	user_id				=> 3,
	user_pswd			=> 4,
	protocol_version	=> 5,

	attempt_cnt			=> 6,
	last_check_time		=> 7,

	cd					=> 8,
	addr_type			=> 9,
	listen_addr			=> 10,
	listen_port			=> 11,
	prev_user_id		=> 12
};

#
#  ëÏÄÙ ×ÏÚ×Ò×ÔÁ ÓÏËÓ ÓÅÒ×ÅÒÏ×.
#
sub SOCKS_GENERAL_SOCKS_SERVER_FAILURE		{ 1 };

sub SOCKS_CONNECTION_NOT_ALLOWED_BY_RULESET	{ 2 };

sub SOCKS_NETWORK_UNREACHABLE				{ 3 };

sub SOCKS_HOST_UNREACHABLE					{ 4 };

sub SOCKS_CONNECTION_REFUSED				{ 5 };

sub SOCKS_TTL_EXPIRED						{ 6 };

sub SOCKS_COMMAND_NOT_SUPPORTED				{ 7 };

sub SOCKS_ADDRESS_TYPE_NOT_SUPPORTED		{ 8 };

sub SOCKS_OKAY								{ 90 };

sub SOCKS_FAILED							{ 91 };

sub SOCKS_NO_IDENT							{ 92 };

sub SOCKS_USER_MISMATCH						{ 93 };

sub SOCKS_INCOMPLETE_AUTH					{ 100 };

sub SOCKS_BAD_AUTH							{ 101 };

sub SOCKS_SERVER_DENIES_AUTH_METHOD			{ 102 };

sub SOCKS_MISSING_SOCKS_SERVER_NET_DATA		{ 202 };

sub SOCKS_MISSING_PEER_NET_DATA				{ 203 };

sub SOCKS_SOCKS_SERVER_UNAVAILABLE			{ 204 };

sub SOCKS_TIMEOUT							{ 205 };

sub SOCKS_UNSUPPORTED_PROTOCOL_VERSION		{ 206 };

sub SOCKS_UNSUPPORTED_ADDRESS_TYPE			{ 207 };

sub SOCKS_HOSTNAME_LOOKUP_FAILURE			{ 208 };

#
# ëÏÎÓÔÒÕËÔÏÒ...
#
# ÷ÏÚ×ÒÁÝÁÅÔ ÓÓÙÌËÕ ÎÁ ÓÏÚÄÁÎÎÙÊ ÏÂØÅËÔ.
#
sub new {
	my ( $class, %conf ) = @_;
	my $self = bless {}, $class;
	my $key;
	local $_;

	my %def_conf = (
						CHAIN_FILE		=> $ENV{HOME} . '/.sc.conf',
						LOG_FILE		=> undef,
						TIMEOUT			=> 180,

						CHAIN_FILE_DATA	=> undef,

						CHECK_DELAY		=> 24 * 3600,

						DEBUG			=> 0x09,
						CHAIN_LEN		=> 10,
						RANDOM_CHAIN	=> 0,

						RESTORE_TYPE	=> 0,
						AUTO_SAVE		=> 0,
						LOOP_CONNECT	=> 0x02, # 0x01 - ÐÒÏ×ÅÒËÁ Socks 5
											     # 0x02 - ÐÒÏ×ÅÒËÁ Socks 4
											     # 0x04 - ÐÒÏ×ÅÒËÁ HTTP proxies
						LOG_FH			=> undef,

						SYSLOG			=> 0,

						HTTP_CLIENT		=> 'Proxy chain client $Id: SC.pm,v 1.21 2009-11-14 10:18:40 gosha Exp $',

						LOG_SOCKS_FIELD	=> [ qw( addr port user_id protocol_version ) ]
	);
	#
	# éÎÉÃÉÁÌÉÚÉÒÕÅÍ ÚÎÁÞÅÎÉÑ ÐÏ ÕÍÏÌÞÁÎÉÀ, É ÄÁÎÎÙÅ ÐÅÒÅÄÁÎÎÙÅ × ËÁÞÅÓÔ×Å
	# ÐÁÒÁÍÅÔÒÏ× ËÏÎÆÉÇÕÒÁÃÉÉ...
	#
	# ÷ÎÕÔÒÉ ÄÁÎÎÙÅ ÈÒÁÎÑÔÓÑ Ó ÐÒÅÆÉËÓÁÍÉ CFG_
	#
	foreach $key ( keys %conf ) {
		$_ = uc($key);
		if ( exists $def_conf{$_} ) {
			$self->{"CFG_$_"} = $conf{$key};
		}
	}
	foreach $key ( keys %def_conf ) {
		unless ( exists $self->{"CFG_$key"} ) {
			$self->{"CFG_$key"} = $def_conf{$key};
		}
	}
	#
	# çÏÔÏ×ÉÍ ÍÅÓÔÏ ÄÌÑ ÄÁÎÎÙÈ ÉÚ ÆÁÊÌÁ ËÏÎÆÉÇÕÒÁÃÉÉ
	#
	undef $self->{CFG_CHAIN_DATA};

	unless ( defined $self->configure( 'TIMEOUT' ) ) {
		$self->configure( TIMEOUT => 0 );
	}
	#
	# åÓÌÉ ÕÓÔÁÎÏ×ÌÅÎÁ ÐÅÒÅÍÅÎÎÁÑ SYSLOG ÔÏ ÌÏÇ ÐÉÛÅÔÓÑ ÞÅÒÅÚ:
	# *nix - syslogd,
	# win32 - eventlog,
	# ÉÎÁÞÅ ÅÓÌÉ ×ÏÚÍÏÖÎÏ ÏÔËÒÙ×ÁÅÍ LOG ÆÁÊÌ, ÔÁË ÖÅ ÍÏÖÎÏ ÎÁÐÒÑÍÕÀ ÐÅÒÅÄÁÔØ
	# ÄÅÓËÒÉÐÔÏÒ ÆÁÊÌÁ  × LOG_FH, ÎÏ ÔÏÇÄÁ ÎÁÄÏ ÞÔÏÂ LOG_FILE ÂÙÌ undef...
	#
	if ( $self->configure( 'SYSLOG' ) ) {
		if ( $^O =~ /[Ww]in32/ ) {
			require Win32::EventLog;

			$self->configure( 'LOG_FH' => Win32::EventLog->new( 'sc45', '' ) );

			unless ( defined $self->configure( 'LOG_FH' ) ) {
					$self->configure( SYSLOG => 0 );
					$self->log_error( "Cannot open EventLog:" . Win32::GetLastError() );
			}
		} else {
			require Sys::Syslog;
			import  Sys::Syslog qw(:DEFAULT setlogsock );

			if ( $^O ne 'solaris' && $^O ne 'freebsd' &&
					eval { &Sys::Syslog::_PATH_LOG() } ) {

				unless ( defined setlogsock( 'unix' ) ) {
					$self->configure( SYSLOG => 0 );
					$self->log_error("Can't `setlogsock' : $!");
				}
			}
			if ( not defined openlog( 'sc45', 'cons,pid', 'daemon') ) {
				$self->configure( SYSLOG => 0 );
				$self->log_error("Can't `openlog' : $!");
			}
		}
	} elsif ( defined $self->configure( 'LOG_FILE' ) ) {
		$key = gensym;
		$self->configure( LOG_FH => $key );
		if ( open ( $key , '>>' . $self->configure( 'LOG_FILE' ) ) ) {
			select((select($key), $| = 1)[0]);
		} else {
			$self->configure( LOG_FH => undef );
			$self->log_error("Can't open file " . $self->configure('LOG_FILE') ." : $!");
			ungensym $key;
		}
	}

	return $self;
}

#
# þÉÔÁÅÔ/ÕÓÔÁÎÁ×ÌÉ×ÁÅÔ ÐÅÒÅÍÅÎÎÙÅ ÉÚ 'ËÏÎÆÉÇÕÒÁÃÉÏÎÎÏÇÏ ÈÅÛÁ'
# ( ÔÏÔ ËÏÔÏÒÙÊ CFG_... )
# åÓÌÉ ÚÁÄÁÎÏ 2 ÁÒÇÕÍÅÎÔÁ ÔÏ ÕÓÔÁÎÁ×ÌÉ×ÁÅÔÓÑ ÐÅÒÅÍÅÎÎÁÑ
# Ó ÉÍÅÎÅÍ `ÐÅÒ×ÙÊ ÁÒÇÕÍÅÎÔ' × ÚÎÁÞÅÎÉÅ `×ÔÏÒÏÊ ÁÒÇÕÍÅÎÔ',
# É ×ÏÚ×ÒÁÝÁÅÔ ÄÁÎÎÏÅ ÚÎÁÞÅÎÉÅ.
# åÓÌÉ ÚÁÄÁÎ ÏÄÉÎ ÁÒÇÕÍÅÎÔ ÔÏ ×ÏÚ×ÒÁÝÁÅÔ ÐÅÒÅÍÅÎÎÕÀ Ó
# ÉÍÅÎÅÍ `ÐÅÒ×ÙÊ ÁÒÇÕÍÅÎÔ'...
#
sub configure {
	my ( $self, $section, $var ) = @_;
	local $_;

	unless ( exists $self->{ 'CFG_' . uc($section) } ) {
		$self->log_error("Use unknown configuration variable : `$section'");
		return undef;
	} elsif ( uc($section) eq 'CHAIN_DATA' and (caller)[0] ne __PACKAGE__ ) {
		#
		# íÁÌÅÎØËÁÑ ËÕÞËÁ ÓÏÌÏÍËÉ, ÏÔ ÉÚÍÅÎÅÎÉÑ ÄÁÎÎÙÈ ËÏÎÆÉÇÕÒÁÃÉÏÎÎÏÇÏ ÆÁÊÌÁ...
		#
		return $self->{ 'CFG_' . uc($section) };
	} else {
		if ( scalar @_ > 2 ) {
			$self->{ 'CFG_' . uc($section) } = $var;
		}
		return $self->{ 'CFG_' . uc($section) };
	}
}

#
# óÏÅÄÉÎÅÎÉÅ Ó ÕÄÁÌÅÎÎÏÊ ÍÁÛÉÎÏÊ ÞÅÒÅÚ socks ÃÅÐØ.
#
# îÕ ÜÔÏ ×ÒÏÄÅ ËÁË ÐÒÏÓÔÏ ÏÂÅÒÔËÁ ÄÌÑ create_chain,
# ÐÌÀÓ Á×ÔÏÍÁÔÉÞÅÓËÏÅ ÞÔÅÎÉÅ ËÏÎÆÉÇÏ×.
#
# ÷ÏÚ×ÒÁÝÁÅÔ SOCKS_OK ÅÓÌÉ ×ÓÅ OK
#
sub connect {
	my ( $self, $peer_host, $peer_port ) = @_;
	my $rc;
	local $_;

	unless ( defined $self->configure( 'CHAIN_DATA' ) ) {
		unless ( ( $rc = $self->read_chain_data ) == SOCKS_OKAY ) {
			return $rc;
		}
		if ( $self->configure( 'AUTO_SAVE' ) ) {
			$self->restore_cfg_data;
		}
	}

	$rc = $self->create_chain( $peer_host, $peer_port, 1 );

	if ( $self->configure( 'AUTO_SAVE' ) ) {
		$self->dump_cfg_data;
	}

	return $rc;
}

#
# õÓÔÁÎÏ×ËÁ Ó×ÑÚÉ ÄÌÑ ÐÒÉÎÑÔÉÑ ÓÏÅÄÉÎÅÎÉÊ ÞÅÒÅÚ socks ÃÅÐØ.
#
# îÕ ÜÔÏ ×ÒÏÄÅ ËÁË ÐÒÏÓÔÏ ÏÂÅÒÔËÁ ÄÌÑ create_chain,
# ÐÌÀÓ Á×ÔÏÍÁÔÉÞÅÓËÏÅ ÞÔÅÎÉÅ ËÏÎÆÉÇÏ×.
#
# ÷ÏÚ×ÒÁÝÁÅÔ SOCKS_OK ÅÓÌÉ ×ÓÅ OK
#
sub bind {
	my ( $self, $peer_host, $peer_port ) = @_;
	my $rc;
	local $_;

	unless ( defined $self->configure( 'CHAIN_DATA' ) ) {
		unless ( ( $rc = $self->read_chain_data ) == SOCKS_OKAY ) {
			return $rc;
		}
		if ( $self->configure( 'AUTO_SAVE' ) ) {
			$self->restore_cfg_data;
		}
	}

	$rc = $self->create_chain( $peer_host, $peer_port, 2 );

	if ( $self->configure( 'AUTO_SAVE' ) ) {
		$self->dump_cfg_data;
	}

	return $rc;
}

#
# öÄÅÔ ÓÏÅÄÉÎÅÎÉÅ ÕÄÁÌÅÎÎÏÊ ÍÁÛÉÎÙ, ÞÅÒÅÚ ÃÅÐÏÞËÕ
# Socks ÓÅÒ×ÅÒÏ×.
#
sub accept {
	my $self = shift;
	local $_;

	if ( $self->socks_param( 'protocol_version' ) == 4 ) {
		return $self->get_resp4;
	} elsif ( $self->socks_param('protocol_version') == 5 ) {
		return $self->get_resp5;
	} else {
		return SOCKS_UNSUPPORTED_PROTOCOL_VERSION;
	}
}

#
# ÷ÏÚ×ÒÁÝÁÅÔ ÓÏËÅÔ ÃÅÐÏÞËÉ socks'Ï×
#
sub sh {
	my $self = shift;

	return $self->{sock_h};
}

#
# úÁËÒÙ×ÁÅÔ ÓÏÅÄÉÎÅÎÉÅ ÞÅÒÅÚ socks ÃÅÐØ.
#
sub close {
	my $self = shift;

	$self->sh->shutdown(2);

	$self->sh->close;

	undef $self->{sock_h};
}

#
# ÷ÏÚ×ÒÁÝÁÅÔ ÐÁÒÁÍÅÔÒÙ ÓÅÁÎÓÁ ÒÁÂÏÔÙ ÐÏÓÌÅÄÎÅÇÏ socks ÓÅÒ×ÅÒÁ
#
# ÷ÏÚÍÏÖÎÙÅ ÐÁÒÁÍÅÔÒÙ : listen_addr, listen_port, proxy_id, etc...
#
# ÐÒÉ ÏÔÓÕÔÓÔ×ÉÉ $param ×ÏÚ×ÒÁÝÁÅÔ ÓÓÙÌËÕ ÎÁ ÈÅÛ ÓÏ ×ÓÅÍÉ
# ÉÍÅÀÝÉÍÉÓÑ ÐÁÒÁÍÅÔÒÁÍÉ...
#
# åÓÌÉ ÎÅ ÚÁÄÁÎ $id ÔÏ ÂÅÒÕÔÓÑ ÄÁÎÎÙÅ Ï ÐÏÓÌÅÄÎÅÍ socks ÓÅÒ×ÅÒÅ ÃÅÐÏÞËÉ...
#
# ðÒÉ ÕÓÔÁÎÏ×ÌÅÎÎÏÍ $value ÐÁÒÁÍÅÔÒ param ÕÓÔÁÎÁ×ÌÉ×ÁÅÔÓÑ ×
# ÄÁÎÎÏÅ ÚÎÁÞÅÎÉÅ.
#
sub socks_param {
	my ( $self, $param, $value, $id ) = @_;
	local $_;

	unless ( defined $id ) {
		$id = $self->{__last_socks};
	}
	unless ( defined $id ) {
		return undef;
	} elsif ( not defined $param ) {
		return $self->configure( 'CHAIN_DATA' )->[ $id ];
	} elsif ( not exists SOCKS_PARAM->{$param} ) {
		$self->log_error("Use unknown socks parameter: `$param'");
		return undef;
	} elsif ( defined $value ) {
		return $self->configure( 'CHAIN_DATA' )->[ $id ]->{$param} = $value;
	} elsif ( not exists $self->configure( 'CHAIN_DATA' )->[ $id ]->{$param} ) {
		return undef;
	} else {
		return $self->configure( 'CHAIN_DATA' )->[ $id ]->{$param};
	}
}

#
# ÷Ù×ÏÄÉÔ ÔÅËÓÔÏ×ÏÅ ÓÏÏÂÝÅÎÉÅ × ÓÏÏÔ×ÅÔÓÔ×ÕÀÝÅÅ ËÏÄÕ ×ÏÚ×ÒÁÔÁ
# socks ÓÅÒ×ÅÒÁ.
#
sub socks_error {
	if ( defined $_[0] ) {
		return SOCKS_MSG->{$_[0]} || $_[0];
	} else {
		return undef;
	}
}

#
# þÉÔÁÅÔ ËÏÎÆÉÇ ÄÌÑ ÍÏÄÕÌÑ Net::SC. æÏÒÍÁÔ:
#
# #host           :   port    : uid   :   pswd    : socks_proto
# 192.168.1.90    :   1080    :       :           :   5
#
# ÷ ËÁÞÅÓÔ×Å ËÏÍÍÅÎÔÁÒÉÅ× ÉÓÐÏÌØÚÕÅÔÓÑ `#' × ÎÁÞÁÌÅ ÓÔÒÏËÉ,
# ÐÕÓÔÙÅ ÓÔÒÏËÉ ÐÒÏÐÕÓËÁÀÔÓÑ. äÁÎÎÙÅ ÚÁÐÉÓÙ×ÁÀÔÓÑ × ÍÁÓÓÉ×
# CFG_CHAIN_DATA, ËÏÔÏÒÙÊ ÓÏÓÔÏÉÔ ÉÚ ÓÓÙÌÏË ÎÁ ÈÅÛ ×ÉÄÁ:
#   0  addr				- ÉÍÑ socks ÓÅÒ×ÅÒÁ
#   1  port				- ÐÏÒÔ socks ÓÅÒ×ÅÒÁ
#   2  user_id			- ÐÏÌØÚÏ×ÁÔÅÌØ socks
#   3  user_pswd		- ÐÁÒÏÌØ ÐÏÌØÚÏ×ÁÔÅÌÑ socks
#   4  protocol_version	- ÐÒÏÔÏËÏÌ socks ÓÅÒ×ÅÒÁ ( 4 ÉÌÉ 5 ÉÌÉ 0 (ÄÌÑ http) )
#   5  last_check_time	- ×ÒÅÍÑ ÐÏÓÌÅÄÎÅÊ ÐÒÏ×ÅÒËÉ ÓÅÒ×ÅÒÁ ( unixtime )
#   6  attempt_cnt		- ËÏÌÉÞÅÓÔ×Ï ÎÅÕÄÁÞÎÙÈ ÐÒÏ×ÅÒÏË ( 1 - ×ÓÅ ÏË )
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
# ó ×ÅÒÓÉÉ 1.17 ÔÁËÖÅ ÍÏÖÎÏ ÏÔËÁÚÁÔØÓÑ ÏÔ ÞÔÅÎÉÑ ÄÁÎÎÙÈ ÉÚ ËÏÎÆÉÇÕÒÁÃÉÏÎÎÏÇÏ
# ÆÁÊÌÁ ( new( CHAIN_FILE_DATA => [ 'str1', .., 'strN' ] ) )
# ÇÄÅ strX - ÓÔÒÏËÁ × ÆÏÒÍÁÔÅ ÏÐÉÓÁÎÎÏÍ ×ÙÛÅ...
#
sub read_chain_data {
	my $self = shift;
	local $_;

	$self->configure( CHAIN_DATA => [] );

	my @data;

	if ( defined $self->configure( 'CHAIN_FILE_DATA' ) and
		 ref $self->configure( 'CHAIN_FILE_DATA' ) eq 'ARRAY' ) {

		 @data = @{ $self->configure( 'CHAIN_FILE_DATA' ) };
	} else {
		my $sym = gensym;

		unless ( open($sym, '<' . $self->configure( 'CHAIN_FILE' ) ) ) {
			$self->log_error("Can't open file " . $self->configure( 'CHAIN_FILE' ) ." : $!");
			return SOCKS_FAILED;
		}

		my_flock ( $sym, LOCK_SH );

		@data = <$sym>;

		CORE::close $sym;

		ungensym $sym;
	}

	chomp @data;

	for my $line ( 0 .. $#data ) {

		next if $data[$line] =~ /^#/ || $data[$line] =~ /^\s*$/;

		my ( $socks_host, $socks_port,
			$socks_user, $socks_pswd, $socks_proto ) = split( /\s*:\s*/, $data[$line] );

		unless ( defined $socks_host and length $socks_host ) {
			$self->log_error( "Parse config: host name not defined [ $line ]" );
			next;
		}
		unless ( defined $socks_port and $socks_port > 0 ) {
			$self->log_error( "Parse config: bad number port [ $line ]" );
			next;
		}
		unless (	defined $socks_proto and
					length( $socks_proto ) and
					( $socks_proto == 4 or $socks_proto == 5 or $socks_proto == 0 ) ) {

			$socks_proto = 5;
		}
		unless ( defined $socks_user ) {
			$socks_user = '';
		}
		unless ( defined $socks_pswd ) {
			$socks_pswd = '';
		}
		push @{$self->configure( 'CHAIN_DATA' )}, {
						addr				=> $socks_host,
						port				=> $socks_port,
						user_id				=> $socks_user || '',
						user_pswd			=> $socks_pswd || '',
						protocol_version	=> $socks_proto,
						last_check_time		=> 0,
						attempt_cnt			=> 0 };
	}

	if ( scalar @{$self->configure( 'CHAIN_DATA' )} ) {
		return SOCKS_OKAY;
	} else {
		$self->log_error('Configuration file is empty');
		return SOCKS_FAILED;
	}
}

#
# ÷ÏÚ×ÒÁÝÁÅÔ ËÏÌÉÞÅÓÔ×Ï Socks ÓÅÒ×ÅÒÏ× Ó `ÎÅÐÒÏÓÒÏÞÅÎÎÙÍ'
# ×ÒÅÍÅÎÅÍ ÐÏÌØÚÏ×ÁÎÉÑ, Ô.Å. ÎÅ `ÏÔÄÙÈÁÀÝÉÈ' ÐÏ ÔÁÊÍÁÕÔÕ
# × Ó×ÑÚÉ Ó ÎÅÄÏÓÔÕÐÎÏÓÔØÀ
#
sub get_socks_count {
	my $self = shift;
	local $_;

	unless ( defined $self->configure( 'CHAIN_DATA' ) ) {
		return 0;
	} else {
		return scalar ( grep {
					$self->socks_param( 'last_check_time', undef, $_ ) + ( $self->configure( 'CHECK_DELAY' ) * $self->socks_param( 'attempt_cnt', undef, $_ ) ) < time
				} ( 0 .. $#{$self->configure( 'CHAIN_DATA' )} ) );
	}
}

#
# ðÏÍÅÞÁÅÔ ÐÒÏËÓÉ Ó ÐÏÒÑÄËÏ×ÙÍ ÎÏÍÅÒÏÍ × ËÏÎÆÉÇÅ $id ËÁË ×ÒÅÍÅÎÎÏ
# ÎÅÄÏÓÔÕÐÎÙÊ ÎÁ CHECK_DELAY * ëïìéþåóô÷ï_îåõäáþîùè_ëïîîåëôï÷ ÓÅËÕÎÄ -
# ÅÓÌÉ $status != SOCKS_OKAY, ÉÎÁÞÅ ÏÞÉÝÁÅÔ ÓÞÅÔÞÉË ÎÅÕÄÁÞÎÙÈ ÐÏÐÙÔÏË...
#
# åÓÌÉ ×ÓÅ ÎÏÒÍÁÌØÎÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub mark_proxy {
	my ( $self, $id, $status ) = @_;
	local $_;

	unless ( defined $self->configure( 'CHAIN_DATA' ) and defined $id ) {
		unless ( defined $id ) {
			$self->log_error('Socks identifer not defined');
		} else {
			$self->log_error('Configuration data not defined...');
		}
		return SOCKS_FAILED;
	}

	if ( $status == SOCKS_OKAY ) {
		$self->socks_param( 'last_check_time', time - 1, $id );
		$self->socks_param( 'attempt_cnt', 0, $id );
	} else {
		$self->socks_param( 'last_check_time', time, $id );
		$self->socks_param( 'attempt_cnt', ( $self->socks_param( 'attempt_cnt' ) || 0 ) + 1, $id );
	}

	return SOCKS_OKAY;
}

#
# óÂÒÁÓÙ×ÁÅÔ ÔÅËÕÝÅÅ ÓÏÓÔÏÑÎÉÅ ÄÁÎÎÙÈ Ï Socks ÓÅÒ×ÅÒÁÈ ÉÚ ËÏÎÆÉÇÁ ×
# ÈÅÛ ÆÁÊÌ, ÎÁ ÄÉÓËÅ. éÓÐÏÌØÚÕÅÔÓÑ ÄÌÑ ÐÏÓÌÅÄÕÀÝÅÇÏ ×ÏÓÓÔÁÎÏ×ÌÅÎÉÑ
# ÄÁÎÎÙÈ Ï `ÄÏÈÌÙÈ' ÓÅÒ×ÅÒÁÈ
#
# åÓÌÉ ×ÓÅ ÎÏÒÍÁÌØÎÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub dump_cfg_data {
	my $self = shift;
	my ( $sym, %hash, $id, $key );
	local $_;

	unless ( defined $self->configure( 'CHAIN_DATA' ) ) {
		return SOCKS_OKAY;
	}

	unless ( dbmopen ( %hash, $self->configure( 'CHAIN_FILE' ) . '-cache', 0600 ) ) {
		$self->log_error("Can't create dump hash : $!");
		return SOCKS_FAILED;
	}
	$sym = gensym;
	#
	# ÷ ËÁÞÅÓÔ×Å ÌÏË ÆÁÊÌÁ - ÉÓÐÏÌØÚÕÅÍ ÔÅËÓÔÏ×Ù ËÏÎÆÉÇÕÒÁÃÉÏÎÎÙÊ ÆÁÊÌ
	#
	unless ( open( $sym, '<'. $self->configure( 'CHAIN_FILE' ) ) ) {
		$self->log_error("Can't open file " . $self->configure( 'CHAIN_FILE' ) . " : $!");
		dbmclose %hash;
		return SOCKS_FAILED;
	}
	my_flock ( $sym, LOCK_EX );

	foreach $id ( 0 .. $#{$self->configure( 'CHAIN_DATA' )} ) {
		$key = join( "\x00",	$self->configure( 'CHAIN_DATA' )->[$id]->{addr},
								$self->configure( 'CHAIN_DATA' )->[$id]->{port},
								$self->configure( 'CHAIN_DATA' )->[$id]->{user_id} || '',
								$self->configure( 'CHAIN_DATA' )->[$id]->{user_pswd} || '',
								$self->configure( 'CHAIN_DATA' )->[$id]->{protocol_version}
					);
		unless ( defined $hash{$key} ) {
			$hash{$key} = join( "\x00", $self->dump_cfg_filter( %{$self->configure( 'CHAIN_DATA' )->[$id]} ) );
		}
	}
	dbmclose %hash;
	CORE::close $sym;
	ungensym $sym;

	return SOCKS_OKAY;
}

#
# þÉÔÁÅÔ ÄÁÎÎÙÅ ÚÁÐÉÓÁÎÎÙÅ ÎÁ ÄÉÓË ÐÒÏÃÅÄÕÒÏÊ dump_cfg_data
#
# äÁÎÎÙÅ ÈÒÁÎÑÔÓÑ × .db ÆÁÊÌÅ Ó ÉÍÅÎÅÍ ÉÄÅÎÔÉÞÎÙÍ ÉÍÅÎÉ ËÏÎÆÉÇÁ + '-cache',
# ÎÏ Ó ÄÏÂÁ×ÌÅÎÎÙÍ ÒÁÓÛÉÒÅÎÉÅÍ .db ( ÉÌÉ .pag & .dir Õ ËÏÇÏ ËÁË )
#
# åÓÌÉ ×ÓÅ × ÐÏÒÑÄËÅ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub restore_cfg_data {
	my $self = shift;
	my ( $sym, %hash, %hash2, $id, $key );
	local $_;

	unless ( defined $self->configure( 'CHAIN_DATA' ) ) {
		return SOCKS_OKAY;
	}

	unless ( dbmopen ( %hash, $self->configure( 'CHAIN_FILE' ) . '-cache', 0600 ) ) {
		$self->log_error("Can't open damp hash : $!");
		return SOCKS_FAILED;
	}
	#
	# ðÕÓÔÏÊ ÆÁÊÌ ( ÔÏÌØËÏ ÞÔÏ ÓÏÚÄÁÎÎÙÊ )
	#
	if ( scalar keys %hash == 0 ) {
		dbmclose %hash;
		return SOCKS_OKAY;
	}

	$sym = gensym;
	#
	# ÷ ËÁÞÅÓÔ×Å ÌÏË ÆÁÊÌÁ - ÉÓÐÏÌØÚÕÅÍ ÔÅËÓÔÏ×Ù ËÏÎÆÉÇÕÒÁÃÉÏÎÎÙÊ ÆÁÊÌ
	#
	unless ( open( $sym, '<'. $self->configure( 'CHAIN_FILE' ) ) ) {
		$self->log_error("Can't open file " . $self->configure( 'CHAIN_FILE' ) . " : $!");
		dbmclose %hash;
		return SOCKS_FAILED;
	}
	my_flock ( $sym, LOCK_SH );

	#
	# óÏÚÄÁÅÍ ËÌÀÞÉ É ÓÏÏÔ×ÅÔÓÔ×ÕÀÝÉÅ ÉÍ ÉÎÄÅËÓÙ
	#
	foreach $id ( 0 .. $#{$self->configure( 'CHAIN_DATA' )} ) {
		$key = join( "\x00",	$self->configure( 'CHAIN_DATA' )->[$id]->{addr},
								$self->configure( 'CHAIN_DATA' )->[$id]->{port},
								$self->configure( 'CHAIN_DATA' )->[$id]->{user_id} || '',
								$self->configure( 'CHAIN_DATA' )->[$id]->{user_pswd} || '',
								$self->configure( 'CHAIN_DATA' )->[$id]->{protocol_version}
					);
		#
		# íÏÖÅÔ ÂÙÔØ ÎÅÓËÏÌØËÏ ÏÄÉÎÁËÏ×ÙÈ ÓÅÒ×ÅÒÏ× × ËÏÎÆÉÇÅ...
		#
		push @{$hash2{ $key }}, $id;
	}

	#
	# ÷ÏÓÓÔÁÎÁ×ÌÉ×ÁÅÍ ÚÎÁÞÅÎÉÑ ÉÚ ËÜÛÁ
	#
	foreach $key ( keys %hash ) {
		if ( not exists $hash2{$key} and $self->configure( 'RESTORE_TYPE' ) == 1 ) {
			delete $hash{$key};
		} else {
			foreach $id ( @{$hash2{$key}} ) {
				$self->configure( 'CHAIN_DATA' )->[$id] = { $self->dump_cfg_filter( split(/\x00/, $hash{$key}) ) };
			}
		}
	}
	dbmclose %hash;
	CORE::close $sym;
	ungensym $sym;

	return SOCKS_OKAY;
}

#
# ðÒÏ×ÅÒÑÅÔ ÄÁÎÎÙÅ ÐÏÄÌÅÖÁÝÉÅ ËÅÛÉÒÏ×ÁÎÉÀ ÎÁ ÎÁÌÉÞÉÅ \x00 É \n,
# ÐÒÏ×ÅÒÑÅÔ ËÏÒÒÅËÔÎÏÓÔØ ÉÓÐÏÌØÚÕÅÍÙÈ ÐÁÒÁÍÅÔÒÏ× ÄÌÑ socks_param
#
# òÁÚÂÏÒ Ó ÐÏÍÏÝØÀ ÍÁÓÓÉ×Á Á ÎÅ ÈÅÛÁ ÓÄÅÌÁÎ ÄÌÑ ×ÏÚÍÏÖÎÏÓÔÉ
# ÉÓÐÏÌØÚÏ×ÁÎÉÑ ×ÎÅÛÎÅÊ ÓÏÒÔÉÒÏ×ËÉ ËÌÀÞÅÊ.
#
# ÷ÏÚ×ÒÁÝÁÅÔ ÐÒÏ×ÅÒÅÎÎÙÊ ÍÁÓÓÉ× ÜÌÅÍÅÎÔÏ×
#
sub dump_cfg_filter {
	my $self = shift;
	my ( $key, $val, @param );
	local $_;

	while ( defined ( $key = shift @_ ) ) {
		$val = shift;

		next unless exists SOCKS_PARAM->{$key};

		unless ( defined $val ) {
			push @param, $key, '';
		} else {
			$val =~ s#[\x00\n]##g;
			push @param, $key, $val;
		}
	}
	return @param;
}

#
# óÏÚÄÁÅÔ ÃÅÐÏÞËÕ Socks ÓÅÒ×ÅÒÏ× ÄÏ/ÄÌÑ ÈÏÓÔÁ $peer_host É ÐÏÒÔÁ $peer_port
# $type - ÔÉÐ ÓÅÒ×ÉÓÁ : 1 - connect
#                     : 2 - bind
#
# äÏ ÉÓÐÏÌØÚÏ×ÁÎÉÑ ÄÁÎÎÏÊ ÐÒÏÃÅÄÕÒÙ ÄÏÌÖÅÎ ÂÙÔØ ÐÒÏÞÉÔÁÎ ËÏÎÆÉÇÕÒÁÃÉÏÎÎÙÊ
# ÆÁÊÌ.
#
# åÓÌÉ ×ÓÅ Ok ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub create_chain {
	my ( $self, $peer_host, $peer_port, $type ) = @_;
	my ( $host_ind, $rc );
	my ( @hosts_id );
	local $_;

	unless ( defined $self->configure( 'CHAIN_DATA' ) ) {
		$self->log_error('Configuration data not defined...');
		return SOCKS_FAILED;
	} elsif ( not defined $peer_host or not defined $peer_port ) {
		$self->log_error('Destination host or destination addr not defined...');
		return SOCKS_MISSING_PEER_NET_DATA;
	} elsif ( not defined $type or ( $type != 1 and $type != 2 ) ) {
		return SOCKS_COMMAND_NOT_SUPPORTED;
	} elsif ( $self->configure( 'CHAIN_LEN' ) < 1 ) {
		$self->log_error('Length of chain very small...');
		return SOCKS_FAILED;
	} elsif ( $self->configure( 'RANDOM_CHAIN' ) > 0 ) {
		#
		# Random select proxies
		#
  	    @hosts_id = ( grep {
							$self->socks_param( 'last_check_time', undef, $_ ) + ( $self->configure( 'CHECK_DELAY' ) * $self->socks_param( 'attempt_cnt', undef, $_ ) ) < time
						} ( sort { rand(10) <=> rand(10) } ( 0 .. $#{$self->configure( 'CHAIN_DATA' )} ) ) );
	} else {
		#
		# Select proxies in order definition
		#
  	    @hosts_id = ( grep {
							$self->socks_param( 'last_check_time', undef, $_ ) + ( $self->configure( 'CHECK_DELAY' ) * $self->socks_param( 'attempt_cnt', undef, $_ ) ) < time
						} ( 0 .. $#{$self->configure( 'CHAIN_DATA' )} ) );
	}

	CHAIN:{
		if ( defined $self->sh ) {
			$self->close;
		}

		if ( scalar @hosts_id < $self->configure( 'CHAIN_LEN' ) ) {
			$self->log_error("Can't create socks chain, many servers not response...");
			return SOCKS_FAILED;
		}

		#
		# Connect to first socks/HTTP proxy
		#
		$self->{__last_socks} = $hosts_id[0];
		unless ( $self->first_connect == SOCKS_OKAY ) {
			shift @hosts_id;
			redo CHAIN;
		}

		for ( $host_ind = 0; $host_ind <= $#hosts_id; $host_ind++ ) {
			#
			# Last proxy identifier...
			#
			$self->{__last_socks} = $hosts_id[$host_ind];

			last if $host_ind >= $self->configure( 'CHAIN_LEN' ) - 1;

			#
			# Check proxies for connection ( create loop connection )
			#
			if ( $self->socks_param( 'protocol_version' ) == 5 and $self->configure( 'LOOP_CONNECT' ) & 0x01 ) {
				$rc = $self->request_socks5( 1,
						$self->socks_param('addr',undef,$hosts_id[$host_ind]),
						$self->socks_param('port',undef,$hosts_id[$host_ind]));
			} elsif ( $self->socks_param( 'protocol_version' ) == 0 and $self->configure( 'LOOP_CONNECT' ) & 0x04 ) {
				$rc = $self->request_http( 1,
						$self->socks_param('addr',undef,$hosts_id[$host_ind]),
						$self->socks_param('port',undef,$hosts_id[$host_ind]));
			} elsif ( $self->socks_param( 'protocol_version' ) == 4 and $self->configure( 'LOOP_CONNECT' ) & 0x02 ) {
				$rc = $self->request_socks4( 1,
						$self->socks_param('addr',undef,$hosts_id[$host_ind]),
						$self->socks_param('port',undef,$hosts_id[$host_ind]));
			} else {
				$rc = SOCKS_OKAY;
			}

			#
			# LoopCheck failed
			#
			unless ( $rc == SOCKS_OKAY ) {
				$self->mark_proxy( $self->{__last_socks}, $rc );

				if ( $self->configure( 'DEBUG' ) & 0x01 ) {
					$self->debug( "Socks error[$rc]: " . $self->log_str( $self->{ __last_socks }) );
				}
				if ( $self->configure( 'DEBUG' ) & 0x08 ) {
					$self->debug( '            [ ' . ( socks_error($rc) ) . ' ]' );
				}
				splice( @hosts_id, $host_ind, 1);

				redo CHAIN;
			}

			#
			# Create connection to next proxy server
			#
			if ( $self->socks_param( 'protocol_version' ) == 5 ) {
				$rc = $self->request_socks5( 1,
							$self->socks_param('addr',undef,$hosts_id[$host_ind+1]),
							$self->socks_param('port',undef,$hosts_id[$host_ind+1]));
			} elsif ( $self->socks_param( 'protocol_version' ) == 0 ) {
				$rc = $self->request_http( 1,
							$self->socks_param('addr',undef,$hosts_id[$host_ind+1]),
							$self->socks_param('port',undef,$hosts_id[$host_ind+1]));
			} else {
				$rc = $self->request_socks4( 1,
							$self->socks_param('addr',undef,$hosts_id[$host_ind+1]),
							$self->socks_param('port',undef,$hosts_id[$host_ind+1]));
			}

			$self->mark_proxy( $self->{__last_socks}, $rc );

			unless ( $rc == SOCKS_OKAY ) {
				if ( $self->configure( 'DEBUG' ) & 0x01 ) {
					$self->debug( "Socks error[$rc]: " . $self->log_str( $hosts_id[$host_ind+1] ) );
				}
				if ( $self->configure( 'DEBUG' ) & 0x08 ) {
					$self->debug( '            [ ' . ( socks_error($rc) ) . ' ]' );
				}
				splice( @hosts_id, $host_ind+1, 1);
				redo CHAIN;
			}
		}
	}

	if ( $host_ind < $self->configure( 'CHAIN_LEN' ) - 1 ) {
		$self->log_error("Can't create socks chain, many servers not response...");
		return SOCKS_FAILED;
	}

	#
	# Create connectino to destination addr/port
	#
	if ( $self->socks_param( 'protocol_version' ) == 5 ) {
		$rc = $self->request_socks5( $type, $peer_host, $peer_port );
	} elsif ( $self->socks_param( 'protocol_version' ) == 0 ) {
		$rc = $self->request_http( $type, $peer_host, $peer_port  );
	} else {
		$rc = $self->request_socks4( $type, $peer_host, $peer_port  );
	}

	$self->mark_proxy( $self->{__last_socks}, $rc );

	return $rc;
}

#
# ðÒÏÃÅÄÕÒÁ ÂÌÏËÉÒÏ×ËÉ ÆÁÊÌÏ×, Ó ÕÞÅÔÏÍ ÐÒÏ×ÅÒËÉ ÎÁ ×ÏÚÍÏÖÎÏÓÔÉ ÓÉÓÔÅÍÙ...
#
sub my_flock {
	my ( $fh, $mode ) = @_;

	return 1 unless defined $Config::Config{d_flock};

	flock ( $fh, $mode );
}

#
# éÓÐÏÌØÚÕÅÔÓÑ ÄÌÑ ÏÔÌÁÄËÉ - ÐÒÉ ÉÓÐÏÌØÚÏ×ÁÎÉÉ SYSLOG'Á ÓÏÏÂÝÅÎÉÑ ÐÉÛÕÔÓÑ
# × `debug', ÅÓÌÉ syslog ÎÅ ÐÏÌØÚÕÅÔÓÑ ÔÏ ×ÙÚÙ×ÁÅÔÓÑ log_error...
#
sub debug {
	my $self = shift;

	#
	# syslogd
	#
	if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
		foreach ( @_ ) {
			syslog( 'debug', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
		}
		return 1;
	}
	#
	# ÷ÓÅ ÏÓÔÁÌØÎÏÅ
	#
	return log_error( $self, @_);
}

#
# ðÉÛÅÔ ÓÏÏÂÝÅÎÉÑ Ï ÏÛÉÂËÁÈ × log ÆÁÊÌ ÉÌÉ ÐÅÒÅÄÁÅÔ syslogd.
# íÏÖÎÏ ÂÙÌÏ ËÏÎÅÞÎÏ Carp.pm ÐÏÌØÚÏ×ÁÔØ, ÎÏ ÐÒÉ×ÙÞËÁ...
#

sub log_error {
	my $self = shift;
	my $sym;
	local $_;

	if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
		#
		# syslogd
		#
		foreach ( @_ ) {
			syslog( 'warning', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
		}
	} elsif (	ref $self and
				$self->configure( 'SYSLOG' ) and
				defined $self->configure( 'LOG_FH' ) ) {
		#
		# eventlog
		#
		$self->configure('LOG_FH')->Report( {
				Category	=> 20,
				EventType	=> Win32::EventLog::EVENTLOG_INFORMATION_TYPE(),
				Strings		=> join( "\n", '', @_ ),
				Data		=> '',
				EventID		=> 0
		} );
	} else {
		#
		# write co STDERR
		#
		unless ( ref $self ) {
			unshift @_, $self;
			$sym = \*STDERR;
		} elsif ( not defined ( $sym = $self->configure( 'LOG_FH' ) ) ) {
				$sym = \*STDERR;
		}
		my_flock ( $sym, LOCK_EX );
		foreach ( @_ ) {
			printf $sym "%2.2d/%2.2d %2.2d:%2.2d:%2.2d [ %5.5d : %d ] : %s\n",(localtime(time))[3,4,2,1,0], $$, (caller)[-1], $_ unless /^\s*$/;
		}
		my_flock ( $sym, LOCK_UN );
	}

	return 1;
}

#
# ÷ÏÚ×ÒÁÝÁÅÔ ÌÏÇ ÓÔÒÏËÕ Ï ÓÏÅÄÉÎÅÎÉÉ id...
#
sub log_str {
	my ( $self, $id ) = @_;
	my $str;
	local $_;

	$str = '';

	foreach ( @{$self->configure('LOG_SOCKS_FIELD')} ) {
		if ( defined $self->socks_param( $_, undef, $id ) ) {
			$str .= ' : ' . $self->socks_param( $_, undef, $id );
		} else {
			$str .= ' : ';
		}
	}

	return substr $str, 3;
}

#
# ðÒÏÉÚ×ÏÄÉÔ ËÏÎÎÅËÔ × `ÏÔËÒÙÔÕÀ' Ë ÐÅÒ×ÏÍÕ socks ÓÅÒ×ÅÒÕ.
#
# åÓÌÉ ×ÓÅ Ok ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub first_connect {
	my $self = shift;
	local $_;

	$self->{sock_h} = new IO::Socket::INET (
			PeerAddr	=> $self->socks_param( 'addr' ),
			PeerPort	=> $self->socks_param( 'port' ),
			Timeout		=> $self->configure( 'TimeOut' ),
			Proto		=> 'tcp'
		);

	unless ( defined $self->sh ) {
		$self->log_error( $@, "Can't create network socket... : $!" );
		return SOCKS_FAILED;
	}

	binmode $self->sh;

	$self->sh->autoflush(1);

	return SOCKS_OKAY;
}

#
# þÉÔÁÅÔ ÄÁÎÎÙÅ ÉÚ ÓÏËÅÔÁ $fh1. $fh2 ÍÏÖÅÔ ÂÙÔØ ËÁË ÓÓÙÌËÏÊ ÎÁ ÓÏËÅÔ
# ÔÁË É ÓÓÙÌËÏÊ ÎÁ ÓËÁÌÑÒ, ÄÌÑ ÐÅÒ×ÏÇÏ ÓÌÕÞÁÑ ÄÏÌÖÎÏ ÂÙÔØ ÏÐÒÅÄÅÌÅÎÏ
# ÚÎÁÞÅÎÉÅ $cnt. åÓÌÉ $fh2 ÓÓÙÌËÁ ÎÁ ÓÏËÅÔ ( ÆÁÊÌÏ×ÙÊ ÄÅÓËÒÉÐÔÏÒ )
# ÔÏ ÄÁÎÎÙÅ ÞÉÔÁÀÔÓÑ ÄÏ 'ËÏÎÃÁ' ÉÚ $fh1 É ÐÉÛÕÔÓÑ × $fh2
#
# ÷ÏÚ×ÒÁÝÁÅÔ  0 - ÐÒÉ ÔÁÊÍÁÕÔÅ
#            -1 - ÐÒÉ ÞÔÅÎÉÉ 0 ÂÁÊÔ
#             1 - ×ÓÅ Ok
sub read_data {
	my ( $self, $fh1, $fh2, $cnt ) = @_;
	my ( $char, $rc, $rin );
	local $_ = 1;

	unless ( defined $cnt ) {
		$cnt = 0;
	}

	vec( $rin = '', fileno( $fh1 ), 1 ) = 1;

	$rc = eval {
		local $SIG{__DIE__}	= sub { die @_ };
		local $SIG{PIPE}	= sub { die "Pipe error\n" };
		if ( ref $fh2 eq 'SCALAR' ) {
			$$fh2 = '';

			#
			# HTTP proxies support
			#
			my $is_http_proxy = 0;
			$is_http_proxy = 1 if $self->socks_param('protocol_version') == 0;

			#
			# \r\n\r\n - for http proxies support
			#
			while( $_ && ($is_http_proxy ? $$fh2 !~ /\r\n\r\n$/ : $cnt-- ) ) {
				unless ( select( $rin, undef, undef, $self->configure( 'TimeOut' ) ) ) {
					die "Read data - timeout\n";
				}
				$_ = sysread( $fh1, $char, 1 );
				$$fh2 .= $char;
			}
		} else {
			while ( $_ ) {
				unless ( select( $rin, undef, undef, $self->configure( 'TimeOut' ) ) ) {
					die "Read data - timeout\n";
				}
				$_ = sysread( $fh1, $char, 1 );
				print $fh2 $char;
			}
		}
	};

	unless ( defined $rc ) {
		if ( $@ eq "Read data - timeout\n" ) {
			$self->log_error( 'Timeout...' );
			return 0;
		} else {
			$self->log_error( $@ );
			return 0;
		}
	}

	if ( $_ < 1 ) {
		return -1;
	} elsif ( ref $fh2 eq 'SCALAR' and $self->configure( 'DEBUG' ) & 0x02 ) {
		$self->debug('READ: ' . unpack('H*', $$fh2) );
	}
	return 1;
}

#
# ðÉÛÅÔ ÄÁÎÎÙÅ @data × ÓÏËÅÔ $fh ( ÓÏËÅÔ ×ÒÏÄÅ ËÁË FH Socks ÓÅÒ×ÅÒÁ )
#
# ÷ÏÚ×ÒÁÝÁÅÔ 1 - ×ÓÅ Ok
#            0 - ËÁËÉÅ ÔÏ ÐÒÏÂÌÅÍÙ...
#
sub print_data {
	my ( $self, $fh, @data ) = @_;
	my $rc;
	local $_;

	$rc = eval {
		local $SIG{__DIE__}	= sub { die @_ };
		local $SIG{PIPE}	= sub { die "Pipe error\n" };

		print $fh @data;
	};

	unless ( defined $rc ) {
		$self->log_error( $@ || 'Print data error...' );
		return 0;
	} else {
		if ( $self->configure( 'DEBUG' ) & 0x04 ) {
			$self->debug('WRITE: ' . unpack('H*', join('', @data) ) );
		}
		return 1;
	}
}

#
# úÁÐÒÏÓ Ë 4 ÓÏËÓÕ...
#
# req_num - ÔÉÐ ÚÁÐÒÏÓÁ Ë socks ÓÅÒ×ÅÒÕ:
#     1 - connect
#     2 - bind
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub request_socks4 {
	my ( $self, $req_num, $peer_host, $peer_port ) = @_;
	local $_;

	#
	# Print debug message
	#
	if ( $self->configure( 'DEBUG' ) & 0x01 ) {
		$self->debug( 'Connect over socks4: ' . $self->log_str( $self->{__last_socks}) . ", to $peer_host:$peer_port" );
	}

	$self->print_data( $self->sh,
			pack ( 'CCn', 4, $req_num, $peer_port ),
			inet_aton( $peer_host ),
			$self->socks_param( 'user_id' ),
			pack 'x' );

	return $self->get_resp_socks4;
}

#
# úÁÐÒÏÓ Ë 5 ÓÏËÓÕ...
#
# req_num - ÔÉÐ ÚÁÐÒÏÓÁ Ë socks ÓÅÒ×ÅÒÕ:
#     1 - connect
#     2 - bind
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub request_socks5 {
	my ( $self, $req_num, $peer_host, $peer_port ) = @_;
	local $_;

	#
	# Print debug message
	#
	if ( $self->configure( 'DEBUG' ) & 0x01 ) {
		$self->debug( 'Connect over socks5: ' . $self->log_str( $self->{__last_socks}) . ", to $peer_host:$peer_port" );
	}

	#
	# Check socks5 auth
	#
	unless ( ( my $rc = $self->socks5_auth ) == SOCKS_OKAY ) {
		$self->close;
		return $rc;
	}

	my $addr_type;

	if ( $peer_host =~ /[a-zA-Z]/) {	# FQDN?
		$addr_type = 3;
		$peer_host = pack('C',length( $peer_host )) . $peer_host;
	} else {									# nope.  Must be dotted-dec.
		$addr_type = 1;
		$peer_host = inet_aton( $peer_host );
	}

	$self->print_data( $self->sh,
			pack ( 'CCCC', 5, $req_num, 0, $addr_type ),
			$peer_host,
			pack( 'n', $peer_port ) );

	return $self->get_resp_socks5;
}

#
# Request to HTTP proxies
#
# req_num - ÔÉÐ ÚÁÐÒÏÓÁ Ë socks ÓÅÒ×ÅÒÕ:
#     1 - connect
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub request_http {
	my ( $self, $req_num, $peer_host, $peer_port ) = @_;
	local $_;

	#
	# Print debug message
	#
	if ( $self->configure( 'DEBUG' ) & 0x01 ) {
		$self->debug( 'Connect over http: ' . $self->log_str( $self->{__last_socks}) . ", to $peer_host:$peer_port" );
	}

	#
	# bind command not support in http proxies...
	#
	if ( $req_num == 2 ) {
		return SOCKS_COMMAND_NOT_SUPPORTED;
	}

	my $CRLF = "\015\012";

	my @headers = (	"CONNECT $peer_host:$peer_port HTTP/1.1",
					'User-Agent: ' . $self->configure( 'Http_Client' ),
					'Proxy-Connection: keep-alive' );

	#
	# Basic authorization
	#
	if (	length ( $self->socks_param( 'user_id' ) ) > 0 and
			length ( $self->socks_param( 'user_pswd' ) ) > 0 ) {

			push @headers,	'Proxy-Authorization: ' .
							'Basic ' .
							MIME::Base64::encode(
								$self->socks_param( 'user_id' )
									. ':' .
								$self->socks_param( 'user_pswd' ), ''
							);
	}

	$self->print_data( $self->sh, join( $CRLF, @headers, '', '' ) );

	return $self->get_resp_http;
}

#
# áÕÔÅÎÔÉÆÉËÁÃÉÑ ÄÌÑ 5 ÓÏËÓÁ...
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub socks5_auth {
	my ( $self ) = @_;
	my ( $status, $method, $received, $ver );
	local $_;

	$method = pack('C', 0);
	$status = 0;
	if (	length ( $self->socks_param( 'user_id' ) ) > 0 and
			length ( $self->socks_param( 'user_pswd' ) ) > 0 ) {

		$method .= pack('C', 2);
	}

	$self->print_data( $self->sh,
			pack ('CC', 5, length($method) ),
			$method );

	$received = '';

	if ( ! $self->read_data($self->sh, \$received, 2) or length($received) < 2 ) {
		return SOCKS_TIMEOUT;
	}

	( $ver, $method ) = unpack 'CC', $received;
	if ( $ver != 5) {
		return SOCKS_UNSUPPORTED_PROTOCOL_VERSION
	}
	if ( $method == 255 ) {
		return SOCKS_SERVER_DENIES_AUTH_METHOD
	}
	if ( $method == 2 and (
				length ( $self->socks_param( 'user_id' ) ) == 0 or
				length ( $self->socks_param( 'user_pswd' ) ) == 0 ) ) {

		return SOCKS_INCOMPLETE_AUTH;
	} elsif ( $method == 2 ) {
		$self->print_data( $self->sh,
				pack ('CC', 1, length( $self->socks_param( 'user_id' ) ) ),
				$self->socks_param( 'user_id' ),
				pack ('C', length( $self->socks_param( 'user_pswd' ) )),
				$self->socks_param( 'user_pswd' ) );

		if ( ! $self->read_data($self->sh, \$received, 2) or length($received) < 2 ) {
			return SOCKS_TIMEOUT;
		}
		( $ver, $status ) = unpack 'CC', $received;
	}

	if ( $status == 0 ) {
		return SOCKS_OKAY;
	} else {
		return SOCKS_BAD_AUTH;
	}
}

#
# ïÔ×ÅÔ 4 ÓÏËÓÁ
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub get_resp_socks4 {
	my ( $self ) = @_;
	my $received;
	local $_;

	$received = '';

	if ( ! $self->read_data($self->sh, \$received, 8) or length($received) < 8 ) {
		return SOCKS_TIMEOUT;
	}
	(	$self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ]->{vn},
		$self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ]->{cd},
		$self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ]->{listen_port},
	) = unpack 'CCn', $received;

	$self->socks_param( 'listen_addr', inet_ntoa( substr $received, 4 ) );

	return $self->socks_param( 'cd' );
}

#
# ïÔ×ÅÔ 5 ÓÏËÓÁ
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub get_resp_socks5 {
	my ( $self ) = @_;
	my ( $received, $length );
	local $_;

	$received = '';

	if ( ! $self->read_data($self->sh, \$received, 4) or length($received) < 4 ) {
		return SOCKS_TIMEOUT;
	}
	(
	 $self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ]->{vn},
	 $self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ]->{cd},
	 $self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ]->{socks_flag},
	 $self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ]->{addr_type}
	) = unpack('CCCC', $received);

	if ( $self->socks_param( 'addr_type' ) == 3 ) {				# FQDN
		if ( ! $self->read_data($self->sh, \$received, 1) or length($received) < 1 ) {
			return SOCKS_TIMEOUT;
		}
		$length = unpack('C', $received);
		if ( ! $self->read_data($self->sh, \$received, $length) or length($received) < $length ) {
			return SOCKS_TIMEOUT;
		}
		unless ( $received = gethostbyname( $received ) ) {
			return SOCKS_HOSTNAME_LOOKUP_FAILURE;
		}
	} elsif ( $self->socks_param( 'addr_type' ) == 1) {			# IPv4 32 bit
		if ( ! $self->read_data($self->sh, \$received, 4) or length($received) < 4 ) {
			return SOCKS_TIMEOUT;
		}
	} else {											# IPv6, others
		return SOCKS_UNSUPPORTED_ADDRESS_TYPE;
	}

	$self->socks_param( 'listen_addr', inet_ntoa( $received ) );

	if ( ! $self->read_data($self->sh, \$received, 2) or length($received) < 2 ) {
		return SOCKS_TIMEOUT;
	}

	$self->socks_param( 'listen_port', unpack('n', $received) );

	if ( $self->socks_param( 'cd' ) == 0 ) {
		$self->socks_param( 'cd', SOCKS_OKAY );
	}

	return $self->socks_param( 'cd' );
}

#
# ïÔ×ÅÔ http ÐÒÏËÓÉ
#
# åÓÌÉ ×ÓÅ OK ÔÏ ×ÏÚ×ÒÁÝÁÅÔ SOCKS_OKAY
#
sub get_resp_http {
	my ( $self ) = @_;
	local $_;

	my $received = '';

	if ( ! $self->read_data($self->sh, \$received, 0) or length($received) < 5 ) {
		return SOCKS_TIMEOUT;
	}

	$self->configure( 'CHAIN_DATA' )->[ $self->{__last_socks} ] = {};

	if ( $received =~ /HTTP\/\d+\.\d+\s+200/is ) {
		return SOCKS_OKAY;
	} elsif ( $received =~ /HTTP\/\d+\.\d+\s+(\d+)\s+([^\r\n]+)/is ) {
		SOCKS_MSG->{"-$1"} = $2;
		return "-$1";
	}

	return SOCKS_FAILED;
}

#
# ÔÁË..., ÐÏÞÉÓÔÉÍ ÚÁ ÓÏÂÏÊ...
#
sub DESTROY	{};

1;

__END__