r68272 - in /branches/upstream/libio-socket-socks-perl/current: CHANGES MANIFEST README examples/bind.pl examples/chain.pl examples/client4.pl examples/client5.pl examples/server4.pl examples/server5.pl examples/udp.pl lib/IO/Socket/Socks.pm
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Thu Feb 10 14:44:28 UTC 2011
Author: periapt-guest
Date: Thu Feb 10 14:44:13 2011
New Revision: 68272
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=68272
Log:
[svn-upgrade] new version libio-socket-socks-perl (0.4)
Added:
branches/upstream/libio-socket-socks-perl/current/examples/chain.pl
branches/upstream/libio-socket-socks-perl/current/examples/udp.pl (with props)
Modified:
branches/upstream/libio-socket-socks-perl/current/CHANGES
branches/upstream/libio-socket-socks-perl/current/MANIFEST
branches/upstream/libio-socket-socks-perl/current/README
branches/upstream/libio-socket-socks-perl/current/examples/bind.pl
branches/upstream/libio-socket-socks-perl/current/examples/client4.pl
branches/upstream/libio-socket-socks-perl/current/examples/client5.pl
branches/upstream/libio-socket-socks-perl/current/examples/server4.pl
branches/upstream/libio-socket-socks-perl/current/examples/server5.pl
branches/upstream/libio-socket-socks-perl/current/lib/IO/Socket/Socks.pm
Modified: branches/upstream/libio-socket-socks-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/CHANGES?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/CHANGES (original)
+++ branches/upstream/libio-socket-socks-perl/current/CHANGES Thu Feb 10 14:44:13 2011
@@ -1,3 +1,9 @@
+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)
Modified: branches/upstream/libio-socket-socks-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/MANIFEST?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/MANIFEST (original)
+++ branches/upstream/libio-socket-socks-perl/current/MANIFEST Thu Feb 10 14:44:13 2011
@@ -9,6 +9,7 @@
examples/client5.pl
examples/server5.pl
examples/bind.pl
+examples/udp.pl
lib/IO/Socket/Socks.pm
t/1_load.t
t/2_new.t
Modified: branches/upstream/libio-socket-socks-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/README?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/README (original)
+++ branches/upstream/libio-socket-socks-perl/current/README Thu Feb 10 14:44:13 2011
@@ -1,4 +1,4 @@
-IO::Socket::Socks v0.3
+IO::Socket::Socks v0.4
This module seeks to provide a full implementation of the SOCKS protocol
while behaving like a regular socket as much as possible.
@@ -16,4 +16,4 @@
make
make install
-2011/01/15
+2011/02/02
Modified: branches/upstream/libio-socket-socks-perl/current/examples/bind.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/examples/bind.pl?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/examples/bind.pl (original)
+++ branches/upstream/libio-socket-socks-perl/current/examples/bind.pl Thu Feb 10 14:44:13 2011
@@ -1,10 +1,10 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
use lib '../lib';
use IO::Socket::Socks;
use strict;
-# example of using socks bind with FTP active control connection
+# example of using socks bind with FTP active data connection
use constant
{
@@ -16,22 +16,24 @@
SOCKS_PORT => 1080
};
-# create primary connection
+# 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 secondary connection
+# 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;
Added: branches/upstream/libio-socket-socks-perl/current/examples/chain.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/examples/chain.pl?rev=68272&op=file
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/examples/chain.pl (added)
+++ branches/upstream/libio-socket-socks-perl/current/examples/chain.pl Thu Feb 10 14:44:13 2011
@@ -1,0 +1,92 @@
+use 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($SOCKS_ERROR eq '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;
+}
Modified: branches/upstream/libio-socket-socks-perl/current/examples/client4.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/examples/client4.pl?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/examples/client4.pl (original)
+++ branches/upstream/libio-socket-socks-perl/current/examples/client4.pl Thu Feb 10 14:44:13 2011
@@ -1,9 +1,10 @@
-#!/usr/bin/perl
+#!/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;
@@ -11,7 +12,7 @@
#$IO::Socket::Socks::SOCKS4_RESOLVE = 1;
my $socks = new IO::Socket::Socks(ProxyAddr=>"127.0.0.1",
- ProxyPort=>"1090",
+ ProxyPort=>"1080",
ConnectAddr=>"www.google.com",
ConnectPort=>80,
Username=>"oleg", # most socks4 servers doesn't needs userid, you can comment this
Modified: branches/upstream/libio-socket-socks-perl/current/examples/client5.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/examples/client5.pl?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/examples/client5.pl (original)
+++ branches/upstream/libio-socket-socks-perl/current/examples/client5.pl Thu Feb 10 14:44:13 2011
@@ -1,9 +1,10 @@
-#!/usr/bin/perl
+#!/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;
@@ -11,7 +12,7 @@
#$IO::Socket::Socks::SOCKS5_RESOLVE = 0;
my $socks = new IO::Socket::Socks(ProxyAddr=>"127.0.0.1",
- ProxyPort=>"1090",
+ ProxyPort=>"1080",
ConnectAddr=>"www.google.com",
ConnectPort=>80,
# uncomment lines below if you want to use authentication
Modified: branches/upstream/libio-socket-socks-perl/current/examples/server4.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/examples/server4.pl?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/examples/server4.pl (original)
+++ branches/upstream/libio-socket-socks-perl/current/examples/server4.pl Thu Feb 10 14:44:13 2011
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
# Simple socks4 server
# implemented with IO::Socket::Socks module
@@ -12,7 +12,7 @@
$IO::Socket::Socks::SOCKS4_RESOLVE = 1;
# create socks server
-my $server = IO::Socket::Socks->new(SocksVersion => 4, SocksDebug => 1, ProxyAddr => 'localhost', ProxyPort => 1090, Listen => 10)
+my $server = IO::Socket::Socks->new(SocksVersion => 4, SocksDebug => 1, ProxyAddr => 'localhost', ProxyPort => 1080, Listen => 10)
or die $SOCKS_ERROR;
# accept connections
Modified: branches/upstream/libio-socket-socks-perl/current/examples/server5.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/examples/server5.pl?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/examples/server5.pl (original)
+++ branches/upstream/libio-socket-socks-perl/current/examples/server5.pl Thu Feb 10 14:44:13 2011
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
use lib '../lib';
use IO::Socket::Socks qw(:constants $SOCKS_ERROR);
@@ -6,10 +6,10 @@
use strict;
# return bind address as ip address like most socks5 proxyes does
-$IO::Socket::Socks::SOCKS5_RESOLVE = 0;
+$IO::Socket::Socks::SOCKS5_RESOLVE = 1;
# create socks server
-my $server = IO::Socket::Socks->new(SocksVersion => 5, SocksDebug => 1, ProxyAddr => 'localhost', ProxyPort => 1090, Listen => 10)
+my $server = IO::Socket::Socks->new(SocksVersion => 5, SocksDebug => 1, ProxyAddr => 'localhost', ProxyPort => 1080, Listen => 10)
or die $SOCKS_ERROR;
# accept connections
@@ -134,6 +134,14 @@
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';
Added: branches/upstream/libio-socket-socks-perl/current/examples/udp.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/examples/udp.pl?rev=68272&op=file
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/examples/udp.pl (added)
+++ branches/upstream/libio-socket-socks-perl/current/examples/udp.pl Thu Feb 10 14:44:13 2011
@@ -1,0 +1,25 @@
+#!/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;
Propchange: branches/upstream/libio-socket-socks-perl/current/examples/udp.pl
------------------------------------------------------------------------------
svn:executable = *
Modified: branches/upstream/libio-socket-socks-perl/current/lib/IO/Socket/Socks.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-socks-perl/current/lib/IO/Socket/Socks.pm?rev=68272&op=diff
==============================================================================
--- branches/upstream/libio-socket-socks-perl/current/lib/IO/Socket/Socks.pm (original)
+++ branches/upstream/libio-socket-socks-perl/current/lib/IO/Socket/Socks.pm Thu Feb 10 14:44:13 2011
@@ -38,6 +38,7 @@
ADDR_IPV6
CMD_CONNECT
CMD_BIND
+ CMD_UDPASSOC
AUTHMECH_ANON
AUTHMECH_USERPASS
AUTHMECH_INVALID
@@ -65,6 +66,7 @@
ADDR_IPV6
CMD_CONNECT
CMD_BIND
+ CMD_UDPASSOC
AUTHMECH_ANON
AUTHMECH_USERPASS
AUTHMECH_INVALID
@@ -85,7 +87,7 @@
REQUEST_REJECTED_USERID
)]);
-$VERSION = "0.3";
+$VERSION = "0.4";
$SOCKS5_RESOLVE = 1;
$SOCKS4_RESOLVE = 0;
@@ -98,7 +100,7 @@
use constant CMD_CONNECT => 1;
use constant CMD_BIND => 2;
-#use constant CMD_UDPASSOC => 3;
+use constant CMD_UDPASSOC => 3;
use constant AUTHMECH_ANON => 0;
#use constant AUTHMECH_GSSAPI => 1;
@@ -148,6 +150,19 @@
#------------------------------------------------------------------------------
# sub new is handled by IO::Socket::INET
#------------------------------------------------------------------------------
+sub new_from_socket
+{
+ my ($class, $sock, %arg) = @_;
+
+ bless $sock, $class;
+
+ $sock->autoflush(1);
+ ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+ return scalar(%arg) ? $sock->configure(\%arg)
+ : $sock;
+}
+
###############################################################################
#
@@ -158,7 +173,61 @@
{
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;
+ }
+
+ $self->SUPER::configure($args);
+}
+
+###############################################################################
+#
+# _configure - reusable configure operations
+#
+###############################################################################
+sub _configure
+{
+ my $self = shift;
+ my $args = shift;
+
${*$self}->{SOCKS}->{Version} =
(exists($args->{SocksVersion}) ?
($args->{SocksVersion} == 4 || $args->{SocksVersion} == 5 ?
@@ -166,18 +235,6 @@
croak("Unsupported socks version specified. Should be 4 or 5")
) :
5
- );
-
- ${*$self}->{SOCKS}->{ProxyAddr} =
- (exists($args->{ProxyAddr}) ?
- delete($args->{ProxyAddr}) :
- croak("You must provide a ProxyAddr to either connect to, or listen on.")
- );
-
- ${*$self}->{SOCKS}->{ProxyPort} =
- (exists($args->{ProxyPort}) ?
- delete($args->{ProxyPort}) :
- croak("You must provide a ProxyPort to either connect to, or listen on.")
);
${*$self}->{SOCKS}->{AuthType} =
@@ -238,51 +295,35 @@
(${*$self}->{SOCKS}->{AuthType} eq "userpass")) ||
(exists($args->{Listen}) &&
defined(${*$self}->{SOCKS}->{UserAuth})));
-
- ${*$self}->{SOCKS}->{COMMAND} = [];
-
+
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});
}
- elsif(!exists($args->{Listen}))
- {
- croak("You must provide ConnectAddr and ConnectPort or BindAddr and BindPort");
- }
-
- if (exists($args->{Listen}))
- {
- ${*$self}->{SOCKS}->{Listen} = 1;
- $args->{LocalAddr} = ${*$self}->{SOCKS}->{ProxyAddr};
- $args->{LocalPort} = ${*$self}->{SOCKS}->{ProxyPort};
- $args->{Reuse} = 1;
- }
- else
- {
- $args->{PeerAddr} = ${*$self}->{SOCKS}->{ProxyAddr};
- $args->{PeerPort} = ${*$self}->{SOCKS}->{ProxyPort};
- }
-
- $args->{Proto} = "tcp";
- $args->{Type} = SOCK_STREAM;
-
- my $status = $self->SUPER::configure($args);
- return unless $status;
-
- #--------------------------------------------------------------------------
- # We are configured... Return the object.
- #--------------------------------------------------------------------------
- return $status;
-}
-
-
+
+ return 1;
+}
###############################################################################
@@ -308,16 +349,32 @@
#--------------------------------------------------------------------------
# Establish a connection
#--------------------------------------------------------------------------
- $self = $self->SUPER::connect(@_);
-
- if (!$self)
+ my $sock = defined( ${*$self}->{SOCKS}->{TCP} ) ?
+ ${*$self}->{SOCKS}->{TCP}->SUPER::connect(@_)
+ :
+ $self->SUPER::connect(@_);
+
+ if (!$sock)
{
$SOCKS_ERROR = "Connection to proxy failed.";
return;
}
- #--------------------------------------------------------------------------
- # If socks version is 4
+ $self->_connect();
+}
+
+###############################################################################
+#
+# _connect - reusable connect operations
+#
+###############################################################################
+sub _connect
+{
+ my $self = shift;
+
+ #--------------------------------------------------------------------------
+ # For socks4 version
+ # Send the command (CONNECT/BIND)
#--------------------------------------------------------------------------
if(${*$self}->{SOCKS}->{Version} == 4)
{
@@ -341,13 +398,18 @@
#--------------------------------------------------------------------------
# Send the command (CONNECT/BIND/UDP)
#--------------------------------------------------------------------------
- return unless $self->_socks5_connect_command( ${*$self}->{SOCKS}->{Bind} ? CMD_BIND : CMD_CONNECT ) &&
+ return unless $self->_socks5_connect_command(
+ ${*$self}->{SOCKS}->{Bind} ?
+ CMD_BIND :
+ ${*$self}->{SOCKS}->{TCP} ?
+ CMD_UDPASSOC :
+ CMD_CONNECT
+ ) &&
$self->_socks5_connect_reply();
return $self;
}
-
###############################################################################
#
# _socks5_connect - Send the opening handsake, and process the reply.
@@ -357,6 +419,10 @@
{
my $self = shift;
my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug};
+ my $sock = defined( ${*$self}->{SOCKS}->{TCP} ) ?
+ ${*$self}->{SOCKS}->{TCP}
+ :
+ $self;
#--------------------------------------------------------------------------
# Send the auth mechanisms
@@ -378,7 +444,7 @@
}
}
- $self->_socks_send(pack('CC', SOCKS5_VER, $nmethods) . $methods)
+ $sock->_socks_send(pack('CC', SOCKS5_VER, $nmethods) . $methods)
or return _timeout();
if($debug)
@@ -400,7 +466,7 @@
# | 1 | 1 |
# +----+--------+
- my $reply = $self->_socks_read(2)
+ my $reply = $sock->_socks_read(2)
or return _timeout();
my ($version, $auth_method) = unpack('CC', $reply);
@@ -432,6 +498,10 @@
{
my $self = shift;
my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug};
+ my $sock = defined( ${*$self}->{SOCKS}->{TCP} ) ?
+ ${*$self}->{SOCKS}->{TCP}
+ :
+ $self;
#--------------------------------------------------------------------------
# Send the auth
@@ -446,7 +516,7 @@
my $passwd = ${*$self}->{SOCKS}->{Password};
my $ulen = length($uname);
my $plen = length($passwd);
- $self->_socks_send(pack('CC', 1, $ulen) . $uname . pack('C', $plen) . $passwd)
+ $sock->_socks_send(pack('CC', 1, $ulen) . $uname . pack('C', $plen) . $passwd)
or return _timeout();
if($debug)
@@ -470,7 +540,7 @@
# | 1 | 1 |
# +----+--------+
- my $reply = $self->_socks_read(2)
+ my $reply = $sock->_socks_read(2)
or return _timeout();
my ($ver, $status) = unpack('CC', $reply);
@@ -505,6 +575,10 @@
my $command = shift;
my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug};
my $resolve = defined(${*$self}->{SOCKS}->{Resolve}) ? ${*$self}->{SOCKS}->{Resolve} : $SOCKS5_RESOLVE;
+ my $sock = defined( ${*$self}->{SOCKS}->{TCP} ) ?
+ ${*$self}->{SOCKS}->{TCP}
+ :
+ $self;
#--------------------------------------------------------------------------
# Send the command
@@ -519,7 +593,7 @@
my $dstaddr = $resolve ? ${*$self}->{SOCKS}->{CmdAddr} : inet_aton(${*$self}->{SOCKS}->{CmdAddr});
my $hlen = length($dstaddr) if $resolve;
my $dstport = pack('n', ${*$self}->{SOCKS}->{CmdPort});
- $self->_socks_send(pack('CCCC', SOCKS5_VER, $command, 0, $atyp) . (defined($hlen) ? pack('C', $hlen) : '') . $dstaddr . $dstport)
+ $sock->_socks_send(pack('CCCC', SOCKS5_VER, $command, 0, $atyp) . (defined($hlen) ? pack('C', $hlen) : '') . $dstaddr . $dstport)
or return _timeout();
if($debug)
@@ -545,6 +619,10 @@
{
my $self = shift;
my $debug = IO::Socket::Socks::Debug->new() if ${*$self}->{SOCKS}->{Debug};
+ my $sock = defined( ${*$self}->{SOCKS}->{TCP} ) ?
+ ${*$self}->{SOCKS}->{TCP}
+ :
+ $self;
#--------------------------------------------------------------------------
# Read the reply
@@ -555,7 +633,7 @@
# | 1 | 1 | X'00' | 1 | Variable | 2 |
# +----+-----+-------+------+----------+----------+
- my $reply = $self->_socks_read(4)
+ my $reply = $sock->_socks_read(4)
or return _timeout();
my ($ver, $rep, $rsv, $atyp) = unpack('CCCC', $reply);
@@ -574,11 +652,11 @@
if ($atyp == ADDR_DOMAINNAME)
{
- defined( $reply = $self->_socks_read() )
+ defined( $reply = $sock->_socks_read() )
or return _timeout();
my $hlen = unpack('C', $reply);
- $bndaddr = $self->_socks_read($hlen)
+ $bndaddr = $sock->_socks_read($hlen)
or return _timeout();
if($debug)
@@ -591,7 +669,7 @@
}
elsif ($atyp == ADDR_IPV4)
{
- $reply = $self->_socks_read(4)
+ $reply = $sock->_socks_read(4)
or return _timeout();
$bndaddr = length($reply) == 4 ? inet_ntoa($reply) : undef;
@@ -602,11 +680,11 @@
}
else
{
- $SOCKS_ERROR = 'Socks server returns unsupported address type';
+ $SOCKS_ERROR = 'Unsupported address type returned by socks server';
return;
}
- $reply = $self->_socks_read(2)
+ $reply = $sock->_socks_read(2)
or return _timeout();
$bndport = unpack('n', $reply);
@@ -1287,7 +1365,29 @@
{
my $self = shift;
- return ${*$self}->{SOCKS}->{COMMAND};
+ unless(exists ${*$self}->{SOCKS}->{AuthMethods})
+ {
+ 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;
+ }
}
###############################################################################
@@ -1311,13 +1411,166 @@
###############################################################################
#
-# dst - access to the address and port selected by socks server when connect/bind
+# dst - access to the address and port selected by socks server when connect/bind/udpassoc
#
###############################################################################
sub dst
{
my $self = shift;
return (${*$self}->{SOCKS}->{DstAddr}, ${*$self}->{SOCKS}->{DstPort});
+}
+
+###############################################################################
+#
+# send - send UDP datagram
+#
+###############################################################################
+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) = sockaddr_in($peer);
+ my ($sndaddr, $sndport) = $self->dst;
+ if($sndaddr eq '0.0.0.0')
+ {
+ $sndaddr = ${*$self}->{SOCKS}->{ProxyAddr};
+ }
+ $sndaddr = inet_aton($sndaddr);
+ $peer = sockaddr_in($sndport, $sndaddr);
+
+ my ($atyp, $hlen);
+ if($resolve)
+ {
+ $atyp = ADDR_DOMAINNAME;
+ $dstaddr = inet_ntoa($dstaddr);
+ $hlen = length($dstaddr);
+ }
+ else
+ {
+ $atyp = ADDR_IPV4;
+ }
+
+ my $msglen = length($msg) if $debug;
+
+ # 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, $atyp) . ($resolve ? pack('C', $hlen) : '') . $dstaddr . pack('n', $dstport) . $msg;
+
+ if($debug)
+ {
+ $debug->add(
+ rsv => '00',
+ frag => '0',
+ atyp => $atyp
+ );
+ $debug->add(hlen => $hlen) if $resolve;
+ $debug->add(
+ dstaddr => $resolve ? $dstaddr : (length($dstaddr) == 4 ? inet_ntoa($dstaddr) : undef),
+ dstport => $dstport,
+ data => "...($msglen)"
+ );
+ $debug->show('Send: ');
+ }
+
+ $self->SUPER::send($msg, $flags, $peer);
+}
+
+###############################################################################
+#
+# recv - receive UDP datagram
+#
+###############################################################################
+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(my $peer = $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);
+ $dstaddr = length($dstaddr) == 4 ? inet_ntoa($dstaddr) : undef;
+ substr($_[0], 0, 4) = '';
+ }
+ else
+ {
+ $SOCKS_ERROR = 'Unsupported address type returned by socks server';
+ return;
+ }
+
+ my $dstport = unpack('n', $_[0]);
+ substr($_[0], 0, 2) = '';
+
+ if($debug)
+ {
+ $debug->add(
+ dstaddr => $dstaddr,
+ dstport => $dstport,
+ data => "...(" . length($_[0]) . ")"
+ );
+ $debug->show('Recv: ');
+ }
+
+ return $peer;
}
###############################################################################
@@ -1582,10 +1835,12 @@
=head2 Socks Client
-=head3
-new( %cfg )
-
-Creates a new IO::Socket::Socks client object. It takes the following
+=head3 new( %cfg )
+
+=head3 new_from_socket($socket, %cfg)
+
+Creates a new IO::Socket::Socks client object. new_from_socket() is the same as
+new(), but allows to create object from an existing socket. Both takes the following
config hash:
SocksVersion => 4 for socks v4, 5 for socks v5. Default is 5
@@ -1611,6 +1866,12 @@
BindAddr => Hostname 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
BindPort => Port of the remote machine which will
connect to the proxy server after bind request
@@ -1633,7 +1894,7 @@
The following options should be specified:
ProxyAddr and ProxyPort
- ConnectAddr and ConnectPort or BindAddr and BindPort
+ ConnectAddr and ConnectPort or BindAddr and BindPort or UdpAddr and UdpPort
Other options are facultative.
@@ -1648,17 +1909,45 @@
client socket.
=head3
+command( %cfg )
+
+Allows to execute socks command on already opened socket. Thus you
+can create socks chain. For example see L</EXAMPLES> 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) of the remote host after connect/accept or socks server
-after bind.
+Return (host, port) of the remote host after connect/accept or socks server (host, port)
+after bind/udpassoc.
=head2 Socks Server
-=head3
-new( %cfg )
-
-Creates a new IO::Socket::Socks server object. It takes the following
+=head3 new( %cfg )
+
+=head3 new_from_socket($socket, %cfg)
+
+Creates a new IO::Socket::Socks server object. new_from_socket() is the same as
+new(), but allows to create object from an existing socket. Both takes the following
config hash:
SocksVersion => 4 for socks v4, 5 for socks v5. Default is 5
@@ -1708,8 +1997,8 @@
=head3 command( )
After you call accept() the client has sent the command they want
-you to process. This function returns a reference to an array with
-the following format:
+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, HOST, PORT ]
@@ -1765,7 +2054,7 @@
=head1 CONSTANTS
-The following constants could be imported manually or using `:constans' tag:
+The following constants could be imported manually or using `:constants' tag:
SOCKS5_VER
SOCKS4_VER
@@ -1774,6 +2063,7 @@
ADDR_IPV6
CMD_CONNECT
CMD_BIND
+ CMD_UDPASSOC
AUTHMECH_ANON
AUTHMECH_USERPASS
AUTHMECH_INVALID
@@ -1793,6 +2083,26 @@
REQUEST_REJECTED_IDENTD
REQUEST_REJECTED_USERID
+=head1 BUGS
+
+The following options are not implemented and not planned:
+
+=over
+
+=item GSSAPI authentication
+
+=item UDP server side support
+
+=item IPV6 support
+
+=back
+
+However patches are welcome.
+
+=head1 SEE ALSO
+
+L<IO::Socket::Socks::Wrapper>
+
=head1 AUTHOR
Original author is Ryan Eatmon
@@ -1802,6 +2112,6 @@
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify
-it under the terms of LGPL license.
+it under the terms of LGPL.
=cut
More information about the Pkg-perl-cvs-commits
mailing list