IO-Socket-Socks-0.67/0000755000175000017500000000000012502333413012715 5ustar olegolegIO-Socket-Socks-0.67/t/0000755000175000017500000000000012502333413013160 5ustar olegolegIO-Socket-Socks-0.67/t/01_load.t0000644000175000017500000000026312456113516014575 0ustar olegoleguse Test::More tests=>1; BEGIN{ use_ok( "IO::Socket::Socks" ); } warn "$IO::Socket::Socks::SOCKET_CLASS v".("$IO::Socket::Socks::SOCKET_CLASS"->VERSION)." used as base class\n"; IO-Socket-Socks-0.67/t/subs.pm0000644000175000017500000000643012456113516014505 0ustar olegoleguse IO::Socket::Socks qw/:constants $SOCKS_ERROR/; use IO::Socket; use IO::Select; use strict; sub make_socks_server { my ($version, $login, $password, %delay) = @_; my $serv = IO::Socket::Socks->new(Listen => 3, SocksVersion => $version, RequireAuth => ($login && $password), UserAuth => sub { $login = '' unless defined $login; $password = '' unless defined $password; $_[0] = '' unless defined $_[0]; $_[1] = '' unless defined $_[1]; return $_[0] eq $login && $_[1] eq $password; }) or die $@; my $child = fork(); die 'fork: ', $! unless defined $child; if ($child == 0) { while (1) { if ($delay{accept}) { sleep $delay{accept}; } my $client = $serv->accept() or next; my $subchild = fork(); die 'subfork: ', $! unless defined $subchild; if ($subchild == 0) { my ($cmd, $host, $port) = @{$client->command()}; if($cmd == CMD_CONNECT) { # connect my $socket = IO::Socket::INET->new(PeerHost => $host, PeerPort => $port, Timeout => 10); if ($delay{reply}) { sleep $delay{reply}; } if($socket) { # request granted $client->command_reply($version == 4 ? REQUEST_GRANTED : REPLY_SUCCESS, $socket->sockhost, $socket->sockport); } else { # request rejected or failed $client->command_reply($version == 4 ? REQUEST_FAILED : REPLY_HOST_UNREACHABLE, $host, $port); $client->close(); exit; } my $selector = IO::Select->new($socket, $client); MAIN_CONNECT: while(1) { my @ready = $selector->can_read(); foreach my $s (@ready) { my $readed = $s->sysread(my $data, 1024); unless($readed) { # error or socket closed $socket->close(); last MAIN_CONNECT; } if($s == $socket) { # return to client data readed from remote host $client->syswrite($data); } else { # return to remote host data readed from the client $socket->syswrite($data); } } } } exit; } } } return ($child, fix_addr($serv->sockhost), $serv->sockport); } sub make_http_server { my $serv = IO::Socket::INET->new(Listen => 3) or die $@; my $child = fork(); die 'fork: ', $! unless defined $child; if ($child == 0) { while (1) { my $client = $serv->accept() or next; my $subchild = fork(); die 'subfork: ', $! unless defined $subchild; if ($subchild == 0) { my $buf; while (1) { $client->sysread($buf, 1024, length $buf) or last; if (rindex($buf, "\015\012\015\012") != -1) { last; } } my ($path) = $buf =~ /GET\s+(\S+)/ or exit; my $response; if ($path eq '/') { $response = 'ROOT'; } elsif ($path eq '/index') { $response = 'INDEX'; } else { $response = 'UNKNOWN'; } $client->syswrite( join( "\015\012", "HTTP/1.1 200 OK", "Connection: close", "Content-Type: text/html", "\015\012" ) . $response ); exit; } } exit; } return ($child, fix_addr($serv->sockhost), $serv->sockport); } sub fix_addr { return '127.0.0.1' if $_[0] eq '0.0.0.0'; return '0:0:0:0:0:0:0:1' if $_[0] eq '::'; return $_[0]; } 1; IO-Socket-Socks-0.67/t/07_accept_nb4.t0000644000175000017500000001146212456113516015671 0ustar olegoleg#!/usr/bin/env perl package IO::Socket::Socks::Slow; use Socket; use IO::Socket::Socks qw(:constants); use base 'IO::Socket::Socks'; use strict; our $DELAY = 0; *_fail = \&IO::Socket::Socks::_fail; sub _socks4_connect_command { my $self = shift; my $command = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $IO::Socket::Socks::SOCKS4_RESOLVE; my $dstaddr = $resolve ? inet_aton('0.0.0.1') : inet_aton(${*$self}->{SOCKS}->{CmdAddr}); my $dstport = pack('n', ${*$self}->{SOCKS}->{CmdPort}); my $userid = ${*$self}->{SOCKS}->{Username} || ''; my $dsthost = ''; if($resolve) { # socks4a $dsthost = ${*$self}->{SOCKS}->{CmdAddr} . pack('C', 0); } my $reply; my $request = pack('CC', SOCKS4_VER, $command) . $dstport . $dstaddr . $userid . pack('C', 0) . $dsthost; my $sent = 0; while ($request =~ /(..{0,3})/g) { $reply = $self->_socks_send($1, ++$sends) or return _fail($reply); $sent += length($1); last if $sent == length($request); sleep $DELAY; } if($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => SOCKS4_VER, cmd => $command, dstport => ${*$self}->{SOCKS}->{CmdPort}, dstaddr => length($dstaddr) == 4 ? inet_ntoa($dstaddr) : undef, userid => $userid, null => 0 ); if($dsthost) { $debug->add( dsthost => ${*$self}->{SOCKS}->{CmdAddr}, null => 0 ); } $debug->show('Client Send: '); } return 1; } package main; use Test::More; use IO::Socket::Socks; use IO::Select; use Time::HiRes; use strict; require 't/subs.pm'; use constant CONN_CNT => 3; unless ($ENV{SOCKS_SLOW_TESTS} || $ENV{AUTOMATED_TESTING}) { plan skip_all => "SOCKS_SLOW_TESTS environment variable should has true value"; } if( $^O eq 'MSWin32' ) { plan skip_all => 'Fork and Windows are incompatible'; } my %childs; my @pipes; my %map = ( 1 => {host => 'google.com', port => 80, request => 'wtf', response => 'googlre response'}, 2 => {host => '2gis.ru', port => 22, request => 'defined', response => 'johny'}, 3 => {host => 'academ.info', port => 110, request => 'make', response => 'segmentation fault'}, ); for my $d (1..CONN_CNT) { pipe my $reader, my $writer; push @pipes, $writer; defined (my $child = fork()) or die "fork(): $!"; if ($child == 0) { close $writer; chomp(my $servinfo = <$reader>); my ($host, $port) = split /\|/, $servinfo; close $reader; $IO::Socket::Socks::Slow::DELAY = $d; my $cli = IO::Socket::Socks::Slow->new(ProxyAddr => $host, ProxyPort => $port, ConnectAddr => $map{$d}{host}, ConnectPort => $map{$d}{port}, SocksVersion => 4, SocksResolve => 1) or die $@; $cli->syswrite("$d:$map{$d}{request}") or die $!; $cli->sysread(my $buf, 1024) or die $!; $buf eq $map{$d}{response} or die "$buf != $map{$d}{response}"; exit 0; } $childs{$child} = 1; } my $server = IO::Socket::Socks->new(Blocking => 0, Listen => 10, SocksVersion => 4, SocksResolve => 1) or die $@; my $host = fix_addr($server->sockhost); my $port = $server->sockport; print $_ "$host|$port\n" for @pipes; close $_ for @pipes; my $sel_read = IO::Select->new($server); my $sel_write = IO::Select->new(); my $conn_cnt = 0; while ($conn_cnt < CONN_CNT || $sel_read->count() > 1 || $sel_write->count() > 0) { my @ready; push @ready, $sel_read->can_read(0.3); push @ready, $sel_write->can_write(0.3); foreach my $socket (@ready) { my $start = Time::HiRes::time(); if ($socket == $server) { my $client = $server->accept(); ok($client, "New client connection") or diag $SOCKS_ERROR; $client->blocking(0); $socket = $client; $conn_cnt++; } if ($socket->ready) { $socket->command_reply(IO::Socket::Socks::REQUEST_GRANTED, '127.0.0.1', $socket->command->[2]); IO::Select->new($socket)->can_read; ok(defined $socket->sysread(my $request, 1024), "sysread() success") or diag $!; my ($d, $r) = $request =~ /(\d+):(.+)/; ok(defined $d, "Correct key") or diag $request; is($r, $map{$d}{request}, "Correct request"); ok(defined $socket->syswrite($map{$d}{response}), "syswrite() success") or diag $!; $sel_read->remove($socket); $sel_write->remove($socket); $socket->close(); } elsif ($SOCKS_ERROR == SOCKS_WANT_READ) { $sel_write->remove($socket); $sel_read->add($socket); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $sel_read->remove($socket); $sel_write->add($socket); } else { ok(0, '$SOCKS_ERROR is known') or diag $SOCKS_ERROR; } my $res = Time::HiRes::time() - $start; ok($res < 1, "ready() not blocked") or diag "$res sec spent"; } } while (%childs) { my $child = wait(); is($?, 0, "Client $child finished successfully"); delete $childs{$child}; } done_testing(); IO-Socket-Socks-0.67/t/08_accept_nb5.t0000644000175000017500000001162212456113516015671 0ustar olegoleg#!/usr/bin/env perl package IO::Socket::Socks::Slow; use IO::Socket::Socks qw(:constants); use base 'IO::Socket::Socks'; use strict; our $DELAY = 0; *_fail = \&IO::Socket::Socks::_fail; sub _socks5_connect { my $self = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); my $sock = defined( ${*$self}->{SOCKS}->{TCP} ) ? ${*$self}->{SOCKS}->{TCP} : $self; my $nmethods = 0; my $methods; foreach my $method (0..$#{${*$self}->{SOCKS}->{AuthMethods}}) { if (${*$self}->{SOCKS}->{AuthMethods}->[$method] == 1) { $methods .= pack('C', $method); $nmethods++; } } my $reply; my $request = pack('CCa*', SOCKS5_VER, $nmethods, $methods); my @p = $request =~ /(..?)/g; my $sent = 0; while ($request =~ /(..?)/g) { $reply = $sock->_socks_send($1, ++$sends) or return _fail($reply); $sent += length($1); last if $sent == length($request); sleep $DELAY; } if($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => SOCKS5_VER, nmethods => $nmethods, methods => join('', unpack("C$nmethods", $methods)) ); $debug->show('Client Send: '); } $reply = $sock->_socks_read(2, ++$reads) or return _fail($reply); my ($version, $auth_method) = unpack('CC', $reply); if($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => $version, method => $auth_method ); $debug->show('Client Recv: '); } if ($auth_method == AUTHMECH_INVALID) { $IO::Socket::Socks::SOCKS_ERROR = $IO::Socket::Socks::CODES{AUTHMECH}->[$auth_method]; return; } return $auth_method; } package main; use Test::More; use IO::Socket::Socks; use IO::Select; use Time::HiRes; use strict; require 't/subs.pm'; use constant CONN_CNT => 3; unless ($ENV{SOCKS_SLOW_TESTS} || $ENV{AUTOMATED_TESTING}) { plan skip_all => "SOCKS_SLOW_TESTS environment variable should has true value"; } if( $^O eq 'MSWin32' ) { plan skip_all => 'Fork and Windows are incompatible'; } my %childs; my @pipes; my %map = ( 1 => {host => 'google.com', port => 80, request => 'wtf', response => 'googlre response'}, 2 => {host => '2gis.ru', port => 22, request => 'defined', response => 'johny'}, 3 => {host => 'academ.info', port => 110, request => 'make', response => 'segmentation fault'}, ); for my $d (1..CONN_CNT) { pipe my $reader, my $writer; push @pipes, $writer; defined (my $child = fork()) or die "fork(): $!"; if ($child == 0) { close $writer; chomp(my $servinfo = <$reader>); my ($host, $port) = split /\|/, $servinfo; close $reader; $IO::Socket::Socks::Slow::DELAY = $d; my $cli = IO::Socket::Socks::Slow->new(ProxyAddr => $host, ProxyPort => $port, ConnectAddr => $map{$d}{host}, ConnectPort => $map{$d}{port}) or die $@; $cli->syswrite("$d:$map{$d}{request}") or die $!; $cli->sysread(my $buf, 1024) or die $!; $buf eq $map{$d}{response} or die "$buf != $map{$d}{response}"; exit 0; } $childs{$child} = 1; } my $server = IO::Socket::Socks->new(Blocking => 0, Listen => 10) or die $@; my $host = fix_addr($server->sockhost); my $port = $server->sockport; print $_ "$host|$port\n" for @pipes; close $_ for @pipes; my $sel_read = IO::Select->new($server); my $sel_write = IO::Select->new(); my $conn_cnt = 0; while ($conn_cnt < CONN_CNT || $sel_read->count() > 1 || $sel_write->count() > 0) { my @ready; push @ready, $sel_read->can_read(0.3); push @ready, $sel_write->can_write(0.3); foreach my $socket (@ready) { my $start = Time::HiRes::time(); if ($socket == $server) { my $client = $server->accept(); ok($client, "New client connection") or diag $SOCKS_ERROR; $client->blocking(0); $socket = $client; $conn_cnt++; } if ($socket->ready) { $socket->command_reply(IO::Socket::Socks::REPLY_SUCCESS, '127.0.0.1', $socket->command->[2]); IO::Select->new($socket)->can_read; ok(defined $socket->sysread(my $request, 1024), "sysread() success") or diag $!; my ($d, $r) = $request =~ /(\d+):(.+)/; ok(defined $d, "Correct key") or diag $request; is($r, $map{$d}{request}, "Correct request"); is($socket->command->[1], $map{$d}{host}, "Command host ok"); is($socket->command->[2], $map{$d}{port}, "Command port ok"); ok(defined $socket->syswrite($map{$d}{response}), "syswrite() success") or diag $!; $sel_read->remove($socket); $sel_write->remove($socket); $socket->close(); } elsif ($SOCKS_ERROR == SOCKS_WANT_READ) { $sel_write->remove($socket); $sel_read->add($socket); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $sel_read->remove($socket); $sel_write->add($socket); } else { ok(0, '$SOCKS_ERROR is known') or diag $SOCKS_ERROR; } my $time_spent = Time::HiRes::time() - $start; ok($time_spent < 1, "ready() not blocked") or diag "$time_spent sec spent"; } } while (%childs) { my $child = wait(); is($?, 0, "Client $child finished successfully"); delete $childs{$child}; } done_testing(); IO-Socket-Socks-0.67/t/06_accept_mixed.t0000644000175000017500000000566412456113516016322 0ustar olegoleg#!/usr/bin/env perl use Test::More; use IO::Socket::Socks qw(:DEFAULT :constants); use IO::Select; use strict; require 't/subs.pm'; my $server = IO::Socket::Socks->new(Listen => 10, Blocking => 0, SocksVersion => [4,5], SocksResolve => 1) or die $@; my $read_select = IO::Select->new($server); my $serveraddr = fix_addr($server->sockhost); my $serverport = $server->sockport; my %local_clients; my $ver4_cnt = 0; my $ver5_cnt = 0; for (1..10) { my $ver = rand() < 0.5 ? 4 : 5; $ver == 4 ? $ver4_cnt++ : $ver5_cnt++; my $client = IO::Socket::Socks->new(SocksVersion => $ver, Blocking => 0, ProxyAddr => $serveraddr, ProxyPort => $serverport, ConnectAddr => '2gis.com', ConnectPort => 8080, SocksResolve => 1); ok(defined($client), "Socks $ver client non-blocking connection $_ started"); $local_clients{$client} = $client; } my $accepted = 0; my $i = 0; my %server_clients; while ($accepted != 10 && $i < 30) { $i++; if ($read_select->can_read(0.5)) { my $client = $server->accept(); $accepted++; ok($client, "Socks mixed accept() $accepted") or diag $SOCKS_ERROR; if ($client) { $client->blocking(0); $server_clients{$client} = $client; } } } is(scalar keys %server_clients, 10, "All socks mixed clients accepted"); $read_select->remove($server); my $write_select = IO::Select->new(); $i = 0; do { $i++; my @ready; if ($read_select->count() || $write_select->count()) { if ($read_select->count()) { push @ready, $read_select->can_read(0.5); } if ($write_select->count()) { push @ready, $write_select->can_write(0.5); } } else { @ready = (values %local_clients, values %server_clients); } for my $client (@ready) { $read_select->remove($client); $write_select->remove($client); if ($client->ready) { if (exists $local_clients{$client}) { delete $local_clients{$client}; } else { if ($client->version == 4) { $client->command_reply(REQUEST_GRANTED, '127.0.0.1', '1080'); $ver4_cnt--; } else { $client->command_reply(REPLY_SUCCESS, '127.0.0.1', '1080'); $ver5_cnt--; } delete $server_clients{$client}; } } elsif ($SOCKS_ERROR == SOCKS_WANT_READ) { $read_select->add($client); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $write_select->add($client); } else { fail("Socks mixed no error"); diag $SOCKS_ERROR; } } } while (%server_clients && $i < 30); $server->close(); is($ver4_cnt, 0, "all socks4 accepted"); is($ver5_cnt, 0, "all socks5 accepted"); ok(!%server_clients, "All socks mixed connections accepted properly") or diag((scalar keys %server_clients) . " connections was not completed"); done_testing(); IO-Socket-Socks-0.67/t/03_connect.t0000644000175000017500000001523612456113516015317 0ustar olegoleg#!/usr/bin/env perl use Test::More; use Socket; use IO::Socket::Socks; use IO::Select; use Time::HiRes 'time'; use strict; require 't/subs.pm'; if( $^O eq 'MSWin32' ) { plan skip_all => 'Fork and Windows are incompatible'; } my ($s_pid, $s_host, $s_port) = make_socks_server(4); my ($h_pid, $h_host, $h_port) = make_http_server(); my $sock = IO::Socket::Socks->new( SocksVersion => 4, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port ); ok(defined($sock), 'Socks 4 connect') or diag $SOCKS_ERROR; is($sock->version, 4, 'Version is 4'); my @dst = $sock->dst; is(@dst, 3, 'Socks 4 dst after connect has 3 elements'); like($dst[0], qr/^\d+\.\d+\.\d+\.\d+$/, 'dst[0] looks like ip'); like($dst[1], qr/^\d+$/, 'dst[1] looks like port'); is($dst[2], IO::Socket::Socks::ADDR_IPV4, 'dst[2] is ipv4'); my $family = length($sock->sockaddr) == 4 ? PF_INET : PF_INET6; kill 15, $s_pid; ($s_pid, $s_host, $s_port) = make_socks_server(5); $sock = IO::Socket::Socks->new( SocksVersion => 5, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port ); ok(defined($sock), 'Socks 5 connect') or diag $SOCKS_ERROR; is($sock->version, 5, 'Version is 5'); @dst = $sock->dst; is(@dst, 3, 'Socks 5 dst after connect has 3 elements'); like($dst[1], qr/^\d+$/, 'dst[1] looks like port'); ok( $dst[2] == IO::Socket::Socks::ADDR_IPV4 || $dst[2] == IO::Socket::Socks::ADDR_IPV6, 'dst[2] is ipv4 or ipv6' ); kill 15, $s_pid; ($s_pid, $s_host, $s_port) = make_socks_server(5, 'root', 'toor'); $sock = IO::Socket::Socks->new( SocksVersion => 5, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port, Username => 'root', Password => 'toor', AuthType => 'userpass' ); ok(defined($sock), 'Socks 5 connect with auth') or diag $SOCKS_ERROR; $sock = IO::Socket::Socks->new( SocksVersion => 5, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port, Username => 'root', Password => '123', AuthType => 'userpass' ) or my $error = int($!); # save it _immediately_ after fail ok(!defined($sock), 'Socks 5 connect with auth and incorrect password'); ok($error == ESOCKSPROTO, '$! == ESOCKSPROTO') or diag $error, "!=", ESOCKSPROTO; ok($SOCKS_ERROR == IO::Socket::Socks::AUTHREPLY_FAILURE, '$SOCKS_ERROR == AUTHREPLY_FAILURE') or diag int($SOCKS_ERROR), "!=", IO::Socket::Socks::AUTHREPLY_FAILURE; kill 15, $s_pid; SKIP: { skip "SOCKS_SLOW_TESTS environment variable should has true value", 1 unless $ENV{SOCKS_SLOW_TESTS} || $ENV{AUTOMATED_TESTING}; ($s_pid, $s_host, $s_port) = make_socks_server(4, undef, undef, accept => 3, reply => 2); my $start = time(); $sock = IO::Socket::Socks->new( SocksVersion => 4, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port ); ok(defined($sock), 'Socks 4 blocking connect success'); $start = time(); $sock = IO::Socket::Socks->new( SocksVersion => 4, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port, Blocking => 0 ); ok(defined($sock), 'Socks 4 non-blocking connect success'); my $time_spent = time()-$start; ok($time_spent < 3, 'Socks 4 non-blocking connect time') or diag "$time_spent sec spent"; my $sel = IO::Select->new($sock); my $i = 0; $start = time(); until ($sock->ready) { $i++; $time_spent = time()-$start; ok($time_spent < 1, "Connection attempt $i not blocked") or diag "$time_spent sec spent"; if ($SOCKS_ERROR == SOCKS_WANT_READ) { $sel->can_read(0.8); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $sel->can_write(0.8); } else { last; } $start = time(); } ok($sock->ready, 'Socks 4 non-blocking socket ready') or diag $SOCKS_ERROR; is($sock->version, 4, 'Version is 4 for non-blocking connect'); kill 15, $s_pid; ($s_pid, $s_host, $s_port) = make_socks_server(5, 'root', 'toor', accept => 3, reply => 2); $start = time(); $sock = IO::Socket::Socks->new( SocksVersion => 5, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port, Username => 'root', Password => 'toor', AuthType => 'userpass', Blocking => 0 ); ok(defined($sock), 'Socks 5 non-blocking connect success'); $time_spent = time()-$start; ok($time_spent < 3, 'Socks 5 non-blocking connect time') or diag "$time_spent sec spent"; $sel = IO::Select->new($sock); $i = 0; $start = time(); until ($sock->ready) { $i++; $time_spent = time()-$start; ok($time_spent < 1, "Connection attempt $i not blocked") or diag "$time_spent sec spent"; if ($SOCKS_ERROR == SOCKS_WANT_READ) { $sel->can_read(0.8); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $sel->can_write(0.8); } else { last; } $start = time(); } ok($sock->ready, 'Socks 5 non-blocking socket ready') or diag $SOCKS_ERROR; is($sock->version, 5, 'Version is 5 for non-blocking connect'); $sock = IO::Socket::Socks->new( SocksVersion => 5, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port, Username => 'root', Password => 'toot', AuthType => 'userpass', Blocking => 0 ); if (defined $sock) { $sel = IO::Select->new($sock); $i = 0; $start = time(); until ($sock->ready) { $i++; $time_spent = time()-$start; ok($time_spent < 1, "Connection attempt $i not blocked") or diag "$time_spent sec spent"; if ($SOCKS_ERROR == SOCKS_WANT_READ) { $sel->can_read(0.8); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $sel->can_write(0.8); } else { last; } $start = time(); } ok(!$sock->ready, 'Socks 5 non-blocking connect with fail auth'); } else { pass('Socks 5 non-blocking connect with fail auth (immediatly)'); } kill 15, $s_pid; } ($s_pid, $s_host, $s_port) = make_socks_server(5); socket(my $unconnected_sock, $family, SOCK_STREAM, getprotobyname('tcp')) || die "socket: $!"; $sock = IO::Socket::Socks->new_from_socket($unconnected_sock, ProxyAddr => $s_host, ProxyPort => $s_port, ConnectAddr => $h_host, ConnectPort => $h_port); ok($unconnected_sock, "plain socket still alive"); if (ok($sock, "socks object created from plain socket")) { is(fileno($sock), fileno($unconnected_sock), "socks object uses plain socket"); } $sock = "$IO::Socket::Socks::SOCKET_CLASS"->new(PeerAddr => $s_host, PeerPort => $s_port); if (ok($sock, "$IO::Socket::Socks::SOCKET_CLASS socket created")) { $sock = IO::Socket::Socks->start_SOCKS($sock, ConnectAddr => $h_host, ConnectPort => $h_port); ok($sock, "$IO::Socket::Socks::SOCKET_CLASS socket upgraded to IO::Socket::Socks"); isa_ok($sock, 'IO::Socket::Socks'); $sock->syswrite( "GET / HTTP/1.1\015\012\015\012" ); is($sock->getline(), "HTTP/1.1 200 OK\015\012", 'socket works properly'); } kill 15, $s_pid; kill 15, $h_pid; done_testing(); IO-Socket-Socks-0.67/t/02_new.t0000644000175000017500000000025612365213154014450 0ustar olegoleguse Test::More tests=>3; BEGIN{ use_ok( "IO::Socket::Socks" ); } my $socks = new IO::Socket::Socks(); ok( defined($socks), "new()"); isa_ok( $socks, "IO::Socket::Socks"); IO-Socket-Socks-0.67/t/05_accept5.t0000644000175000017500000000435212456113516015211 0ustar olegoleg#!/usr/bin/env perl use Test::More; use IO::Socket::Socks qw(:DEFAULT :constants); use IO::Select; use strict; require 't/subs.pm'; my $server = IO::Socket::Socks->new(Listen => 10, Blocking => 0, SocksVersion => 5) or die $@; my $read_select = IO::Select->new($server); my $serveraddr = fix_addr($server->sockhost); my $serverport = $server->sockport; my %local_clients; for (1..10) { my $client = IO::Socket::Socks->new(Blocking => 0, ProxyAddr => $serveraddr, ProxyPort => $serverport, ConnectAddr => '2gis.com', ConnectPort => 8080); ok(defined($client), "Socks 5 client non-blocking connection $_ started"); $local_clients{$client} = $client; } my $accepted = 0; my $i = 0; my %server_clients; while ($accepted != 10 && $i < 30) { $i++; if ($read_select->can_read(0.5)) { my $client = $server->accept(); $accepted++; ok($client, "Socks 5 accept() $accepted") or diag $SOCKS_ERROR; is($client->version, 5, 'Client version is 5'); if ($client) { $client->blocking(0); $server_clients{$client} = $client; } } } is(scalar keys %server_clients, 10, "All socks 5 clients accepted"); $read_select->remove($server); my $write_select = IO::Select->new(); $i = 0; do { $i++; my @ready; if ($read_select->count() || $write_select->count()) { if ($read_select->count()) { push @ready, $read_select->can_read(0.5); } if ($write_select->count()) { push @ready, $write_select->can_write(0.5); } } else { @ready = (values %local_clients, values %server_clients); } for my $client (@ready) { $read_select->remove($client); $write_select->remove($client); if ($client->ready) { if (exists $local_clients{$client}) { delete $local_clients{$client}; } else { $client->command_reply(REPLY_SUCCESS, '127.0.0.1', '1080'); delete $server_clients{$client}; } } elsif ($SOCKS_ERROR == SOCKS_WANT_READ) { $read_select->add($client); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $write_select->add($client); } else { fail("Socks 5 no error"); diag $SOCKS_ERROR; } } } while (%server_clients && $i < 30); $server->close(); ok(!%server_clients, "All socks 5 connections accepted properly") or diag((scalar keys %server_clients) . " connections was not completed"); done_testing(); IO-Socket-Socks-0.67/t/04_accept4.t0000644000175000017500000000451212456113516015205 0ustar olegoleg#!/usr/bin/env perl use Test::More; use IO::Socket::Socks qw(:DEFAULT :constants); use IO::Select; use strict; require 't/subs.pm'; my $server = IO::Socket::Socks->new(Listen => 10, Blocking => 0, SocksVersion => 4, SocksResolve => 1) or die $@; my $read_select = IO::Select->new($server); my $serveraddr = fix_addr($server->sockhost); my $serverport = $server->sockport; my %local_clients; for (1..10) { my $client = IO::Socket::Socks->new(Blocking => 0, ProxyAddr => $serveraddr, ProxyPort => $serverport, ConnectAddr => '2gis.com', ConnectPort => 8080, SocksVersion => 4, SocksResolve => 1); ok(defined($client), "Socks 4 client non-blocking connection $_ started"); $local_clients{$client} = $client; } my $accepted = 0; my $i = 0; my %server_clients; while ($accepted != 10 && $i < 30) { $i++; if ($read_select->can_read(0.5)) { my $client = $server->accept(); $accepted++; ok($client, "Socks 4 accept() $accepted") or diag $SOCKS_ERROR; is($client->version, 4, 'Client version is 4'); if ($client) { $client->blocking(0); $server_clients{$client} = $client; } } } is(scalar keys %server_clients, 10, "All socks 4 clients accepted"); $read_select->remove($server); my $write_select = IO::Select->new(); $i = 0; do { $i++; my @ready; if ($read_select->count() || $write_select->count()) { if ($read_select->count()) { push @ready, $read_select->can_read(0.5); } if ($write_select->count()) { push @ready, $write_select->can_write(0.5); } } else { @ready = (values %local_clients, values %server_clients); } for my $client (@ready) { $read_select->remove($client); $write_select->remove($client); if ($client->ready) { if (exists $local_clients{$client}) { delete $local_clients{$client}; } else { $client->command_reply(REQUEST_GRANTED, '127.0.0.1', '1080'); delete $server_clients{$client}; } } elsif ($SOCKS_ERROR == SOCKS_WANT_READ) { $read_select->add($client); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $write_select->add($client); } else { fail("Socks 4 no error"); diag $SOCKS_ERROR; } } } while (%server_clients && $i < 30); $server->close(); ok(!%server_clients, "All socks 4 connections accepted properly") or diag((scalar keys %server_clients) . " connections was not completed"); done_testing(); IO-Socket-Socks-0.67/examples/0000755000175000017500000000000012502333413014533 5ustar olegolegIO-Socket-Socks-0.67/examples/udp.pl0000755000175000017500000000072012365213154015670 0ustar olegoleg#!/usr/bin/env perl use lib '../lib'; use IO::Socket::Socks; use Socket; use strict; # daytime UDP client my $sock = IO::Socket::Socks->new( UdpAddr => 'localhost', UdpPort => 8344, ProxyAddr => 'localhost', ProxyPort => 1080, SocksDebug => 1 ) or die $SOCKS_ERROR; my $peer = inet_aton('localhost'); $peer = sockaddr_in(13, $peer); $sock->send('!', 0, $peer) or die $!; $sock->recv(my $data, 50) or die $!; $sock->close(); print $data; IO-Socket-Socks-0.67/examples/server5.pl0000755000175000017500000001230412365213154016474 0ustar olegoleg#!/usr/bin/env perl use lib '../lib'; use IO::Socket::Socks qw(:constants $SOCKS_ERROR); use IO::Select; use strict; # return bind address as ip address like most socks5 proxyes does $IO::Socket::Socks::SOCKS5_RESOLVE = 1; # create socks server my $server = IO::Socket::Socks->new(SocksVersion => 5, SocksDebug => 1, ProxyAddr => 'localhost', ProxyPort => 1080, Listen => 10) or die $SOCKS_ERROR; # accept connections while() { my $client = $server->accept(); if($client) { my ($cmd, $host, $port) = @{$client->command()}; if($cmd == CMD_CONNECT) { # connect # create socket with requested host my $socket = IO::Socket::INET->new(PeerHost => $host, PeerPort => $port, Timeout => 10); if($socket) { # success $client->command_reply(REPLY_SUCCESS, $socket->sockhost, $socket->sockport); } else { # Host Unreachable $client->command_reply(REPLY_HOST_UNREACHABLE, $host, $port); $client->close(); next; } my $selector = IO::Select->new($socket, $client); MAIN_CONNECT: while() { my @ready = $selector->can_read(); foreach my $s (@ready) { my $readed = $s->sysread(my $data, 1024); unless($readed) { # error or socket closed warn 'connection closed'; $socket->close(); last MAIN_CONNECT; } if($s == $socket) { # return to client data readed from remote host $client->syswrite($data); } else { # return to remote host data readed from the client $socket->syswrite($data); } } } } elsif($cmd == CMD_BIND) { # bind # create listen socket my $socket = IO::Socket::INET->new(Listen => 10); if($socket) { # success $client->command_reply(REPLY_SUCCESS, $socket->sockhost, $socket->sockport); } else { # request rejected or failed $client->command_reply(REPLY_HOST_UNREACHABLE, $host, $port); $client->close(); next; } while() { # accept new connection needed proxifycation my $conn = $socket->accept() or next; $socket->close(); if($conn->peerhost ne join('.', unpack('C4', (gethostbyname($host))[4]))) { # connected host should be same as specified in the client bind request last; } $client->command_reply(REPLY_SUCCESS, $conn->peerhost, $conn->peerport); my $selector = IO::Select->new($conn, $client); MAIN_BIND: while() { my @ready = $selector->can_read(); foreach my $s (@ready) { my $readed = $s->sysread(my $data, 1024); unless($readed) { # error or socket closed warn 'connection closed'; $conn->close(); last MAIN_BIND; } if($s == $conn) { # return to client data readed from remote host $client->syswrite($data); } else { # return to remote host data readed from the client $conn->syswrite($data); } } } last; } } elsif($cmd == CMD_UDPASSOC) { # UDP associate # who really need it? # you could send me a patch warn 'UDP assoc: not implemented'; $client->command_reply(REPLY_GENERAL_FAILURE, $host, $port); } else { warn 'Unknown command'; } $client->close(); } else { warn $SOCKS_ERROR; } } sub auth { # add `UserAuth => \&auth, RequireAuth => 1' to the server constructor if you want to authenticate user by login and password my $login = shift; my $password = shift; my %allowed_users = (root => 123, oleg => 321, ryan => 213); return $allowed_users{$login} eq $password; } # tested with `curl --socks5' IO-Socket-Socks-0.67/examples/server4.pl0000755000175000017500000001166612365213154016505 0ustar olegoleg#!/usr/bin/env perl # Simple socks4 server # implemented with IO::Socket::Socks module use lib '../lib'; use IO::Socket::Socks qw(:constants $SOCKS_ERROR); use IO::Select; use strict; # allow socks4a protocol extension $IO::Socket::Socks::SOCKS4_RESOLVE = 1; # create socks server my $server = IO::Socket::Socks->new(SocksVersion => 4, SocksDebug => 1, ProxyAddr => 'localhost', ProxyPort => 1080, Listen => 10) or die $SOCKS_ERROR; # accept connections while() { my $client = $server->accept(); if($client) { my ($cmd, $host, $port) = @{$client->command()}; if($cmd == CMD_CONNECT) { # connect # create socket with requested host my $socket = IO::Socket::INET->new(PeerHost => $host, PeerPort => $port, Timeout => 10); if($socket) { # request granted $client->command_reply(REQUEST_GRANTED, $socket->sockhost, $socket->sockport); } else { # request rejected or failed $client->command_reply(REQUEST_FAILED, $host, $port); $client->close(); next; } my $selector = IO::Select->new($socket, $client); MAIN_CONNECT: while() { my @ready = $selector->can_read(); foreach my $s (@ready) { my $readed = $s->sysread(my $data, 1024); unless($readed) { # error or socket closed warn 'connection closed'; $socket->close(); last MAIN_CONNECT; } if($s == $socket) { # return to client data readed from remote host $client->syswrite($data); } else { # return to remote host data readed from the client $socket->syswrite($data); } } } } elsif($cmd == CMD_BIND) { # bind # create listen socket my $socket = IO::Socket::INET->new(Listen => 10); if($socket) { # request granted $client->command_reply(REQUEST_GRANTED, $socket->sockhost, $socket->sockport); } else { # request rejected or failed $client->command_reply(REQUEST_FAILED, $host, $port); $client->close(); next; } while() { # accept new connection needed proxifycation my $conn = $socket->accept() or next; $socket->close(); if($conn->peerhost ne join('.', unpack('C4', (gethostbyname($host))[4]))) { # connected host should be same as specified in the client bind request last; } $client->command_reply(REQUEST_GRANTED, $conn->peerhost, $conn->peerport); my $selector = IO::Select->new($conn, $client); MAIN_BIND: while() { my @ready = $selector->can_read(); foreach my $s (@ready) { my $readed = $s->sysread(my $data, 1024); unless($readed) { # error or socket closed warn 'connection closed'; $conn->close(); last MAIN_BIND; } if($s == $conn) { # return to client data readed from remote host $client->syswrite($data); } else { # return to remote host data readed from the client $conn->syswrite($data); } } } last; } } else { warn 'Unknown command'; } $client->close(); } else { warn $SOCKS_ERROR; } } sub auth { # add `UserAuth => \&auth' to the server constructor if you want to authenticate user by its id my $userid = shift; my %allowed_users = (root => 1, oleg => 1, ryan => 1); return exists($allowed_users{$userid}); } # tested with `curl --socks4' and `curl --socks4a' IO-Socket-Socks-0.67/examples/chain.pl0000755000175000017500000000447312365213154016173 0ustar olegoleguse lib '../lib'; use IO::Socket::Socks; use strict; # connect to www.google.com via socks chain my @chain = ( {ProxyAddr => '10.0.0.1', ProxyPort => 1080, SocksVersion => 4, SocksDebug => 1}, {ProxyAddr => '10.0.0.2', ProxyPort => 1080, SocksVersion => 4, SocksDebug => 1}, {ProxyAddr => '10.0.0.3', ProxyPort => 1080, SocksVersion => 5, SocksDebug => 1}, {ProxyAddr => '10.0.0.4', ProxyPort => 1080, SocksVersion => 4, SocksDebug => 1}, {ProxyAddr => '10.0.0.5', ProxyPort => 1080, SocksVersion => 5, SocksDebug => 1}, {ProxyAddr => '10.0.0.6', ProxyPort => 1080, SocksVersion => 4, SocksDebug => 1}, ); my $dst = {ConnectAddr => 'www.google.com', ConnectPort => 80}; my $sock; my $len; TRY: while(@chain) { for(my $i=0, $len = 0; $i<@chain; $i++) { unless($len) { $sock = IO::Socket::Socks->new( %{$chain[$i]}, Timeout => 10, $#chain != $i ? (ConnectAddr => $chain[$i+1]->{ProxyAddr}, ConnectPort => $chain[$i+1]->{ProxyPort}) : %$dst ); if($sock) { $len++; } elsif($! != ESOCKSPROTO) { # connection to proxy failed shift @chain; next TRY; } else { splice @chain, 0, 2; next TRY; } } else { my $st = $sock->command( %{$chain[$i]}, $#chain != $i ? (ConnectAddr => $chain[$i+1]->{ProxyAddr}, ConnectPort => $chain[$i+1]->{ProxyPort}) : %$dst ); if($st) { $len++; } else { # on fail we don't know which of the two links broken # so, remove both from the chain splice @chain, $i, 2; # if one of the link in the chain is broken we should # try to build chain from the beginning next TRY; } } } last; } unless($sock) { die('Bad chain'); } else { warn("chain length is $len"); } $sock->syswrite ( "GET / HTTP/1.0\015\012". "Host: www.google.com\015\012\015\012" ); while($sock->sysread(my $buf, 1024)) { print $buf; } IO-Socket-Socks-0.67/examples/client5.pl0000755000175000017500000000244712365213154016453 0ustar olegoleg#!/usr/bin/env perl # Simple socks5 client # gets google.com main page # implemented with IO::Socket::Socks use lib '../lib'; use strict; use IO::Socket::Socks; # uncomment line below if you want to resolve hostnames locally #$IO::Socket::Socks::SOCKS5_RESOLVE = 0; my $socks = new IO::Socket::Socks(ProxyAddr=>"127.0.0.1", ProxyPort=>"1080", ConnectAddr=>"www.google.com", ConnectPort=>80, # uncomment lines below if you want to use authentication #Username=>"oleg", #Password=>"321", #AuthType=>"userpass", # uncomment line below if you want client not to send anonymous as supported method #RequireAuth=>1, SocksDebug=>1, # comment this if you are not interested in the debug information Timeout=>10, ) or die $SOCKS_ERROR; $socks->syswrite ( "GET / HTTP/1.0\015\012". "Host: www.google.com\015\012\015\012" ); while($socks->sysread(my $buf, 1024)) { print $buf; } # tested with server5.pl IO-Socket-Socks-0.67/examples/client4.pl0000755000175000017500000000205312365213154016443 0ustar olegoleg#!/usr/bin/env perl # Simple socks4 client # gets google.com main page # implemented with IO::Socket::Socks use lib '../lib'; use strict; use IO::Socket::Socks; # uncomment line below if you want to use socks4a #$IO::Socket::Socks::SOCKS4_RESOLVE = 1; my $socks = new IO::Socket::Socks(ProxyAddr=>"127.0.0.1", ProxyPort=>"1080", ConnectAddr=>"www.google.com", ConnectPort=>80, Username=>"oleg", # most socks4 servers doesn't needs userid, you can comment this SocksDebug=>1, # comment this if you are not interested in the debug information SocksVersion => 4, # default is 5 Timeout=>10, ) or die $SOCKS_ERROR; $socks->syswrite ( "GET / HTTP/1.0\015\012". "Host: www.google.com\015\012\015\012" ); while($socks->sysread(my $buf, 1024)) { print $buf; } # tested with server4.pl IO-Socket-Socks-0.67/examples/multi-client-multi-ver-coro-based-server.pl0000755000175000017500000000402012456113516024747 0ustar olegoleg#!/usr/bin/env perl # This Socks Proxy Server allows 4 and 5 version on the same port # May process many clients in parallel use strict; use lib '../lib'; use Coro::PatchSet 0.04; BEGIN { # make IO::Select Coro aware package IO::Select; use Coro::Select; use IO::Select; } use IO::Socket::Socks qw(:constants :DEFAULT); use Coro; use Coro::Socket; # make our server Coro aware $IO::Socket::Socks::SOCKET_CLASS = 'Coro::Socket'; my $server = IO::Socket::Socks->new(SocksVersion => [4,5], ProxyAddr => 'localhost', ProxyPort => 1080, Listen => 10) or die $SOCKS_ERROR; warn "Server started at ", $server->sockhost, ":", $server->sockport; $server->blocking(0); # accept() shouldn't block main thread my $server_selector = IO::Select->new($server); while (1) { $server_selector->can_read(); my $client = $server->accept() # just accept or next; # without socks handshake async_pool { $client->ready() # and make handshake in separate thread or return; my ($cmd, $host, $port) = @{$client->command}; if ($cmd == CMD_CONNECT) { my $sock = Coro::Socket->new( PeerAddr => $host, PeerPort => $port, Timeout => 10 ); if ($sock) { $client->command_reply( $client->version == 4 ? REQUEST_GRANTED : REPLY_SUCCESS, $sock->sockhost, $sock->sockport ); my $selector = IO::Select->new($client, $sock); my $buf; SELECT: while (1) { my @ready = $selector->can_read(); for my $s (@ready) { last SELECT unless $s->sysread($buf, 1024); if ($s == $client) { $sock->syswrite($buf); } else { $client->syswrite($buf); } } } $sock->close(); } else { $client->command_reply( $client->version == 4 ? REQUEST_FAILED : REPLY_HOST_UNREACHABLE, $host, $port ); } } else { $client->command_reply( $client->version == 4 ? REQUEST_FAILED : REPLY_CMD_NOT_SUPPORTED, $host, $port ); } $client->close(); }; } $server->close(); IO-Socket-Socks-0.67/examples/bind.pl0000755000175000017500000000316212365213154016017 0ustar olegoleg#!/usr/bin/env perl use lib '../lib'; use IO::Socket::Socks; use strict; # example of using socks bind with FTP active data connection use constant { FTP_HOST => 'host.net', FTP_PORT => 21, FTP_USER => 'root', FTP_PASS => 'lsdadp', SOCKS_HOST => '195.190.0.20', SOCKS_PORT => 1080 }; # create control connection my $primary = IO::Socket::Socks->new( ConnectAddr => FTP_HOST, ConnectPort => FTP_PORT, ProxyAddr => SOCKS_HOST, ProxyPort => SOCKS_PORT, SocksVersion => 5, SocksDebug => 1, Timeout => 30 ) or die $SOCKS_ERROR; # create data connection my $secondary = IO::Socket::Socks->new( BindAddr => FTP_HOST, BindPort => FTP_PORT, ProxyAddr => SOCKS_HOST, ProxyPort => SOCKS_PORT, SocksVersion => 5, SocksDebug => 1, Timeout => 30 ) or die $SOCKS_ERROR; # login to ftp $primary->syswrite("USER ". FTP_USER ."\015\012"); $primary->getline(); $primary->syswrite("PASS ". FTP_PASS ."\015\012"); $primary->getline(); # get address where socks bind and pass it to the ftp server my ($host, $port) = $secondary->dst(); $host = SOCKS_HOST if $host eq '0.0.0.0'; # RFC says that if host == '0.0.0.0' it means that it should be replaced by socks host $primary->syswrite("PORT " . join(',', split (/\./, $host), (map hex, sprintf("%04x", $port) =~ /(..)(..)/)) . "\015\012"); $primary->getline(); $primary->syswrite("LIST /\015\012"); $primary->getline(); # wait connection from ftp server $secondary->accept() or die $SOCKS_ERROR; # print all data received from ftp server print while <$secondary>; # close all connections $secondary->close(); $primary->close(); IO-Socket-Socks-0.67/Changes0000644000175000017500000000520012502333262014207 0ustar olegoleg0.67 ==== - properly push $SOCKET_CLASS defined before loading to @ISA - fix annoying warning about @ISA 0.66 ==== - IPv6 support for SOCKS protocol - IPv6 support for socket layer (requires IO::Socket::IP 0.36+) - new $SOCKET_CLASS variable - several non-critical internal fixes and doc updates 0.65 ==== - Fix tests failures on OS X (#rt97619) - Clean up documentation a little bit - Do not run slow tests if environment variable SOCKS_SLOW_TESTS is not true 0.64 ==== - start_SOCKS() method added 0.63 ==== - Ignore SIGPIPE on write - $SOCKS_ERROR is readonly now - Ability to make server which understands both 4 and 5 version on the same port - version() method added - Prevent recreation of the passed socket by new_from_fd/new_from_socket 0.62 ==== - Some tests didn't work without internet connection because of the resolving on client side. Fixed - New socket after server accept didn't inherit SocksResolve parameter. Fixed - Removed automatically resolving hostname to ip in socks4a server accept. This should be done in the program, not in this library - command() on the server side now in addition returns address type as last value (ADDR_DOMAINNAME or ADDR_IPV4) - Fix for $! test on Solaris and ready() time measurement on OpenBSD 0.61 ==== - Set $! to ESOCKPROTO (new module constant) on error in the protocol - Set $@ on error - $SOCKS_ERROR now behaves more like $!: string or number in appropriate contexts - Return socket to non-blocking state after new_from_fd if socket was non-blocking before 0.60 ==== - Added support for non-blocking clients accept on the server side - new_from_fd() is now alias to new_from_socket() 0.51 ==== - Non-blocking connect on BSD systems could break connection with ENOTCONN error - Spelling patch from the debian project was applied 0.5 === - Added support for non-blocking connect/bind operations on the client side - $SOCKS_DEBUG variable added, debug now to STDERR instead STDOUT - Real tests added 0.4 === - UDP associate support added. It closes Bug #39216 - method new_from_socket() added. It needed for IO::Socket::Socks::Wrapper module - command() method on the client added. It allows to create socks chains and other cool things 0.3 === - clarified the issue with the license (Bug #44047) - socks bind support added - improvements in the documentation 0.2 === - fixed possible SIGPIPE (Bug #62997) - blocking reading and writing replaced by non-blocking equivalents, so `Timeout' option now documented and works - added support for socks v4, both server and client - some bug fixes 0.1 === - Initial version. IO-Socket-Socks-0.67/MANIFEST0000644000175000017500000000110412502333413014042 0ustar olegolegChanges examples/bind.pl examples/chain.pl examples/client4.pl examples/client5.pl examples/multi-client-multi-ver-coro-based-server.pl examples/server4.pl examples/server5.pl examples/udp.pl lib/IO/Socket/Socks.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/01_load.t t/02_new.t t/03_connect.t t/04_accept4.t t/05_accept5.t t/06_accept_mixed.t t/07_accept_nb4.t t/08_accept_nb5.t t/subs.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) IO-Socket-Socks-0.67/MANIFEST.SKIP0000644000175000017500000000005112365213154014615 0ustar olegolegMakefile$ TODO blib tests .swp$ CVS .git IO-Socket-Socks-0.67/lib/0000755000175000017500000000000012502333413013463 5ustar olegolegIO-Socket-Socks-0.67/lib/IO/0000755000175000017500000000000012502333413013772 5ustar olegolegIO-Socket-Socks-0.67/lib/IO/Socket/0000755000175000017500000000000012502333413015222 5ustar olegolegIO-Socket-Socks-0.67/lib/IO/Socket/Socks.pm0000644000175000017500000021127112502333053016646 0ustar olegolegpackage IO::Socket::Socks; use strict; use IO::Select; use Socket; use Errno qw(EWOULDBLOCK EAGAIN EINPROGRESS ETIMEDOUT ECONNABORTED); use Carp; use vars qw( $SOCKET_CLASS @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $SOCKS_ERROR $SOCKS5_RESOLVE $SOCKS4_RESOLVE $SOCKS_DEBUG %CODES ); require Exporter; $VERSION = '0.67'; use constant { SOCKS_WANT_READ => 20, SOCKS_WANT_WRITE => 21, ESOCKSPROTO => exists &Errno::EPROTO ? &Errno::EPROTO : 7000, }; @ISA = ('Exporter', $SOCKET_CLASS||''); tie $SOCKET_CLASS, 'IO::Socket::Socks::SocketClassVar', $SOCKET_CLASS; unless ($SOCKET_CLASS) { if (eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.36) }) { $SOCKET_CLASS = 'IO::Socket::IP'; } else { $SOCKET_CLASS = 'IO::Socket::INET'; } } @EXPORT = qw( $SOCKS_ERROR SOCKS_WANT_READ SOCKS_WANT_WRITE ESOCKSPROTO ); @EXPORT_OK = qw( SOCKS5_VER SOCKS4_VER ADDR_IPV4 ADDR_DOMAINNAME ADDR_IPV6 CMD_CONNECT CMD_BIND CMD_UDPASSOC AUTHMECH_ANON AUTHMECH_USERPASS AUTHMECH_INVALID AUTHREPLY_SUCCESS AUTHREPLY_FAILURE ISS_UNKNOWN_ADDRESS ISS_BAD_VERSION ISS_CANT_RESOLVE REPLY_SUCCESS REPLY_GENERAL_FAILURE REPLY_CONN_NOT_ALLOWED REPLY_NETWORK_UNREACHABLE REPLY_HOST_UNREACHABLE REPLY_CONN_REFUSED REPLY_TTL_EXPIRED REPLY_CMD_NOT_SUPPORTED REPLY_ADDR_NOT_SUPPORTED REQUEST_GRANTED REQUEST_FAILED REQUEST_REJECTED_IDENTD REQUEST_REJECTED_USERID ); %EXPORT_TAGS = (constants => [ 'SOCKS_WANT_READ', 'SOCKS_WANT_WRITE', @EXPORT_OK ]); tie $SOCKS_ERROR, 'IO::Socket::Socks::ReadOnlyVar', IO::Socket::Socks::Error->new(); $SOCKS5_RESOLVE = 1; $SOCKS4_RESOLVE = 0; $SOCKS_DEBUG = $ENV{SOCKS_DEBUG}; use constant { SOCKS5_VER => 5, SOCKS4_VER => 4, ADDR_IPV4 => 1, ADDR_DOMAINNAME => 3, ADDR_IPV6 => 4, CMD_CONNECT => 1, CMD_BIND => 2, CMD_UDPASSOC => 3, AUTHMECH_ANON => 0, #AUTHMECH_GSSAPI => 1, AUTHMECH_USERPASS => 2, AUTHMECH_INVALID => 255, AUTHREPLY_SUCCESS => 0, AUTHREPLY_FAILURE => 10, # to not intersect with other socks5 constants ISS_UNKNOWN_ADDRESS => 500, ISS_BAD_VERSION => 501, ISS_CANT_RESOLVE => 502, }; $CODES{AUTHMECH}->[AUTHMECH_INVALID] = "No valid auth mechanisms"; $CODES{AUTHREPLY}->[AUTHREPLY_FAILURE] = "Failed to authenticate"; # socks5 use constant { REPLY_SUCCESS => 0, REPLY_GENERAL_FAILURE => 1, REPLY_CONN_NOT_ALLOWED => 2, REPLY_NETWORK_UNREACHABLE => 3, REPLY_HOST_UNREACHABLE => 4, REPLY_CONN_REFUSED => 5, REPLY_TTL_EXPIRED => 6, REPLY_CMD_NOT_SUPPORTED => 7, REPLY_ADDR_NOT_SUPPORTED => 8, }; $CODES{REPLY}->{&REPLY_SUCCESS} = "Success"; $CODES{REPLY}->{&REPLY_GENERAL_FAILURE} = "General failure"; $CODES{REPLY}->{&REPLY_CONN_NOT_ALLOWED} = "Not allowed"; $CODES{REPLY}->{&REPLY_NETWORK_UNREACHABLE} = "Network unreachable"; $CODES{REPLY}->{&REPLY_HOST_UNREACHABLE} = "Host unreachable"; $CODES{REPLY}->{&REPLY_CONN_REFUSED} = "Connection refused"; $CODES{REPLY}->{&REPLY_TTL_EXPIRED} = "TTL expired"; $CODES{REPLY}->{&REPLY_CMD_NOT_SUPPORTED} = "Command not supported"; $CODES{REPLY}->{&REPLY_ADDR_NOT_SUPPORTED} = "Address not supported"; # socks4 use constant { REQUEST_GRANTED => 90, REQUEST_FAILED => 91, REQUEST_REJECTED_IDENTD => 92, REQUEST_REJECTED_USERID => 93, }; $CODES{REPLY}->{&REQUEST_GRANTED} = "request granted"; $CODES{REPLY}->{&REQUEST_FAILED} = "request rejected or failed"; $CODES{REPLY}->{&REQUEST_REJECTED_IDENTD} = "request rejected becasue SOCKS server cannot connect to identd on the client"; $CODES{REPLY}->{&REQUEST_REJECTED_USERID} = "request rejected because the client program and identd report different user-ids"; # queue use constant { Q_SUB => 0, Q_ARGS => 1, Q_BUF => 2, Q_READS => 3, Q_SENDS => 4, Q_OKCB => 5, Q_DEBUGS => 6, }; sub new_from_fd { my ($class, $sock, %arg) = @_; bless $sock, $class; $sock->autoflush(1); if (exists $arg{Timeout}) { ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout}; } scalar(%arg) or return $sock; return $sock->configure(\%arg); } *new_from_socket = \&new_from_fd; sub start_SOCKS { my ($class, $sock, %arg) = @_; bless $sock, $class; $sock->autoflush(1); if (exists $arg{Timeout}) { ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout}; } ${*$sock}->{SOCKS} = { RequireAuth => 0 }; return $sock->command(%arg) ? $sock : undef; } sub socket { my $self = shift; if (-S $self) { ${*$self}{'io_socket_domain'} ||= $_[0]; ${*$self}{'io_socket_type'} ||= $_[1]; ${*$self}{'io_socket_proto'} ||= $_[2]; return $self; } return $self->SUPER::socket(@_); } sub configure { my $self = shift; my $args = shift; $self->_configure($args) or return; ${*$self}->{SOCKS}->{ProxyAddr} = ( exists($args->{ProxyAddr}) ? delete($args->{ProxyAddr}) : undef ); ${*$self}->{SOCKS}->{ProxyPort} = ( exists($args->{ProxyPort}) ? delete($args->{ProxyPort}) : undef ); ${*$self}->{SOCKS}->{COMMAND} = []; if (exists($args->{Listen})) { $args->{LocalAddr} = ${*$self}->{SOCKS}->{ProxyAddr}; $args->{LocalPort} = ${*$self}->{SOCKS}->{ProxyPort}; $args->{Reuse} = 1; ${*$self}->{SOCKS}->{Listen} = 1; } elsif (${*$self}->{SOCKS}->{ProxyAddr} && ${*$self}->{SOCKS}->{ProxyPort}) { $args->{PeerAddr} = ${*$self}->{SOCKS}->{ProxyAddr}; $args->{PeerPort} = ${*$self}->{SOCKS}->{ProxyPort}; } unless (defined ${*$self}->{SOCKS}->{TCP}) { $args->{Proto} = "tcp"; $args->{Type} = SOCK_STREAM; } elsif (!defined $args->{Proto}) { $args->{Proto} = "udp"; $args->{Type} = SOCK_DGRAM; } $SOCKS_ERROR->set(); unless ($self->SUPER::configure($args)) { if ($SOCKS_ERROR == undef) { $SOCKS_ERROR->set($!, $@); } return; } return $self; } sub _configure { my $self = shift; my $args = shift; ${*$self}->{SOCKS}->{Version} = ( exists($args->{SocksVersion}) ? ( $args->{SocksVersion} == 4 || $args->{SocksVersion} == 5 || ( exists $args->{Listen} && ref $args->{SocksVersion} eq 'ARRAY' && _validate_multi_version($args->{SocksVersion})) ? delete($args->{SocksVersion}) : croak("Unsupported socks version specified. Should be 4 or 5") ) : 5 ); ${*$self}->{SOCKS}->{AuthType} = ( exists($args->{AuthType}) ? delete($args->{AuthType}) : "none" ); ${*$self}->{SOCKS}->{RequireAuth} = ( exists($args->{RequireAuth}) ? delete($args->{RequireAuth}) : 0 ); ${*$self}->{SOCKS}->{UserAuth} = ( exists($args->{UserAuth}) ? delete($args->{UserAuth}) : undef ); ${*$self}->{SOCKS}->{Username} = ( exists($args->{Username}) ? delete($args->{Username}) : ( (${*$self}->{SOCKS}->{AuthType} eq "none") ? undef : croak("If you set AuthType to userpass, then you must provide a username.") ) ); ${*$self}->{SOCKS}->{Password} = ( exists($args->{Password}) ? delete($args->{Password}) : ( (${*$self}->{SOCKS}->{AuthType} eq "none") ? undef : croak("If you set AuthType to userpass, then you must provide a password.") ) ); ${*$self}->{SOCKS}->{Debug} = ( exists($args->{SocksDebug}) ? delete($args->{SocksDebug}) : $SOCKS_DEBUG ); ${*$self}->{SOCKS}->{Resolve} = ( exists($args->{SocksResolve}) ? delete($args->{SocksResolve}) : undef ); ${*$self}->{SOCKS}->{AuthMethods} = [ 0, 0, 0 ]; ${*$self}->{SOCKS}->{AuthMethods}->[AUTHMECH_ANON] = 1 unless ${*$self}->{SOCKS}->{RequireAuth}; #${*$self}->{SOCKS}->{AuthMethods}->[AUTHMECH_GSSAPI] = 1 # if (${*$self}->{SOCKS}->{AuthType} eq "gssapi"); ${*$self}->{SOCKS}->{AuthMethods}->[AUTHMECH_USERPASS] = 1 if ( (!exists($args->{Listen}) && (${*$self}->{SOCKS}->{AuthType} eq "userpass")) || (exists($args->{Listen}) && defined(${*$self}->{SOCKS}->{UserAuth})) ); if (exists($args->{BindAddr}) && exists($args->{BindPort})) { ${*$self}->{SOCKS}->{CmdAddr} = delete($args->{BindAddr}); ${*$self}->{SOCKS}->{CmdPort} = delete($args->{BindPort}); ${*$self}->{SOCKS}->{Bind} = 1; } elsif (exists($args->{UdpAddr}) && exists($args->{UdpPort})) { if (${*$self}->{SOCKS}->{Version} == 4) { croak("Socks v4 doesn't support UDP association"); } ${*$self}->{SOCKS}->{CmdAddr} = delete($args->{UdpAddr}); ${*$self}->{SOCKS}->{CmdPort} = delete($args->{UdpPort}); $args->{LocalAddr} = ${*$self}->{SOCKS}->{CmdAddr}; $args->{LocalPort} = ${*$self}->{SOCKS}->{CmdPort}; ${*$self}->{SOCKS}->{TCP} = __PACKAGE__->new( # TCP backend for UDP socket Timeout => $args->{Timeout}, Proto => 'tcp' ) or return; } elsif (exists($args->{ConnectAddr}) && exists($args->{ConnectPort})) { ${*$self}->{SOCKS}->{CmdAddr} = delete($args->{ConnectAddr}); ${*$self}->{SOCKS}->{CmdPort} = delete($args->{ConnectPort}); } return 1; } sub version { my $self = shift; return ${*$self}->{SOCKS}->{Version}; } sub connect { my $self = shift; croak("Undefined IO::Socket::Socks object passed to connect.") unless defined($self); my $ok = defined(${*$self}->{SOCKS}->{TCP}) ? ${*$self}->{SOCKS}->{TCP}->SUPER::connect(@_) : $self->SUPER::connect(@_); if (($! == EINPROGRESS || $! == EWOULDBLOCK) && $self->blocking == 0) { $SOCKS_ERROR->set(SOCKS_WANT_WRITE, 'Socks want write'); } elsif (!$ok) { $SOCKS_ERROR->set($!, $@ = "Connection to proxy failed: $!"); return; } $self->_connect(); } sub _connect { my $self = shift; ${*$self}->{SOCKS}->{ready} = 0; if (${*$self}->{SOCKS}->{Version} == 4) { ${*$self}->{SOCKS}->{queue} = [ # [sub, [@args], buf, [@reads], sends_cnt] [ '_socks4_connect_command', [ ${*$self}->{SOCKS}->{Bind} ? CMD_BIND : CMD_CONNECT ], undef, [], 0 ], [ '_socks4_connect_reply', [], undef, [], 0 ] ]; } else { ${*$self}->{SOCKS}->{queue} = [ [ '_socks5_connect', [], undef, [], 0 ], [ '_socks5_connect_if_auth', [], undef, [], 0 ], [ '_socks5_connect_command', [ ${*$self}->{SOCKS}->{Bind} ? CMD_BIND : ${*$self}->{SOCKS}->{TCP} ? CMD_UDPASSOC : CMD_CONNECT ], undef, [], 0 ], [ '_socks5_connect_reply', [], undef, [], 0 ] ]; } if ($SOCKS_ERROR == undef) { # socket connection estabilished defined($self->_run_queue()) or return; } return $self; } sub _run_queue { # run tasks from queue, return undef on error, -1 if one of the task # returned not completed because of the possible blocking on network operation my $self = shift; my $retval; my $sub; while (my $elt = ${*$self}->{SOCKS}->{queue}[0]) { $sub = $elt->[Q_SUB]; $retval = $self->$sub(@{ $elt->[Q_ARGS] }); unless (defined $retval) { ${*$self}->{SOCKS}->{queue} = []; ${*$self}->{SOCKS}->{queue_results} = {}; last; } last if ($retval == -1); ${*$self}->{SOCKS}->{queue_results}{ $elt->[Q_SUB] } = $retval; if ($elt->[Q_OKCB]) { $elt->[Q_OKCB]->(); } shift @{ ${*$self}->{SOCKS}->{queue} }; } if (defined($retval) && !@{ ${*$self}->{SOCKS}->{queue} }) { ${*$self}->{SOCKS}->{queue_results} = {}; ${*$self}->{SOCKS}->{ready} = $SOCKS_ERROR ? 0 : 1; } return $retval; } sub ready { my $self = shift; $self->_run_queue(); return ${*$self}->{SOCKS}->{ready}; } sub _socks5_connect { my $self = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); my $sock = defined(${*$self}->{SOCKS}->{TCP}) ? ${*$self}->{SOCKS}->{TCP} : $self; #-------------------------------------------------------------------------- # Send the auth mechanisms #-------------------------------------------------------------------------- # +----+----------+----------+ # |VER | NMETHODS | METHODS | # +----+----------+----------+ # | 1 | 1 | 1 to 255 | # +----+----------+----------+ my $nmethods = 0; my $methods; foreach my $method (0 .. $#{ ${*$self}->{SOCKS}->{AuthMethods} }) { if (${*$self}->{SOCKS}->{AuthMethods}->[$method] == 1) { $methods .= pack('C', $method); $nmethods++; } } my $reply; $reply = $sock->_socks_send(pack('CCa*', SOCKS5_VER, $nmethods, $methods), ++$sends) or return _fail($reply); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => SOCKS5_VER, nmethods => $nmethods, methods => join('', unpack("C$nmethods", $methods)) ); $debug->show('Client Send: '); } #-------------------------------------------------------------------------- # Read the reply #-------------------------------------------------------------------------- # +----+--------+ # |VER | METHOD | # +----+--------+ # | 1 | 1 | # +----+--------+ $reply = $sock->_socks_read(2, ++$reads) or return _fail($reply); my ($version, $auth_method) = unpack('CC', $reply); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => $version, method => $auth_method ); $debug->show('Client Recv: '); } if ($auth_method == AUTHMECH_INVALID) { $! = ESOCKSPROTO; $SOCKS_ERROR->set(AUTHMECH_INVALID, $@ = $CODES{AUTHMECH}->[$auth_method]); return; } return $auth_method; } sub _socks5_connect_if_auth { my $self = shift; if (${*$self}->{SOCKS}->{queue_results}{'_socks5_connect'} != AUTHMECH_ANON) { unshift @{ ${*$self}->{SOCKS}->{queue} }, [ '_socks5_connect_auth', [], undef, [], 0 ]; (${*$self}->{SOCKS}->{queue}[0], ${*$self}->{SOCKS}->{queue}[1]) = (${*$self}->{SOCKS}->{queue}[1], ${*$self}->{SOCKS}->{queue}[0]); } 1; } sub _socks5_connect_auth { # rfc1929 my $self = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); my $sock = defined(${*$self}->{SOCKS}->{TCP}) ? ${*$self}->{SOCKS}->{TCP} : $self; #-------------------------------------------------------------------------- # Send the auth #-------------------------------------------------------------------------- # +----+------+----------+------+----------+ # |VER | ULEN | UNAME | PLEN | PASSWD | # +----+------+----------+------+----------+ # | 1 | 1 | 1 to 255 | 1 | 1 to 255 | # +----+------+----------+------+----------+ my $uname = ${*$self}->{SOCKS}->{Username}; my $passwd = ${*$self}->{SOCKS}->{Password}; my $ulen = length($uname); my $plen = length($passwd); my $reply; $reply = $sock->_socks_send(pack("CCa${ulen}Ca*", 1, $ulen, $uname, $plen, $passwd), ++$sends) or return _fail($reply); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => 1, ulen => $ulen, uname => $uname, plen => $plen, passwd => $passwd ); $debug->show('Client Send: '); } #-------------------------------------------------------------------------- # Read the reply #-------------------------------------------------------------------------- # +----+--------+ # |VER | STATUS | # +----+--------+ # | 1 | 1 | # +----+--------+ $reply = $sock->_socks_read(2, ++$reads) or return _fail($reply); my ($ver, $status) = unpack('CC', $reply); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => $ver, status => $status ); $debug->show('Client Recv: '); } if ($status != AUTHREPLY_SUCCESS) { $! = ESOCKSPROTO; $SOCKS_ERROR->set(AUTHREPLY_FAILURE, $@ = "Authentication failed with SOCKS5 proxy"); return; } return 1; } sub _socks5_connect_command { my $self = shift; my $command = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $SOCKS5_RESOLVE; my $sock = defined(${*$self}->{SOCKS}->{TCP}) ? ${*$self}->{SOCKS}->{TCP} : $self; #-------------------------------------------------------------------------- # Send the command #-------------------------------------------------------------------------- # +----+-----+-------+------+----------+----------+ # |VER | CMD | RSV | ATYP | DST.ADDR | DST.PORT | # +----+-----+-------+------+----------+----------+ # | 1 | 1 | X'00' | 1 | Variable | 2 | # +----+-----+-------+------+----------+----------+ my ($atyp, $dstaddr) = $resolve ? (ADDR_DOMAINNAME, ${*$self}->{SOCKS}->{CmdAddr}) : _resolve(${*$self}->{SOCKS}->{CmdAddr}) or $SOCKS_ERROR->set(ISS_CANT_RESOLVE, $@ = "Can't resolve `" . ${*$self}->{SOCKS}->{CmdAddr} . "'"), return; my $hlen = length($dstaddr) if $resolve; my $dstport = pack('n', ${*$self}->{SOCKS}->{CmdPort}); my $reply; $reply = $sock->_socks_send(pack('C4', SOCKS5_VER, $command, 0, $atyp) . (defined($hlen) ? pack('C', $hlen) : '') . $dstaddr . $dstport, ++$sends) or return _fail($reply); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => SOCKS5_VER, cmd => $command, rsv => 0, atyp => $atyp ); $debug->add(hlen => $hlen) if defined $hlen; $debug->add( dstaddr => $resolve ? $dstaddr : _addr_ntoa($dstaddr, $atyp), dstport => ${*$self}->{SOCKS}->{CmdPort} ); $debug->show('Client Send: '); } return 1; } sub _socks5_connect_reply { my $self = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); my $sock = defined(${*$self}->{SOCKS}->{TCP}) ? ${*$self}->{SOCKS}->{TCP} : $self; #-------------------------------------------------------------------------- # Read the reply #-------------------------------------------------------------------------- # +----+-----+-------+------+----------+----------+ # |VER | REP | RSV | ATYP | BND.ADDR | BND.PORT | # +----+-----+-------+------+----------+----------+ # | 1 | 1 | X'00' | 1 | Variable | 2 | # +----+-----+-------+------+----------+----------+ my $reply; $reply = $sock->_socks_read(4, ++$reads) or return _fail($reply); my ($ver, $rep, $rsv, $atyp) = unpack('C4', $reply); if ($debug) { $debug->add( ver => $ver, rep => $rep, rsv => $rsv, atyp => $atyp ); } my ($bndaddr, $bndport); if ($atyp == ADDR_DOMAINNAME) { length($reply = $sock->_socks_read(1, ++$reads)) or return _fail($reply); my $hlen = unpack('C', $reply); $bndaddr = $sock->_socks_read($hlen, ++$reads) or return _fail($bndaddr); if ($debug) { $debug->add(hlen => $hlen); } } elsif ($atyp == ADDR_IPV4) { $bndaddr = $sock->_socks_read(4, ++$reads) or return _fail($bndaddr); } elsif ($atyp == ADDR_IPV6) { $bndaddr = $sock->_socks_read(16, ++$reads) or return _fail($bndaddr); } else { $! = ESOCKSPROTO; $SOCKS_ERROR->set(ISS_UNKNOWN_ADDRESS, $@ = "Unsupported address type returned by socks server: $atyp"); return; } $reply = $sock->_socks_read(2, ++$reads) or return _fail($reply); $bndport = unpack('n', $reply); ${*$self}->{SOCKS}->{DstAddrType} = $atyp; ${*$self}->{SOCKS}->{DstAddr} = $bndaddr; ${*$self}->{SOCKS}->{DstPort} = $bndport; if ($debug && !$self->_debugged(++$debugs)) { my ($addr) = $self->dst; $debug->add( bndaddr => $addr, bndport => $bndport ); $debug->show('Client Recv: '); } if ($rep != REPLY_SUCCESS) { $! = ESOCKSPROTO; unless (exists $CODES{REPLY}->{$rep}) { $rep = REPLY_GENERAL_FAILURE; } $SOCKS_ERROR->set($rep, $@ = $CODES{REPLY}->{$rep}); return; } return 1; } sub _socks4_connect_command { # http://ss5.sourceforge.net/socks4.protocol.txt # http://ss5.sourceforge.net/socks4A.protocol.txt my $self = shift; my $command = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $SOCKS4_RESOLVE; #-------------------------------------------------------------------------- # Send the command #-------------------------------------------------------------------------- # +-----+-----+----------+---------------+----------+------+ # | VER | CMD | DST.PORT | DST.ADDR | USERID | NULL | # +-----+-----+----------+---------------+----------+------+ # | 1 | 1 | 2 | 4 | variable | 1 | # +-----+-----+----------+---------------+----------+------+ my $dstaddr = $resolve ? inet_aton('0.0.0.1') : inet_aton(${*$self}->{SOCKS}->{CmdAddr}) or $SOCKS_ERROR->set(ISS_CANT_RESOLVE, $@ = "Can't resolve `" . ${*$self}->{SOCKS}->{CmdAddr} . "'"), return; my $dstport = pack('n', ${*$self}->{SOCKS}->{CmdPort}); my $userid = ${*$self}->{SOCKS}->{Username} || ''; my $dsthost = ''; if ($resolve) { # socks4a $dsthost = ${*$self}->{SOCKS}->{CmdAddr} . pack('C', 0); } my $reply; $reply = $self->_socks_send(pack('CC', SOCKS4_VER, $command) . $dstport . $dstaddr . $userid . pack('C', 0) . $dsthost, ++$sends) or return _fail($reply); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => SOCKS4_VER, cmd => $command, dstport => ${*$self}->{SOCKS}->{CmdPort}, dstaddr => length($dstaddr) == 4 ? inet_ntoa($dstaddr) : undef, userid => $userid, null => 0 ); if ($dsthost) { $debug->add( dsthost => ${*$self}->{SOCKS}->{CmdAddr}, null => 0 ); } $debug->show('Client Send: '); } return 1; } sub _socks4_connect_reply { my $self = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); #-------------------------------------------------------------------------- # Read the reply #-------------------------------------------------------------------------- # +-----+-----+----------+---------------+ # | VER | REP | BND.PORT | BND.ADDR | # +-----+-----+----------+---------------+ # | 1 | 1 | 2 | 4 | # +-----+-----+----------+---------------+ my $reply; $reply = $self->_socks_read(8, ++$reads) or return _fail($reply); my ($ver, $rep, $bndport) = unpack('CCn', $reply); substr($reply, 0, 4) = ''; ${*$self}->{SOCKS}->{DstAddrType} = ADDR_IPV4; ${*$self}->{SOCKS}->{DstAddr} = $reply; ${*$self}->{SOCKS}->{DstPort} = $bndport; if ($debug && !$self->_debugged(++$debugs)) { my ($addr) = $self->dst; $debug->add( ver => $ver, rep => $rep, bndport => $bndport, bndaddr => $addr ); $debug->show('Client Recv: '); } if ($rep != REQUEST_GRANTED) { $! = ESOCKSPROTO; unless (exists $CODES{REPLY}->{$rep}) { $rep = REQUEST_FAILED; } $SOCKS_ERROR->set($rep, $@ = $CODES{REPLY}->{$rep}); return; } return 1; } sub accept { my $self = shift; croak("Undefined IO::Socket::Socks object passed to accept.") unless defined($self); if (${*$self}->{SOCKS}->{Listen}) { my $client = $self->SUPER::accept(@_); if (!$client) { if ($! == EAGAIN || $! == EWOULDBLOCK) { $SOCKS_ERROR->set(SOCKS_WANT_READ, "Socks want read"); } else { $SOCKS_ERROR->set($!, $@ = "Proxy accept new client failed: $!"); } return; } my $ver = ref ${*$self}->{SOCKS}->{Version} ? @{ ${*$self}->{SOCKS}->{Version} } > 1 ? ${*$self}->{SOCKS}->{Version} : ${*$self}->{SOCKS}->{Version}->[0] : ${*$self}->{SOCKS}->{Version}; # inherit some socket parameters ${*$client}->{SOCKS}->{Debug} = ${*$self}->{SOCKS}->{Debug}; ${*$client}->{SOCKS}->{Version} = $ver; ${*$client}->{SOCKS}->{AuthMethods} = ${*$self}->{SOCKS}->{AuthMethods}; ${*$client}->{SOCKS}->{UserAuth} = ${*$self}->{SOCKS}->{UserAuth}; ${*$client}->{SOCKS}->{Resolve} = ${*$self}->{SOCKS}->{Resolve}; ${*$client}->{SOCKS}->{ready} = 0; $client->blocking($self->blocking); # temporarily if (ref $ver) { ${*$client}->{SOCKS}->{queue} = [ [ '_socks_accept', [], undef, [], 0 ] ]; } elsif ($ver == 4) { ${*$client}->{SOCKS}->{queue} = [ [ '_socks4_accept_command', [], undef, [], 0 ] ]; } else { ${*$client}->{SOCKS}->{queue} = [ [ '_socks5_accept', [], undef, [], 0 ], [ '_socks5_accept_if_auth', [], undef, [], 0 ], [ '_socks5_accept_command', [], undef, [], 0 ] ]; } defined($client->_run_queue()) or return; $client->blocking(1); # new socket should be in blocking mode return $client; } else { ${*$self}->{SOCKS}->{ready} = 0; if ({*$self}->{SOCKS}->{Version} == 4) { push @{ ${*$self}->{SOCKS}->{queue} }, [ '_socks4_connect_reply', [], undef, [], 0 ]; } else { push @{ ${*$self}->{SOCKS}->{queue} }, [ '_socks5_connect_reply', [], undef, [], 0 ]; } defined($self->_run_queue()) or return; return $self; } } sub _socks_accept { # when 4 and 5 version allowed my $self = shift; my $request; $request = $self->_socks_read(1, 0) or return _fail($request); my $ver = unpack('C', $request); if ($ver == 4) { ${*$self}->{SOCKS}->{Version} = 4; push @{ ${*$self}->{SOCKS}->{queue} }, [ '_socks4_accept_command', [$ver], undef, [], 0 ]; } elsif ($ver == 5) { ${*$self}->{SOCKS}->{Version} = 5; push @{ ${*$self}->{SOCKS}->{queue} }, [ '_socks5_accept', [$ver], undef, [], 0 ], [ '_socks5_accept_if_auth', [], undef, [], 0 ], [ '_socks5_accept_command', [], undef, [], 0 ]; } else { $! = ESOCKSPROTO; $SOCKS_ERROR->set(ISS_BAD_VERSION, $@ = "Socks version should be 4 or 5, $ver recieved"); return; } 1; } sub _socks5_accept { my ($self, $ver) = @_; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); #-------------------------------------------------------------------------- # Read the auth mechanisms #-------------------------------------------------------------------------- # +----+----------+----------+ # |VER | NMETHODS | METHODS | # +----+----------+----------+ # | 1 | 1 | 1 to 255 | # +----+----------+----------+ my $request; $request = $self->_socks_read($ver ? 1 : 2, ++$reads) or return _fail($request); unless ($ver) { $ver = unpack('C', $request); } my $nmethods = unpack('C', substr($request, -1, 1)); $request = $self->_socks_read($nmethods, ++$reads) or return _fail($request); my @methods = unpack('C' x $nmethods, $request); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => $ver, nmethods => $nmethods, methods => join('', @methods) ); $debug->show('Server Recv: '); } if ($ver != SOCKS5_VER) { $! = ESOCKSPROTO; $SOCKS_ERROR->set(ISS_BAD_VERSION, $@ = "Socks version should be 5, $ver recieved"); return; } if ($nmethods == 0) { $! = ESOCKSPROTO; $SOCKS_ERROR->set(AUTHMECH_INVALID, $@ = "No auth methods sent"); return; } my $authmech; foreach my $method (@methods) { if (${*$self}->{SOCKS}->{AuthMethods}->[$method] == 1) { $authmech = $method; last; } } if (!defined($authmech)) { $authmech = AUTHMECH_INVALID; } #-------------------------------------------------------------------------- # Send the reply #-------------------------------------------------------------------------- # +----+--------+ # |VER | METHOD | # +----+--------+ # | 1 | 1 | # +----+--------+ $request = $self->_socks_send(pack('CC', SOCKS5_VER, $authmech), ++$sends) or return _fail($request); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => SOCKS5_VER, method => $authmech ); $debug->show('Server Send: '); } if ($authmech == AUTHMECH_INVALID) { $! = ESOCKSPROTO; $SOCKS_ERROR->set(AUTHMECH_INVALID, $@ = "No available auth methods"); return; } return $authmech; } sub _socks5_accept_if_auth { my $self = shift; if (${*$self}->{SOCKS}->{queue_results}{'_socks5_accept'} == AUTHMECH_USERPASS) { unshift @{ ${*$self}->{SOCKS}->{queue} }, [ '_socks5_accept_auth', [], undef, [], 0 ]; (${*$self}->{SOCKS}->{queue}[0], ${*$self}->{SOCKS}->{queue}[1]) = (${*$self}->{SOCKS}->{queue}[1], ${*$self}->{SOCKS}->{queue}[0]); } 1; } sub _socks5_accept_auth { my $self = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); #-------------------------------------------------------------------------- # Read the auth #-------------------------------------------------------------------------- # +----+------+----------+------+----------+ # |VER | ULEN | UNAME | PLEN | PASSWD | # +----+------+----------+------+----------+ # | 1 | 1 | 1 to 255 | 1 | 1 to 255 | # +----+------+----------+------+----------+ my $request; $request = $self->_socks_read(2, ++$reads) or return _fail($request); my ($ver, $ulen) = unpack('CC', $request); $request = $self->_socks_read($ulen + 1, ++$reads) or return _fail($request); my $uname = substr($request, 0, $ulen); my $plen = unpack('C', substr($request, $ulen)); my $passwd; $passwd = $self->_socks_read($plen, ++$reads) or return _fail($passwd); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => $ver, ulen => $ulen, uname => $uname, plen => $plen, passwd => $passwd ); $debug->show('Server Recv: '); } my $status = 1; if (defined(${*$self}->{SOCKS}->{UserAuth})) { $status = &{ ${*$self}->{SOCKS}->{UserAuth} }($uname, $passwd); } #-------------------------------------------------------------------------- # Send the reply #-------------------------------------------------------------------------- # +----+--------+ # |VER | STATUS | # +----+--------+ # | 1 | 1 | # +----+--------+ $status = $status ? AUTHREPLY_SUCCESS : 1; #XXX AUTHREPLY_FAILURE broken $request = $self->_socks_send(pack('CC', 1, $status), ++$sends) or return _fail($request); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => 1, status => $status ); $debug->show('Server Send: '); } if ($status != AUTHREPLY_SUCCESS) { $! = ESOCKSPROTO; $SOCKS_ERROR->set(AUTHREPLY_FAILURE, $@ = "Authentication failed with SOCKS5 proxy"); return; } return 1; } sub _socks5_accept_command { my $self = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); @{ ${*$self}->{SOCKS}->{COMMAND} } = (); #-------------------------------------------------------------------------- # Read the command #-------------------------------------------------------------------------- # +----+-----+-------+------+----------+----------+ # |VER | CMD | RSV | ATYP | DST.ADDR | DST.PORT | # +----+-----+-------+------+----------+----------+ # | 1 | 1 | X'00' | 1 | Variable | 2 | # +----+-----+-------+------+----------+----------+ my $request; $request = $self->_socks_read(4, ++$reads) or return _fail($request); my ($ver, $cmd, $rsv, $atyp) = unpack('CCCC', $request); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => $ver, cmd => $cmd, rsv => $rsv, atyp => $atyp ); } my $dstaddr; if ($atyp == ADDR_DOMAINNAME) { length($request = $self->_socks_read(1, ++$reads)) or return _fail($request); my $hlen = unpack('C', $request); $dstaddr = $self->_socks_read($hlen, ++$reads) or return _fail($dstaddr); if ($debug && !$self->_debugged(++$debugs)) { $debug->add(hlen => $hlen); } } elsif ($atyp == ADDR_IPV4) { $request = $self->_socks_read(4, ++$reads) or return _fail($request); $dstaddr = length($request) == 4 ? inet_ntoa($request) : undef; } elsif ($atyp == ADDR_IPV6) { $request = $self->_socks_read(16, ++$reads) or return _fail($request); $dstaddr = length($request) == 16 ? Socket::inet_ntop(AF_INET6, $request) : undef; } else { # unknown address type - how many bytes to read? push @{${*$self}->{SOCKS}->{queue}}, [ '_socks5_accept_command_reply', [ REPLY_ADDR_NOT_SUPPORTED, '0.0.0.0', 0 ], undef, [], 0, sub { $! = ESOCKSPROTO; $SOCKS_ERROR->set(REPLY_ADDR_NOT_SUPPORTED, $@ = $CODES{REPLY}->{REPLY_ADDR_NOT_SUPPORTED}); } ]; return 0; } $request = $self->_socks_read(2, ++$reads) or return _fail($request); my $dstport = unpack('n', $request); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( dstaddr => $dstaddr, dstport => $dstport ); $debug->show('Server Recv: '); } @{ ${*$self}->{SOCKS}->{COMMAND} } = ($cmd, $dstaddr, $dstport, $atyp); return 1; } sub _socks5_accept_command_reply { my $self = shift; my $reply = shift; my $host = shift; my $port = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $SOCKS5_RESOLVE; my ($reads, $sends, $debugs) = (0, 0, 0); if (!defined($reply) || !defined($host) || !defined($port)) { croak("You must provide a reply, host, and port on the command reply."); } #-------------------------------------------------------------------------- # Send the reply #-------------------------------------------------------------------------- # +----+-----+-------+------+----------+----------+ # |VER | REP | RSV | ATYP | BND.ADDR | BND.PORT | # +----+-----+-------+------+----------+----------+ # | 1 | 1 | X'00' | 1 | Variable | 2 | # +----+-----+-------+------+----------+----------+ my ($atyp, $bndaddr) = $resolve ? _resolve($host) : (ADDR_DOMAINNAME, $host) or $SOCKS_ERROR->set(ISS_CANT_RESOLVE, $@ = "Can't resolve `$host'"), return; my $hlen = $resolve ? undef : length($bndaddr); my $rc; $rc = $self->_socks_send(pack('CCCC', SOCKS5_VER, $reply, 0, $atyp) . ($resolve ? '' : pack('C', $hlen)) . $bndaddr . pack('n', $port), ++$sends) or return _fail($rc); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => SOCKS5_VER, rep => $reply, rsv => 0, atyp => $atyp ); $debug->add(hlen => $hlen) unless $resolve; $debug->add( bndaddr => $resolve ? _addr_ntoa($bndaddr, $atyp) : $bndaddr, bndport => $port ); $debug->show('Server Send: '); } 1; } sub _socks4_accept_command { my ($self, $ver) = @_; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $SOCKS4_RESOLVE; my ($reads, $sends, $debugs) = (0, 0, 0); @{ ${*$self}->{SOCKS}->{COMMAND} } = (); #-------------------------------------------------------------------------- # Read the auth mechanisms #-------------------------------------------------------------------------- # +-----+-----+----------+---------------+----------+------+ # | VER | CMD | DST.PORT | DST.ADDR | USERID | NULL | # +-----+-----+----------+---------------+----------+------+ # | 1 | 1 | 2 | 4 | variable | 1 | # +-----+-----+----------+---------------+----------+------+ my $request; $request = $self->_socks_read($ver ? 7 : 8, ++$reads) or return _fail($request); unless ($ver) { $ver = unpack('C', $request); substr($request, 0, 1) = ''; } my ($cmd, $dstport) = unpack('Cn', $request); substr($request, 0, 3) = ''; my $dstaddr = length($request) == 4 ? inet_ntoa($request) : undef; my $userid = ''; my $c; while (1) { length($c = $self->_socks_read(1, ++$reads)) or return _fail($c); if ($c ne "\0") { $userid .= $c; } else { last; } } if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => $ver, cmd => $cmd, dstport => $dstport, dstaddr => $dstaddr, userid => $userid, null => 0 ); } my $atyp = ADDR_IPV4; if ($resolve && $dstaddr =~ /^0\.0\.0\.[1-9]/) { # socks4a $dstaddr = ''; $atyp = ADDR_DOMAINNAME; while (1) { length($c = $self->_socks_read(1, ++$reads)) or return _fail($c); if ($c ne "\0") { $dstaddr .= $c; } else { last; } } if ($debug && !$self->_debugged(++$debugs)) { $debug->add( dsthost => $dstaddr, null => 0 ); } } if ($debug && !$self->_debugged(++$debugs)) { $debug->show('Server Recv: '); } if (defined(${*$self}->{SOCKS}->{UserAuth})) { unless (&{ ${*$self}->{SOCKS}->{UserAuth} }($userid)) { push @{${*$self}->{SOCKS}->{queue}}, [ '_socks4_accept_command_reply', [ REQUEST_REJECTED_USERID, '0.0.0.0', 0 ], undef, [], 0, sub { $! = ESOCKSPROTO; $SOCKS_ERROR->set(REQUEST_REJECTED_USERID, $@ = 'Authentication failed with SOCKS4 proxy'); } ]; return 0; } } if ($ver != SOCKS4_VER) { $! = ESOCKSPROTO; $SOCKS_ERROR->set(ISS_BAD_VERSION, $@ = "Socks version should be 4, $ver recieved"); return; } @{ ${*$self}->{SOCKS}->{COMMAND} } = ($cmd, $dstaddr, $dstport, $atyp); return 1; } sub _socks4_accept_command_reply { my $self = shift; my $reply = shift; my $host = shift; my $port = shift; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my ($reads, $sends, $debugs) = (0, 0, 0); if (!defined($reply) || !defined($host) || !defined($port)) { croak("You must provide a reply, host, and port on the command reply."); } #-------------------------------------------------------------------------- # Send the reply #-------------------------------------------------------------------------- # +-----+-----+----------+---------------+ # | VER | REP | BND.PORT | BND.ADDR | # +-----+-----+----------+---------------+ # | 1 | 1 | 2 | 4 | # +-----+-----+----------+---------------+ my $bndaddr = inet_aton($host) or $SOCKS_ERROR->set(ISS_CANT_RESOLVE, $@ = "Can't resolve `$host'"), return; my $rc; $rc = $self->_socks_send(pack('CCna*', 0, $reply, $port, $bndaddr), ++$sends) or return _fail($rc); if ($debug && !$self->_debugged(++$debugs)) { $debug->add( ver => 0, rep => $reply, bndport => $port, bndaddr => length($bndaddr) == 4 ? inet_ntoa($bndaddr) : undef ); $debug->show('Server Send: '); } 1; } sub command { my $self = shift; unless (exists ${*$self}->{SOCKS}->{RequireAuth}) # TODO: find more correct way { return ${*$self}->{SOCKS}->{COMMAND}; } else { my @keys = qw(Version AuthType RequireAuth UserAuth Username Password Debug Resolve AuthMethods CmdAddr CmdPort Bind TCP); my %tmp; $tmp{$_} = ${*$self}->{SOCKS}->{$_} for @keys; my %args = @_; $self->_configure(\%args); if ($self->_connect()) { return 1; } ${*$self}->{SOCKS}->{$_} = $tmp{$_} for @keys; return 0; } } sub command_reply { my $self = shift; ${*$self}->{SOCKS}->{ready} = 0; if (${*$self}->{SOCKS}->{Version} == 4) { ${*$self}->{SOCKS}->{queue} = [ [ '_socks4_accept_command_reply', [@_], undef, [], 0 ] ]; } else { ${*$self}->{SOCKS}->{queue} = [ [ '_socks5_accept_command_reply', [@_], undef, [], 0 ] ]; } $self->_run_queue(); } sub dst { my $self = shift; my ($addr, $port, $atype) = @{ ${*$self}->{SOCKS} }{qw/DstAddr DstPort DstAddrType/}; return (_addr_ntoa($addr, $atype), $port, $atype); } sub send { my $self = shift; unless (defined ${*$self}->{SOCKS}->{TCP}) { return $self->SUPER::send(@_); } my ($msg, $flags, $peer) = @_; my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $SOCKS5_RESOLVE; croak "send: Cannot determine peer address" unless defined $peer; my ($dstport, $dstaddr, $dstaddr_type); if (ref $peer eq 'ARRAY') { $dstaddr = $peer->[0]; $dstport = $peer->[1]; $dstaddr_type = ADDR_DOMAINNAME; } else { unless (($dstport, $dstaddr, $dstaddr_type) = eval { (unpack_sockaddr_in($peer), ADDR_IPV4) }) { ($dstport, $dstaddr, $dstaddr_type) = ((unpack_sockaddr_in6($peer))[ 0, 1 ], ADDR_IPV6); } } my ($sndaddr, $sndport, $sndaddr_type) = $self->dst; if (($sndaddr eq '0.0.0.0' && $sndaddr_type == ADDR_IPV4) || ($sndaddr eq '::' && $sndaddr_type == ADDR_IPV6)) { $sndaddr = ${*$self}->{SOCKS}->{ProxyAddr}; $sndaddr_type = ADDR_DOMAINNAME; } if ($sndaddr_type == ADDR_DOMAINNAME) { ($sndaddr_type, $sndaddr) = _resolve($sndaddr) or $SOCKS_ERROR->set(ISS_CANT_RESOLVE, $@ = "Can't resolve `$sndaddr'"), return; } else { $sndaddr = ${*$self}->{SOCKS}->{DstAddr}; } $peer = $sndaddr_type == ADDR_IPV4 ? pack_sockaddr_in($sndport, $sndaddr) : pack_sockaddr_in6($sndport, $sndaddr); my $hlen; if ($dstaddr_type == ADDR_DOMAINNAME) { if ($resolve) { $hlen = length $dstaddr; } else { ($dstaddr_type, $dstaddr) = _resolve($dstaddr) or $SOCKS_ERROR->set(ISS_CANT_RESOLVE, $@ = "Can't resolve `$dstaddr'"), return; } } my $msglen = $debug ? length($msg) : 0; # we need to add socks header to the message # +----+------+------+----------+----------+----------+ # |RSV | FRAG | ATYP | DST.ADDR | DST.PORT | DATA | # +----+------+------+----------+----------+----------+ # | 2 | 1 | 1 | Variable | 2 | Variable | # +----+------+------+----------+----------+----------+ $msg = pack('C4', 0, 0, 0, $dstaddr_type) . (defined $hlen ? pack('C', $hlen) : '') . $dstaddr . pack('n', $dstport) . $msg; if ($debug) { $debug->add( rsv => '00', frag => '0', atyp => $dstaddr_type ); $debug->add(hlen => $hlen) if defined $hlen; $debug->add( dstaddr => defined $hlen ? $dstaddr : _addr_ntoa($dstaddr, $dstaddr_type), dstport => $dstport, data => "...($msglen)" ); $debug->show('Client Send: '); } $self->SUPER::send($msg, $flags, $peer); } sub recv { my $self = shift; unless (defined ${*$self}->{SOCKS}->{TCP}) { return $self->SUPER::recv(@_); } my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug}; defined($self->SUPER::recv($_[0], $_[1] + 262, $_[2])) or return; # we need to remove socks header from the message # +----+------+------+----------+----------+----------+ # |RSV | FRAG | ATYP | DST.ADDR | DST.PORT | DATA | # +----+------+------+----------+----------+----------+ # | 2 | 1 | 1 | Variable | 2 | Variable | # +----+------+------+----------+----------+----------+ my $rsv = join('', unpack('C2', $_[0])); substr($_[0], 0, 2) = ''; my ($frag, $atyp) = unpack('C2', $_[0]); substr($_[0], 0, 2) = ''; if ($debug) { $debug->add( rsv => $rsv, frag => $frag, atyp => $atyp ); } my $dstaddr; if ($atyp == ADDR_DOMAINNAME) { my $hlen = unpack('C', $_[0]); $dstaddr = substr($_[0], 1, $hlen); substr($_[0], 0, $hlen + 1) = ''; if ($debug) { $debug->add(hlen => $hlen); } } elsif ($atyp == ADDR_IPV4) { $dstaddr = substr($_[0], 0, 4); substr($_[0], 0, 4) = ''; } elsif ($atyp == ADDR_IPV6) { $dstaddr = substr($_[0], 0, 16); substr($_[0], 0, 16) = ''; } else { $! = ESOCKSPROTO; $SOCKS_ERROR->set(ISS_UNKNOWN_ADDRESS, $@ = "Unsupported address type returned by socks server: $atyp"); return; } my $dstport = unpack('n', $_[0]); substr($_[0], 0, 2) = ''; if ($debug) { $debug->add( dstaddr => _addr_ntoa($dstaddr, $atyp), dstport => $dstport, data => "...(" . length($_[0]) . ")" ); $debug->show('Client Recv: '); } return pack_sockaddr_in($dstport, $dstaddr) if $atyp == ADDR_IPV4; return pack_sockaddr_in6($dstport, $dstaddr) if $atyp == ADDR_IPV6; return [ $dstaddr, $dstport ]; } #+----------------------------------------------------------------------------- #| Helper Functions #+----------------------------------------------------------------------------- sub _socks_send { my $self = shift; my $data = shift; my $numb = shift; local $SIG{PIPE} = 'IGNORE'; $SOCKS_ERROR->set(); my $rc; my $writed = 0; my $blocking = ${*$self}{io_socket_timeout} ? $self->blocking(0) : $self->blocking; unless ($blocking || ${*$self}{io_socket_timeout}) { if (${*$self}->{SOCKS}->{queue}[0][Q_SENDS] >= $numb) { # already sent return 1; } if (defined ${*$self}->{SOCKS}->{queue}[0][Q_BUF]) { # some chunk already sent substr($data, 0, ${*$self}->{SOCKS}->{queue}[0][Q_BUF]) = ''; } while (length $data) { $rc = $self->syswrite($data); if (defined $rc) { if ($rc > 0) { ${*$self}->{SOCKS}->{queue}[0][Q_BUF] += $rc; substr($data, 0, $rc) = ''; } else { # XXX: socket closed? if smth writed, but not all? last; } } elsif ($! == EWOULDBLOCK || $! == EAGAIN) { $SOCKS_ERROR->set(SOCKS_WANT_WRITE, 'Socks want write'); return undef; } else { $SOCKS_ERROR->set($!, $@ = "send: $!"); last; } } $writed = int(${*$self}->{SOCKS}->{queue}[0][Q_BUF]); ${*$self}->{SOCKS}->{queue}[0][Q_BUF] = undef; ${*$self}->{SOCKS}->{queue}[0][Q_SENDS]++; return $writed; } my $selector = IO::Select->new($self); my $start = time(); while (1) { if (${*$self}{io_socket_timeout} && time() - $start >= ${*$self}{io_socket_timeout}) { $! = ETIMEDOUT; last; } unless ($selector->can_write(1)) { # socket couldn't accept data for now, check if timeout expired and try again next; } $rc = $self->syswrite($data); if ($rc > 0) { # reduce our message $writed += $rc; substr($data, 0, $rc) = ''; if (length($data) == 0) { # all data successfully writed last; } } else { # some error in the socket; will return false $SOCKS_ERROR->set($!, $@ = "send: $!") unless defined $rc; last; } } $self->blocking(1) if $blocking; return $writed; } sub _socks_read { my $self = shift; my $length = shift || 1; my $numb = shift; $SOCKS_ERROR->set(); my $data = ''; my ($buf, $rc); my $blocking = $self->blocking; # non-blocking read unless ($blocking || ${*$self}{io_socket_timeout}) { # no timeout should be specified for non-blocking connect if (defined ${*$self}->{SOCKS}->{queue}[0][Q_READS][$numb]) { # already readed return ${*$self}->{SOCKS}->{queue}[0][Q_READS][$numb]; } if (defined ${*$self}->{SOCKS}->{queue}[0][Q_BUF]) { # some chunk already readed $data = ${*$self}->{SOCKS}->{queue}[0][Q_BUF]; $length -= length $data; } while ($length > 0) { $rc = $self->sysread($buf, $length); if (defined $rc) { if ($rc > 0) { $length -= $rc; $data .= $buf; } else { # XXX: socket closed, if smth readed but not all? last; } } elsif ($! == EWOULDBLOCK || $! == EAGAIN) { # no data to read if (length $data) { # save already readed data in the queue buffer ${*$self}->{SOCKS}->{queue}[0][Q_BUF] = $data; } $SOCKS_ERROR->set(SOCKS_WANT_READ, 'Socks want read'); return undef; } else { $SOCKS_ERROR->set($!, $@ = "read: $!"); last; } } ${*$self}->{SOCKS}->{queue}[0][Q_BUF] = undef; ${*$self}->{SOCKS}->{queue}[0][Q_READS][$numb] = $data; return $data; } # blocking read my $selector = IO::Select->new($self); my $start = time(); while ($length > 0) { if (${*$self}{io_socket_timeout} && time() - $start >= ${*$self}{io_socket_timeout}) { $! = ETIMEDOUT; last; } unless ($selector->can_read(1)) { # no data in socket for now, check if timeout expired and try again next; } $rc = $self->sysread($buf, $length); if (defined $rc && $rc > 0) { # reduce limit and modify buffer $length -= $rc; $data .= $buf; } else { # EOF or error in the socket $SOCKS_ERROR->set($!, $@ = "read: $!") unless defined $rc; last; # TODO handle unexpected EOF more correct } } # XXX it may return incomplete $data if timed out. Could it break smth? return $data; } sub _debugged { my ($self, $debugs) = @_; if (${*$self}->{SOCKS}->{queue}[0][Q_DEBUGS] >= $debugs) { return 1; } ${*$self}->{SOCKS}->{queue}[0][Q_DEBUGS] = $debugs; return 0; } sub _fail { if (!@_ || defined($_[0])) { $SOCKS_ERROR->set(ECONNABORTED, $@ = 'Socket closed by remote side') if $SOCKS_ERROR == undef; return; } return -1; } sub _validate_multi_version { my $multi_ver = shift; if (@$multi_ver == 1) { return $multi_ver->[0] == 4 || $multi_ver->[0] == 5; } if (@$multi_ver == 2) { return $multi_ver->[0] != $multi_ver->[1] && ($multi_ver->[0] == 4 || $multi_ver->[0] == 5) && ($multi_ver->[1] == 4 || $multi_ver->[1] == 5); } return; } sub _resolve { my $addr = shift; my ($err, @res) = Socket::getaddrinfo($addr, undef, { protocol => Socket::IPPROTO_TCP, socktype => Socket::SOCK_STREAM }); return if $err; for my $r (@res) { if ($r->{family} == PF_INET) { return (ADDR_IPV4, (unpack_sockaddr_in($r->{addr}))[1]); } } return (ADDR_IPV6, (unpack_sockaddr_in6($res[0]{addr}))[1]); } sub _addr_ntoa { my ($addr, $atype) = @_; return inet_ntoa($addr) if ($atype == ADDR_IPV4); return Socket::inet_ntop(AF_INET6, $addr) if ($atype == ADDR_IPV6); return $addr; } ############################################################################### #+----------------------------------------------------------------------------- #| Helper Package to bring some magic in $SOCKS_ERROR #+----------------------------------------------------------------------------- ############################################################################### package IO::Socket::Socks::Error; use overload '==' => \&num_eq, '!=' => sub { !num_eq(@_) }, '""' => \&as_str, '0+' => \&as_num; sub new { my ($class, $num, $str) = @_; my $self = { num => $num, str => $str, }; bless $self, $class; } sub set { my ($self, $num, $str) = @_; $self->{num} = defined $num ? int($num) : $num; $self->{str} = $str; } sub as_str { my $self = shift; return $self->{str}; } sub as_num { my $self = shift; return $self->{num}; } sub num_eq { my ($self, $num) = @_; unless (defined $num) { return !defined($self->{num}); } return $self->{num} == int($num); } ############################################################################### #+----------------------------------------------------------------------------- #| Helper Package to prevent modifications of $SOCKS_ERROR outside this package #+----------------------------------------------------------------------------- ############################################################################### package IO::Socket::Socks::ReadOnlyVar; sub TIESCALAR { my ($class, $value) = @_; bless \$value, $class; } sub FETCH { my $self = shift; return $$self; } *STORE = *UNTIE = sub { Carp::croak 'Modification of readonly value attempted' }; ############################################################################### #+----------------------------------------------------------------------------- #| Helper Package to handle assigning of $SOCKET_CLASS #+----------------------------------------------------------------------------- ############################################################################### package IO::Socket::Socks::SocketClassVar; sub TIESCALAR { my ($class, $value) = @_; bless { v => $value }, $class; } sub FETCH { return $_[0]->{v}; } sub STORE { my ($self, $class) = @_; $self->{v} = $class; eval "use $class; 1" or die $@; $IO::Socket::Socks::ISA[1] = $class; } sub UNTIE { Carp::croak 'Untie of tied variable is denied'; } ############################################################################### #+----------------------------------------------------------------------------- #| Helper Package to display pretty debug messages #+----------------------------------------------------------------------------- ############################################################################### package IO::Socket::Socks::Debug; sub new { my ($class) = @_; my $self = []; bless $self, $class; } sub add { my $self = shift; push @{$self}, @_; } sub show { my ($self, $tag) = @_; $self->_separator($tag); $self->_row(0, $tag); $self->_separator($tag); $self->_row(1, $tag); $self->_separator($tag); print STDERR "\n"; @{$self} = (); } sub _separator { my $self = shift; my $tag = shift; my ($row1_len, $row2_len, $len); print STDERR $tag, '+'; for (my $i = 0 ; $i < @$self ; $i += 2) { $row1_len = length($self->[$i]); $row2_len = length($self->[ $i + 1 ]); $len = ($row1_len > $row2_len ? $row1_len : $row2_len) + 2; print STDERR '-' x $len, '+'; } print STDERR "\n"; } sub _row { my $self = shift; my $row = shift; my $tag = shift; my ($row1_len, $row2_len, $len); print STDERR $tag, '|'; for (my $i = 0 ; $i < @$self ; $i += 2) { $row1_len = length($self->[$i]); $row2_len = length($self->[ $i + 1 ]); $len = ($row1_len > $row2_len ? $row1_len : $row2_len); printf STDERR ' %-' . $len . 's |', $self->[ $i + $row ]; } print STDERR "\n"; } 1; __END__ =head1 NAME IO::Socket::Socks - Provides a way to create socks client or server both 4 and 5 version. =head1 SYNOPSIS =head2 Client use IO::Socket::Socks; my $socks_client = IO::Socket::Socks->new( ProxyAddr => "proxy host", ProxyPort => "proxy port", ConnectAddr => "remote host", ConnectPort => "remote port", ) or die $SOCKS_ERROR; print $socks_client "foo\n"; $socks_client->close(); =head2 Server use IO::Socket::Socks ':constants'; my $socks_server = IO::Socket::Socks->new( ProxyAddr => "localhost", ProxyPort => 8000, Listen => 1, UserAuth => \&auth, RequireAuth => 1 ) or die $SOCKS_ERROR; while(1) { my $client = $socks_server->accept(); unless ($client) { print "ERROR: $SOCKS_ERROR\n"; next; } my $command = $client->command(); if ($command->[0] == CMD_CONNECT) { # Handle the CONNECT $client->command_reply(REPLY_SUCCESS, addr, port); } ... #read from the client and send to the CONNECT address ... $client->close(); } sub auth { my ($user, $pass) = @_; return 1 if $user eq "foo" && $pass eq "bar"; return 0; } =head1 DESCRIPTION C connects to a SOCKS proxy, tells it to open a connection to a remote host/port when the object is created. The object you receive can be used directly as a socket (with C interface) for sending and receiving data from the remote host. In addition to create socks client this module could be used to create socks server. See examples below. =head1 EXAMPLES For complete examples of socks 4/5 client and server see `examples' subdirectory in the distribution. =head1 METHODS =head2 Socks Client =head3 new( %cfg ) =head3 new_from_socket($socket, %cfg) =head3 new_from_fd($socket, %cfg) Creates a new IO::Socket::Socks client object. new_from_socket() is the same as new(), but allows one to create object from an existing and not connected socket (new_from_fd is new_from_socket alias). To make IO::Socket::Socks object from connected socket see C Both takes the following config hash: SocksVersion => 4 or 5. Default is 5 Timeout => connect/accept timeout Blocking => Since IO::Socket::Socks version 0.5 you can perform non-blocking connect/bind by passing false value for this option. Default is true - blocking. See ready() below for more details. SocksResolve => resolve host name to ip by proxy server or not (will resolve by client). This overrides value of $SOCKS4_RESOLVE or $SOCKS5_RESOLVE variable. Boolean. SocksDebug => This will cause all of the SOCKS traffic to be presented on the command line in a form similar to the tables in the RFCs. This overrides value of $SOCKS_DEBUG variable. Boolean. ProxyAddr => Hostname of the proxy ProxyPort => Port of the proxy ConnectAddr => Hostname of the remote machine ConnectPort => Port of the remote machine BindAddr => Hostname of the remote machine which will connect to the proxy server after bind request BindPort => Port of the remote machine which will connect to the proxy server after bind request UdpAddr => Associate UDP socket on the server with this client hostname UdpPort => Associate UDP socket on the server with this client port AuthType => What kind of authentication to support: none - no authentication (default) userpass - Username/Password. For socks5 proxy only. RequireAuth => Do not send ANON as a valid auth mechanism. For socks5 proxy only Username => For socks5 if AuthType is set to userpass, then you must provide a username. For socks4 proxy with this option you can specify userid. Password => If AuthType is set to userpass, then you must provide a password. For socks5 proxy only. The following options should be specified: (ProxyAddr and ProxyPort) (ConnectAddr and ConnectPort) or (BindAddr and BindPort) or (UdpAddr and UdpPort) Other options are facultative. =head3 start_SOCKS($socket, %cfg) This is a class method to start socks handshake on already connected socket. This will bless passed $socket to IO::Socket::Socks class. %cfg is like hash in the constructor. Only options listed below makes sence: Timeout ConnectAddr ConnectPort BindAddr BindPort UdpAddr UdpPort SocksVersion SocksDebug SocksResolve AuthType RequireAuth Username Password AuthMethods On success this method will return same $socket, but as IO::Socket::Socks object. On failure it will return undef (but socket will be still blessed to IO::Socket::Socks class). See example: use IO::Socket; use IO::Socket::Socks; my $sock = IO::Socket::INET->new("$proxy_host:$proxy_port") or die $@; $sock = IO::Socket::Socks->start_SOCKS($sock, ConnectAddr => "google.com", ConnectPort => 80) or die $SOCKS_ERROR; =head3 version( ) Returns socks version for this socket =head3 ready( ) Returns true when socket becomes ready to transfer data (socks handshake done), false otherwise. This is useful for non-blocking connect/bind. When this method returns false value you can determine what socks handshake need for with $SOCKS_ERROR variable. It may need for read, then $SOCKS_ERROR will be SOCKS_WANT_READ or need for write, then it will be SOCKS_WANT_WRITE. Example: use IO::Socket::Socks; use IO::Select; my $sock = IO::Socket::Socks->new( ProxyAddr => 'localhost', ProxyPort => 1080, ConnectAddr => 'mail.com', ConnectPort => 80, Blocking => 0 ) or die $SOCKS_ERROR; my $sel = IO::Select->new($sock); until ($sock->ready) { if ($SOCKS_ERROR == SOCKS_WANT_READ) { $sel->can_read(); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $sel->can_write(); } else { die $SOCKS_ERROR; } } # you may want to return socket to blocking state by $sock->blocking(1) $sock->syswrite("I am ready"); =head3 accept( ) Accept an incoming connection after bind request. On failed returns undef. On success returns socket. No new socket created, returned socket is same on which this method was called. Because accept(2) is not invoked on the client side, socks server calls accept(2) and proxify all traffic via socket opened by client bind request. You can call accept only once on IO::Socket::Socks client socket. =head3 command( %cfg ) Allows one to execute socks command on already opened socket. Thus you can create socks chain. For example see L section. %cfg is like hash in the constructor. Only options listed below makes sence: ConnectAddr ConnectPort BindAddr BindPort UdpAddr UdpPort SocksVersion SocksDebug SocksResolve AuthType RequireAuth Username Password AuthMethods Values of the other options (Timeout for example) inherited from the constructor. Options like ProxyAddr and ProxyPort are not included. =head3 dst( ) Return (host, port, address_type) of the remote host after connect/accept or socks server (host, port, address_type) after bind/udpassoc. =head2 Socks Server =head3 new( %cfg ) =head3 new_from_socket($socket, %cfg) =head3 new_from_fd($socket, %cfg) Creates a new IO::Socket::Socks server object. new_from_socket() is the same as new(), but allows one to create object from an existing socket (new_from_fd is new_from_socket alias). Both takes the following config hash: SocksVersion => 4 for socks4, 5 for socks5 or [4,5] if you want accept both 4 and 5. Default is 5 Timeout => Timeout value for various operations Blocking => Since IO::Socket::Socks version 0.6 you can perform non-blocking accept by passing false value for this option. Default is true - blocking. See ready() below for more details. SocksResolve => For socks v5: return destination address to the client in form of 4 bytes if true, otherwise in form of host length and host name. For socks v4: allow use socks4a protocol extension if true and not otherwise. This overrides value of $SOCKS4_RESOLVE or $SOCKS5_RESOLVE. See also command_reply(). SocksDebug => This will cause all of the SOCKS traffic to be presented on the command line in a form similar to the tables in the RFCs. This overrides value of $SOCKS_DEBUG variable. Boolean. ProxyAddr => Local host bind address ProxyPort => Local host bind port UserAuth => Reference to a function that returns 1 if client allowed to use socks server, 0 otherwise. For socks5 proxy it takes login and password as arguments. For socks4 argument is userid. RequireAuth => Not allow anonymous access for socks5 proxy. Listen => Same as IO::Socket::INET listen option. Should be specified as number > 0. The following options should be specified: Listen ProxyAddr ProxyPort Other options are facultative. =head3 accept( ) Accept an incoming connection and return a new IO::Socket::Socks object that represents that connection. You must call command() on this to find out what the incoming connection wants you to do, and then call command_reply() to send back the reply. =head3 version( ) Returns socks version for socket. It is useful when your server accepts both 4 and 5 version. Then you should know socks version to make proper response. Just call C on socket received after C. =head3 ready( ) After non-blocking accept you will get new client socket object, which may be not ready to transfer data (if socks handshake is not done yet). ready() will return true value when handshake will be done successfully and false otherwise. Note, socket returned by accept() call will be always in blocking mode. So if your program can't block you should set non-blocking mode for this socket before ready() call: $socket->blocking(0). When ready() returns false value you can determine what socks handshake needs for with $SOCKS_ERROR variable. It may need for read, then $SOCKS_ERROR will be SOCKS_WANT_READ or need for write, then it will be SOCKS_WANT_WRITE. Example: use IO::Socket::Socks; use IO::Select; my $server = IO::Socket::Socks->new(ProxyAddr => 'localhost', ProxyPort => 1080, Blocking => 0) or die $@; my $select = IO::Select->new($server); $select->can_read(); # wait for client my $client = $server->accept() or die "accept(): $! ($SOCKS_ERROR)"; $client->blocking(0); # !!! $select->add($client); $select->remove($server); # no more connections while (1) { if ($client->ready) { my $command = $client->command; ... # do client command $client->command_reply(IO::Socket::Socks::REPLY_SUCCESS, $command->[1], $command->[2]); ... # transfer traffic last; } elsif ($SOCKS_ERROR == SOCKS_WANT_READ) { $select->can_read(); } elsif ($SOCKS_ERROR == SOCKS_WANT_WRITE) { $select->can_write(); } else { die "Unexpected error: $SOCKS_ERROR"; } } =head3 command( ) After you call accept() the client has sent the command they want you to process. This function should be called on the socket returned by accept(). It returns a reference to an array with the following format: [ COMMAND, ADDRESS, PORT, ADDRESS TYPE ] =head3 command_reply( REPLY CODE, ADDRESS, PORT ) After you call command() the client needs to be told what the result is. The REPLY CODE is one of the constants as follows (integer value): For socks v4 REQUEST_GRANTED(90): request granted REQUEST_FAILED(91): request rejected or failed REQUEST_REJECTED_IDENTD(92): request rejected becasue SOCKS server cannot connect to identd on the client REQUEST_REJECTED_USERID(93): request rejected because the client program and identd report different user-ids For socks v5 REPLY_SUCCESS(0): Success REPLY_GENERAL_FAILURE(1): General Failure REPLY_CONN_NOT_ALLOWED(2): Connection Not Allowed REPLY_NETWORK_UNREACHABLE(3): Network Unreachable REPLY_HOST_UNREACHABLE(4): Host Unreachable REPLY_CONN_REFUSED(5): Connection Refused REPLY_TTL_EXPIRED(6): TTL Expired REPLY_CMD_NOT_SUPPORTED(7): Command Not Supported REPLY_ADDR_NOT_SUPPORTED(8): Address Not Supported HOST and PORT are the resulting host and port (where server socket responsible for this command bound). Note: for 5 version C will try to resolve passed address if C has true value and passed address is domain name. To avoid this just pass ip address (C<$socket-Esockhost>) instead of host name or turn off C for this server. For version 4 passed host name will always be resolved to ip address even if C has false value. Because this version doesn't support C
as domain name. =head1 VARIABLES =head2 $SOCKS_ERROR This scalar behaves like $! in that if undef is returned. C<$SOCKS_ERROR> is IO::Socket::Socks::Error object with some overloaded operators. In string context this variable should contain a string reason for the error. In numeric context it contains error code. =head2 $SOCKS4_RESOLVE If this variable has true value resolving of host names will be done by proxy server, otherwise resolving will be done locally. Resolving host by socks proxy version 4 is extension to the protocol also known as socks4a. So, only socks4a proxy supports resolving of hostnames. Default value of this variable is false. This variable is not importable. See also `SocksResolve' parameter in the constructor. =head2 $SOCKS5_RESOLVE If this variable has true value resolving of host names will be done by proxy server, otherwise resolving will be done locally. Note: some bugous socks5 servers doesn't support resolving of host names. Default value is true. This variable is not importable. See also `SocksResolve' parameter in the constructor. =head2 $SOCKS_DEBUG Default value is $ENV{SOCKS_DEBUG}. If this variable has true value and no SocksDebug option in the constructor specified, then SocksDebug will has true value. This variable is not importable. =head2 $SOCKET_CLASS With this variable you can get/set base socket class for C. By default it tries to use C 0.36+ as socket class. And falls back to C if not available. You can set C<$IO::Socket::Socks::SOCKET_CLASS> before loading of C and then it will not try to detect proper base class itself. You can also set it after loading of C and this will automatically update C<@ISA>, so you shouldn't worry about inheritence. =head1 CONSTANTS The following constants could be imported manually or using `:constants' tag: SOCKS5_VER SOCKS4_VER ADDR_IPV4 ADDR_DOMAINNAME ADDR_IPV6 CMD_CONNECT CMD_BIND CMD_UDPASSOC AUTHMECH_ANON AUTHMECH_USERPASS AUTHMECH_INVALID AUTHREPLY_SUCCESS AUTHREPLY_FAILURE ISS_UNKNOWN_ADDRESS # address type sent by client/server not supported by I::S::S ISS_BAD_VERSION # socks version sent by client/server != specified version ISS_CANT_RESOLVE # I::S::S failed to resolve some host REPLY_SUCCESS REPLY_GENERAL_FAILURE REPLY_CONN_NOT_ALLOWED REPLY_NETWORK_UNREACHABLE REPLY_HOST_UNREACHABLE REPLY_CONN_REFUSED REPLY_TTL_EXPIRED REPLY_CMD_NOT_SUPPORTED REPLY_ADDR_NOT_SUPPORTED REQUEST_GRANTED REQUEST_FAILED REQUEST_REJECTED_IDENTD REQUEST_REJECTED_USERID SOCKS_WANT_READ SOCKS_WANT_WRITE ESOCKSPROTO SOCKS_WANT_READ, SOCKS_WANT_WRITE and ESOCKSPROTO are imported by default. =head1 IPv6 Since version 0.66 C supports IPv6 with help of L 0.36+. And will use C as base class if available. However you can force set C<$SOCKET_CLASS = "IO::Socket::INET"> to use IPv4 only. See also L =head1 FAQ =over =item How to determine is connection to socks server (client accept) failed or some protocol error occurred? You can check $! variable. If $! == ESOCKSPROTO constant, then it was error in the protocol. Error description could be found in $SOCKS_ERROR. =item How to determine which error in the protocol occurred? You should compare C<$SOCKS_ERROR> with constants below: AUTHMECH_INVALID AUTHREPLY_FAILURE ISS_UNKNOWN_ADDRESS ISS_BAD_VERSION REPLY_GENERAL_FAILURE REPLY_CONN_NOT_ALLOWED REPLY_NETWORK_UNREACHABLE REPLY_HOST_UNREACHABLE REPLY_CONN_REFUSED REPLY_TTL_EXPIRED REPLY_CMD_NOT_SUPPORTED REPLY_ADDR_NOT_SUPPORTED REQUEST_FAILED REQUEST_REJECTED_IDENTD REQUEST_REJECTED_USERID =back =head1 BUGS The following options are not implemented: =over =item GSSAPI authentication =item UDP server side support =back Patches are welcome. =head1 SEE ALSO L =head1 AUTHOR Original author is Ryan Eatmon Now maintained by Oleg G =head1 COPYRIGHT This module is free software, you can redistribute it and/or modify it under the terms of LGPL. =cut IO-Socket-Socks-0.67/Makefile.PL0000644000175000017500000000154512456113516014704 0ustar olegoleguse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'IO::Socket::Socks', 'LICENSE' => 'lgpl', 'PREREQ_PM' => { 'Socket' => 1.94, 'IO::Select' => 0, 'constant' => 1.03 }, 'BUILD_REQUIRES' => { 'Test::More' => 0.88 }, 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => 6.52 }, 'META_MERGE' => { resources => {repository => 'https://github.com/olegwtf/p5-IO-Socket-Socks'} }, 'VERSION_FROM' => 'lib/IO/Socket/Socks.pm', ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/IO/Socket/Socks.pm', # retrieve abstract from module AUTHOR => 'Oleg G ') : ()), 'dist' => { 'COMPRESS' => 'gzip --best' } ); IO-Socket-Socks-0.67/README0000644000175000017500000000036012365213154013602 0ustar olegolegThis module seeks to provide a full implementation of the SOCKS protocol while behaving like a regular socket as much as possible. Ryan Eatmon reatmon@mail.com Oleg G oleg@cpan.org INSTALLATION perl Makefile.PL make make install IO-Socket-Socks-0.67/META.yml0000644000175000017500000000120012502333413014157 0ustar olegoleg--- abstract: 'Provides a way to create socks client or server both 4 and 5 version.' author: - 'Oleg G ' build_requires: Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '6.52' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7, CPAN::Meta::Converter version 2.143240' license: open_source meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: IO-Socket-Socks no_index: directory: - t - inc requires: IO::Select: '0' Socket: '1.94' constant: '1.03' resources: repository: https://github.com/olegwtf/p5-IO-Socket-Socks version: '0.67' IO-Socket-Socks-0.67/META.json0000644000175000017500000000210612502333413014335 0ustar olegoleg{ "abstract" : "Provides a way to create socks client or server both 4 and 5 version.", "author" : [ "Oleg G " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7, CPAN::Meta::Converter version 2.143240", "license" : [ "open_source" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "IO-Socket-Socks", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0.88" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.52" } }, "runtime" : { "requires" : { "IO::Select" : "0", "Socket" : "1.94", "constant" : "1.03" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/olegwtf/p5-IO-Socket-Socks" } }, "version" : "0.67" }