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