view release on metacpan or  search on metacpan

lib/AnyEvent/SOCKS/Client.pm  view on Meta::CPAN

            my( $data, $header) = @_ ;
            ...
        };

=head1 SECURITY

By default resolves names on SOCKS server. No DNS leaks.

=head1 SUBROUTINES/METHODS 

=head2 $sub = tcp_connect_via( @proxy_uris )

Function accepts proxy list and return proxied tcp_connect function. See AnyEvent::Socket docs for more information about its semantics. 

=cut

=head1 Errors and logging

Module uses AE::log for error reporting. You can use "error" or "debug" levels to get more information about errors. 

=cut

package AnyEvent::SOCKS::Client;

use 5.006;
use strict ;

use AnyEvent;
use AnyEvent::Util qw/guard/;
use AnyEvent::Socket qw/tcp_connect parse_ipv4 format_ipv4 parse_ipv6 format_ipv6/;
use AnyEvent::Handle ;
use AnyEvent::Log ;

use Scalar::Util qw/weaken/;

require Exporter;
our $VERSION = '0.051';
our @ISA = qw/Exporter/;
our @EXPORT_OK = qw/tcp_connect_via/;

our $TIMEOUT = 300;

use constant {
	TYPE_IP4 => 1,
	TYPE_IP6 => 4,
	TYPE_FQDN => 3,
	
	AUTH_ANON => 0,
	AUTH_GSSAPI => 1,
	AUTH_LOGIN => 2,
	AUTH_GTFO => 255,
	
	CMD_CONNECT => 1 ,
	CMD_BIND => 2, 
	CMD_UDP_ASSOC => 3,
};

sub _parse_uri{
	my $re = qr!socks(4|4a|5)://(?:([^\s:]+):([^\s@]*)@)?(\[[0-9a-f:.]+\]|[^\s:]+):(\d+)!i ;
	if( $_[0] =~ m/$re/gi ){
		my $p = {v => $1, login => $2, password => $3, host => $4, port => $5};
		$p->{host} =~ s/^\[|\]$//g;
		return $p;
	}
	undef ;
}
# returns tcp_connect compatible function
sub tcp_connect_via{
	my(@chain) = @_ ;

	unless( @chain ){
		AE::log "error" => "No socks were given, abort"; 
		return sub{ $_[2]->() };
	}
	my @parsed;
	for(@chain){
		if( my $p = _parse_uri($_) ){
			push @parsed, $p; next;
		}
		AE::log "error" => "Invalid socks uri: $_";
		return sub{ $_[2]->() };
	}

	return sub{
		my( $dst_host, $dst_port, $c_cb, $pre_cb ) = @_ ;
		my $con = bless {
			chain => \@parsed,
			dst_host => $dst_host,
			dst_port => $dst_port,
			c_cb => $c_cb,
			pre_cb => $pre_cb,
		}, __PACKAGE__ ;
		$con->connect;

		if( defined wantarray ){ # not void
			weaken( $con );
			return guard{
				AE::log "debug" => "Guard triggered" ;
				if( ref $con eq __PACKAGE__ ){
					undef $con->{c_cb};
					$con->DESTROY;
				}
			};
		}
		undef;
	};
}

sub connect{
	my( $self ) = @_ ;
	# tcp connect to first socks
	my $that = $self->{chain}->[0] ;
	$self->{_guard} = tcp_connect $that->{host}, $that->{port}, sub{
		my $fh = shift ;
		unless($fh){
			AE::log "error" => "$that->{host}:$that->{port} connect failed: $!";
			return;
		}

		$self->{hd} = new AnyEvent::Handle(
			fh => $fh,
			on_error => sub{
				my ($hd, $fatal, $msg) = @_;
				AE::log "error" => ( $fatal ? "Fatal " : "" ) . $msg ;
				$hd->destroy unless( $hd->destroyed );
				return;
			}
		);
		if($that->{v} =~ /4a?/){
			$self->connect_socks4;
			return;
		}
		$self->handshake;
	}, $self->{pre_cb} || sub{ $TIMEOUT };
}

sub connect_socks4{
	my( $self ) = @_;
	my( $that, $next ) = @{ $self->{chain} } ;
	my( $host, $port ) = $next 
		? ( $next->{host}, $next->{port} )
		: ( $self->{dst_host}, $self->{dst_port} ) ;

	my $ip4 = parse_ipv4($host);
	if( $that->{v} eq '4' and not $ip4 ){
		AE::log "error" => "SOCKS4 is only support IPv4 addresses: $host given";
		return;
	}

	if( $host =~ /:/ ){
		AE::log "error" => "SOCKS4/4a doesn't support IPv6 addresses: $host given";
		return;
	}
	AE::log "debug" => "SOCKS4 connect to $host:$port";
	$self->{hd}->push_write( $ip4 
		? pack('CCnA4A2', 4, CMD_CONNECT, $port, $ip4, "X\0" )
		: pack('CCnCCCCA*', 4, CMD_CONNECT, $port, 0,0,0,7 , "X\0$host\0" )
	);
	$self->{hd}->push_read( chunk => 8, sub{
		my($code, $dst_port, $dst_ip) = unpack('xCna4', $_[1]);
		unless( $code == 90 ){
			AE::log "error" => "SOCKS4/4a request rejected: code is $code";
			return;
		}
		$self->socks_connect_done( format_ipv4( $dst_ip ), $dst_port );
	});
}

sub handshake{
	my( $self ) = @_;
	my $that = $self->{chain}->[0] ;
	my @auth_methods = 0 ;
	if($that->{login} and $that->{password}){
		push @auth_methods, AUTH_LOGIN ;
	}
	$self->{hd}->push_write( 
		pack('CC', 5, scalar @auth_methods ) . join( "", map( pack( 'C', $_ ), @auth_methods ))
	);
	$self->{hd}->push_read( chunk => 2 , sub{
		my $method = unpack( 'xC', $_[1] ); 
		AE::log "debug" => "Server want auth method $method" ;
		if($method == AUTH_GTFO ){
			AE::log "error" => "Server: no suitable auth method";
			return ;
		}

		if( $method ) {
			$self->auth($method);
		}
		else {
			$self->connect_cmd ;
		}
	 });
}

sub auth{
	my( $self, $method ) = @_;
	my $that = $self->{chain}->[0] ;
	if( $method == AUTH_LOGIN and $that->{login} and $that->{password}){
		$self->{hd}->push_write( 
			pack('CC', 5, length $that->{login} ) . $that->{login} 
			. pack('C', length $that->{password}) . $that->{password} 
		);
		$self->{hd}->push_read( chunk => 2, sub{
			my $status = unpack('xC', $_[1]) ;
			if( $status == 0 ){
				$self->connect_cmd ;
				return ;
			}
			AE::log "error" => "Bad login or password";
		});
		return ;
	}
	AE::log "error" => "Auth method $method not implemented!";
}

sub connect_cmd{
	my( $self ) = @_ ; 
	my $next = $self->{chain}->[1] ;
	my( $host, $port ) = $next 
		? ( $next->{host}, $next->{port} )
		: ( $self->{dst_host}, $self->{dst_port} ) ;

	my ($cmd, $ip );
	if( $ip = parse_ipv4($host) ){
		AE::log "debug" => "Connect IPv4: $host";
		$cmd = pack('CCCCA4n', 5, CMD_CONNECT, 0, TYPE_IP4, $ip, $port);
	}
	elsif( $ip = parse_ipv6($host) ){
		AE::log "debug" => "Connect IPv6: $host";
		$cmd = pack('CCCCA16n', 5, CMD_CONNECT, 0, TYPE_IP6, $ip, $port);
	}
	else{
		AE::log "debug" => "Connect hostname: $host";
		$cmd = pack('CCCCCA*n', 5, CMD_CONNECT, 0, TYPE_FQDN , length $host, $host, $port);
	}

	$self->{hd}->push_write( $cmd );
	$self->{hd}->push_read( chunk => 4, sub{
		my( $status, $type ) = unpack( 'xCxC', $_[1] );
		unless( $status == 0 ){
			AE::log "error" => "Connect cmd rejected: status is $status" ;
			return ;
		}
		$self->connect_cmd_finalize( $type ); 
	});
}

sub connect_cmd_finalize{ 
	my( $self, $type ) = @_ ;

	AE::log "debug" => "Connect cmd done, bind atype is $type"; 

	if($type == TYPE_IP4){
		$self->{hd}->push_read( chunk => 6, sub{
			my( $host, $port) = unpack( "a4n", $_[1] );
			$self->socks_connect_done( format_ipv4( $host ), $port );
		}); 
	}
	elsif($type == TYPE_IP6){
		$self->{hd}->push_read( chunk => 18, sub{
			my( $host, $port) = unpack( "a16n", $_[1] );
			$self->socks_connect_done( format_ipv6( $host ) , $port );
		});
	}
	elsif($type == TYPE_FQDN){
		# read 1 byte (fqdn len)
		# then read fqdn and port
		$self->{hd}->push_read( chunk => 1, sub{
			my $fqdn_len = unpack( 'C', $_[1] ) ;