perl/lib/Thrasher/Plugin/Socks.pm

   1 package Thrasher::Plugin::Socks;
   2
   3 # This file is based on IO::Socket::Socks, but is modified
   4 # to work with the interface of Thrasher::EventLoop. It should
   5 # work with any conformant implementation of the EventLoop.
   6 #
   7 # Only reading and writing a single proxied socket works. Serving
   8 # stuff will be removed, eventually.
   9 #
  10 # This file is used by the ProxyFileTransfer plugin, but I just don't
  11 # care to go down another layer of hierarchy in the package name.
  12 # Besides, other plugins could use this, someday.
  13 #
  14 # In theory, we should also convert this so that the process of
  15 # connecting to the socket doesn't block, but uses the event loop
  16 # callback system for everything. However, this is unlikely to be a
  17 # problem until you have incredibly high load. In my experience, a
  18 # file transfer is a rare thing. You want it to work when you want to
  19 # move a file, but you don't move files anywhere near as often as you
  20 # send messages.
  21
  22 ##############################################################################
  23 #
  24 #  This library is free software; you can redistribute it and/or
  25 #  modify it under the terms of the GNU Library General Public
  26 #  License as published by the Free Software Foundation; either
  27 #  version 2 of the License, or (at your option) any later version.
  28 #
  29 #  This library is distributed in the hope that it will be useful,
  30 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  31 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  32 #  Library General Public License for more details.
  33 #
  34 #  You should have received a copy of the GNU Library General Public
  35 #  License along with this library; if not, write to the
  36 #  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  37 #  Boston, MA  02111-1307, USA.
  38 #
  39 #  Copyright (C) 2003 Ryan Eatmon
  40 #
  41 ##############################################################################
  42
  43 use strict;
  44 use IO::Socket;
  45 use Carp;
  46 use vars qw(@ISA @EXPORT $VERSION %CODES );
  47 require Exporter;
  48 @ISA = qw(Exporter IO::Socket::INET);
  49 @EXPORT = qw( $SOCKS_ERROR );
  50
  51 use POSIX qw(F_SETFL O_NONBLOCK);
  52 use Thrasher::Log qw(log);
  53
  54 $VERSION = "0.1";
  55 our $SOCKS_ERROR;
  56
  57 use constant SOCKS5_VER =>  5;
  58
  59 use constant ADDR_IPV4       => 1;
  60 use constant ADDR_DOMAINNAME => 3;
  61 use constant ADDR_IPV6       => 4;
  62
  63 use constant CMD_CONNECT  => 1;
  64 #use constant CMD_BIND     => 2;
  65 #use constant CMD_UDPASSOC => 3;
  66
  67 use constant AUTHMECH_ANON     => 0;
  68 #use constant AUTHMECH_GSSAPI   => 1;
  69 use constant AUTHMECH_USERPASS => 2;
  70 use constant AUTHMECH_INVALID  => 255;
  71
  72 $CODES{AUTHMECH}->[AUTHMECH_INVALID] = "No valid auth mechanisms";
  73
  74 use constant AUTHREPLY_SUCCESS  => 0;
  75 use constant AUTHREPLY_FAILURE  => 1;
  76
  77 $CODES{AUTHREPLY}->[AUTHREPLY_FAILURE] = "Failed to authenticate";
  78
  79 use constant REPLY_SUCCESS             => 0;
  80 use constant REPLY_GENERAL_FAILURE     => 1;
  81 use constant REPLY_CONN_NOT_ALLOWED    => 2;
  82 use constant REPLY_NETWORK_UNREACHABLE => 3;
  83 use constant REPLY_HOST_UNREACHABLE    => 4;
  84 use constant REPLY_CONN_REFUSED        => 5;
  85 use constant REPLY_TTL_EXPIRED         => 6;
  86 use constant REPLY_CMD_NOT_SUPPORTED   => 7;
  87 use constant REPLY_ADDR_NOT_SUPPORTED  => 8;
  88
  89 $CODES{REPLY}->[REPLY_SUCCESS] = "Success";
  90 $CODES{REPLY}->[REPLY_GENERAL_FAILURE] = "General failure";
  91 $CODES{REPLY}->[REPLY_CONN_NOT_ALLOWED] = "Not allowed";
  92 $CODES{REPLY}->[REPLY_NETWORK_UNREACHABLE] = "Network unreachable";
  93 $CODES{REPLY}->[REPLY_HOST_UNREACHABLE] = "Host unreachable";
  94 $CODES{REPLY}->[REPLY_CONN_REFUSED] = "Connection refused";
  95 $CODES{REPLY}->[REPLY_TTL_EXPIRED] = "TTL expired";
  96 $CODES{REPLY}->[REPLY_CMD_NOT_SUPPORTED] = "Command not supported";
  97 $CODES{REPLY}->[REPLY_ADDR_NOT_SUPPORTED] = "Address not supported";
  98
  99 # To retain basic compatibility with the previous interface, we
 100 # explicitly set which arguments we care about and which will
 101 # go to the raw socket.
 102 my %SOCKS_ARGUMENTS = map { $_ => 1 }
 103     qw(ProxyAddr ProxyPort ConnectAddr ConnectPort AuthType
 104        RequireAuth UserAuth Username Password Debug Listen
 105        LocalAddr LocalPort PeerAddr PeerPort EventLoop
 106        SuccessCallback FailureCallback);
 107
 108 my @REQUIRED_ARGS = qw(ProxyAddr ProxyPort EventLoop SuccessCallback
 109                        FailureCallback);
 110
 111 # Note this removes the automatic connect
 112 # EventLoop is a reference to a Thrasher::EventLoop object of some
 113 # sort
 114 # SuccessCallback will be called with the next chunk of data, when
 115 # we receive some, or undef if the socket is over normally
 116 # FailureCallback will be called when something fails, including
 117 # a failure to log in to the proxy or a lost connection.
 118 sub new {
 119     my $class = shift;
 120
 121     my $self = {};
 122     bless $self, $class;
 123
 124     $self->{socket_args} = {Proto => 'tcp',
 125                             Type => SOCK_STREAM};
 126     $self->{args} = {};
 127     while (@_) {
 128         my $key = shift;
 129         my $value = shift;
 130
 131         if ($SOCKS_ARGUMENTS{$key}) {
 132             $self->{$key} = $value;
 133         } else {
 134             $self->{socket_args}->{$key} = $value;
 135         }
 136     }
 137
 138     $self->{AuthType} ||= 'none';
 139     if ($self->{AuthType} ne 'none' &&
 140         (!$self->{Username} || !$self->{Password})) {
 141         croak "An AuthTyype other than none requires a Username "
 142             ."and Passward.";
 143     }
 144
 145     $self->{AuthMethods} = [!$self->{RequireAuth},
 146                             0,
 147                             exists($self->{Listen}) ?
 148                                 defined($self->{UserAuth}) :
 149                                 $self->{AuthType} eq 'userpass'
 150                            ];
 151
 152     $self->{COMMAND} = undef;
 153
 154     if (exists($self->{Listen})) {
 155         $self->{socket_args}->{LocalAddr} = $self->{ProxyAddr};
 156         $self->{socket_args}->{LocalPort} = $self->{ProxyPort};
 157     } else {
 158         $self->{socket_args}->{PeerAddr} = $self->{ProxyAddr};
 159         $self->{socket_args}->{PeerPort} = $self->{ProxyPort};
 160     }
 161
 162     for my $required (@REQUIRED_ARGS) {
 163         if (!$self->{$required}) {
 164             croak "You must provide $required to a Socks connection.";
 165         }
 166     }
 167
 168     if (ref($self->{FailureCallback}) ne 'CODE' ||
 169         ref($self->{SuccessCallback}) ne 'CODE') {
 170         croak "FailureCallback and SuccessCallback both need to be "
 171             ."subrefs.";
 172     }
 173
 174     $self->{socket} = new IO::Socket::INET(%{$self->{socket_args}});
 175
 176     if (!$self->{socket}) {
 177         log("Failed to connect to XMPP proxy.");
 178         return undef;
 179     }
 180
 181     # Setting Blocking => 0 doesn't seem to work as well as this does.
 182     fcntl($self->{socket}, F_SETFL, O_NONBLOCK);
 183
 184     return $self;
 185 }
 186
 187 sub connect
 188 {
 189     my $self = shift;
 190
 191     print "Socks: Connecting\n";
 192
 193     croak("Undefined Socks object passed to connect.")
 194         unless defined($self);
 195
 196     my $completed_connect = sub {
 197         print "Calling completed connect callback\n";
 198
 199         if (defined($self->{ConnectAddr}) &&
 200             defined($self->{ConnectPort}))
 201         {
 202             print "Proceding to connect socket.\n";
 203             $self->connect_to_socket();
 204         }
 205     };
 206
 207     my $auth_mech = $self->_socks5_connect($completed_connect);
 208 }
 209
 210
 211 ###############################################################################
 212 #
 213 # _socks5_connect - Send the opening handsake, and process the reply.
 214 #
 215 ###############################################################################
 216 sub _socks5_connect
 217 {
 218     my $self = shift;
 219     my $after_connect_closure = shift;
 220
 221     #--------------------------------------------------------------------------
 222     # Send the auth mechanisms
 223     #--------------------------------------------------------------------------
 224     my %connect;
 225     $connect{version} = SOCKS5_VER;
 226     my @methods;
 227     foreach my $method (0..scalar(@{$self->{AuthMethods}}))
 228     {
 229         push(@methods,$method)
 230             if ($self->{AuthMethods}->[$method] == 1);
 231     }
 232     $connect{num_methods} = $#methods + 1;
 233     $connect{methods} = \@methods;
 234
 235     $self->_debug_connect("Send",\%connect);
 236
 237     $self->_socks_send($connect{version});
 238     $self->_socks_send($connect{num_methods});
 239     foreach my $method (@{$connect{methods}})
 240     {
 241         $self->_socks_send($method);
 242     }
 243     $self->_socks_flush();
 244
 245     my $handle_reply = sub {
 246         print "Socks: Made it to handle_reply.\n";
 247         my %connect_reply;
 248         print "Socks: A\n";
 249         $connect_reply{version} = $self->_socks_read();
 250         print "Socks: B\n";
 251         $connect_reply{auth_method} = $self->_socks_read();
 252         print "Socks: C\n";
 253
 254         $self->_debug_connect_reply("Recv",\%connect_reply);
 255
 256         if ($connect_reply{auth_method} == AUTHMECH_INVALID)
 257         {
 258             log("Could not complete connection to proxy.");
 259             $self->{socket}->close;
 260             $self->{FailureCallback}->();
 261             return 0;
 262         }
 263
 264         if ($connect_reply{auth_method} != AUTHMECH_ANON)
 265         {
 266             die "Authentication not converted yet.";
 267             return unless $self->_socks5_connect_auth();
 268         }
 269
 270         print "About to run after_connect_closure\n";
 271         $after_connect_closure->();
 272
 273         # We'll never run *this* callback again on this socket.
 274         return 0;
 275     };
 276
 277     print "Adding handle reply watcher\n";
 278     $self->{EventLoop}->add_fd_watch
 279         ($self->{socket}->fileno,
 280          $Thrasher::EventLoop::IN,
 281          $handle_reply);
 282 }
 283
 284
 285 ###############################################################################
 286 #
 287 # _socks5_connect_auth - Send and receive a SOCKS5 auth handshake
 288 #
 289 ###############################################################################
 290 sub _socks5_connect_auth
 291 {
 292     my $self = shift;
 293
 294     #--------------------------------------------------------------------------
 295     # Send the auth
 296     #--------------------------------------------------------------------------
 297     my %auth;
 298     $auth{version} = 1;
 299     $auth{user_length} = length($self->{Username});
 300     $auth{user} = $self->{Username};
 301     $auth{pass_length} = length($self->{Password});
 302     $auth{pass} = $self->{Password};
 303
 304     $self->_debug_auth("Send",\%auth);
 305
 306     $self->_socks_send($auth{version});
 307     $self->_socks_send($auth{user_length});
 308     $self->_socks_send_raw($auth{user});
 309     $self->_socks_send($auth{pass_length});
 310     $self->_socks_send_raw($auth{pass});
 311     $self->_socks_flush;
 312
 313     #--------------------------------------------------------------------------
 314     # Read the reply
 315     #--------------------------------------------------------------------------
 316     my %auth_reply;
 317     $auth_reply{version} = $self->_socks_read();
 318     $auth_reply{status} = $self->_socks_read();
 319
 320     $self->_debug_auth_reply("Recv",\%auth_reply);
 321
 322     if ($auth_reply{status} != AUTHREPLY_SUCCESS)
 323     {
 324         $SOCKS_ERROR = "Authentication failed with SOCKS5 proxy.";
 325         return;
 326     }
 327
 328     return 1;
 329 }
 330
 331
 332 sub connect_to_socket
 333 {
 334     my $self = shift;
 335     my $command = CMD_CONNECT;
 336
 337     print "Socks: Connecting to socket.\n";
 338
 339     #--------------------------------------------------------------------------
 340     # Send the command
 341     #--------------------------------------------------------------------------
 342     my %command;
 343     $command{version} = SOCKS5_VER;
 344     $command{command} = $command;
 345     $command{reserved} = 0;
 346     $command{atype} = ADDR_DOMAINNAME;
 347     $command{host_length} = length($self->{ConnectAddr});
 348     $command{host} = $self->{ConnectAddr};
 349     $command{port} = $self->{ConnectPort};
 350
 351     $self->_debug_command("Send",\%command);
 352
 353     $self->_socks_send($command{version});
 354     $self->_socks_send($command{command});
 355     $self->_socks_send($command{reserved});
 356     $self->_socks_send($command{atype});
 357     $self->_socks_send($command{host_length});
 358     $self->_socks_send_raw($command{host});
 359     $self->_socks_send_raw(pack("n",$command{port}));
 360     $self->_socks_flush();
 361
 362     my $handle_connect_reply = sub {
 363         print "Socks: Handling connect reply.\n";
 364         my %command_reply;
 365         $command_reply{version} = $self->_socks_read();
 366         $command_reply{status} = $self->_socks_read();
 367
 368         if ($command_reply{status} == REPLY_SUCCESS)
 369         {
 370             $command_reply{reserved} = $self->_socks_read();
 371             $command_reply{atype} = $self->_socks_read();
 372
 373             if ($command_reply{atype} == ADDR_DOMAINNAME)
 374             {
 375                 $command_reply{host_length} = $self->_socks_read();
 376                 $command_reply{host} = $self->_socks_read_raw($command_reply{host_length});
 377             }
 378             elsif ($command_reply{atype} == ADDR_IPV4)
 379             {
 380                 $command_reply{host} = unpack("N",$self->_socks_read_raw(4));
 381             }
 382
 383             $command_reply{port} = unpack("n",$self->_socks_read_raw(2));
 384         }
 385
 386         $self->_debug_command_reply("Recv",\%command_reply);
 387
 388         if ($command_reply{status} != REPLY_SUCCESS)
 389         {
 390             $self->{FailureCallback}->();
 391             return 0;
 392         }
 393
 394         print "Socks: Final handler installed.\n";
 395         # If we got here, must be successful.
 396         #
 397         # We need to make sure that one side of the file transfer
 398         # doesn't run way ahead of the other, and to do that,
 399         # ProxyFileTransfer.pm needs full control of when the stream
 400         # is actually read, so the OS correctly rate-limits the TCP
 401         # socket....
 402         my $data_reader = sub {
 403             my ($chunk_sz) = @_;
 404             my ($eof, $error, $data);
 405             my $result = sysread($self->{socket}, $data, $chunk_sz);
 406             if (! defined($result)) {
 407                 $error = $!;
 408             }
 409             elsif ($result == 0) {
 410                 $eof = 1;
 411             }
 412             return ($eof, $error, $data);
 413         };
 414         $self->{SuccessCallback}->($data_reader);
 415
 416         return 0;
 417     };
 418
 419     print "Socks: Preparing connection reply watch.\n";
 420     $self->{EventLoop}->add_fd_watch
 421         ($self->{socket}->fileno,
 422          $Thrasher::EventLoop::IN,
 423          $handle_connect_reply);
 424 }
 425
 426 sub add_fd_watch {
 427     my ($self, $directions, $callback) = @_;
 428
 429     my $callback_wrapped = sub {
 430         my $ret = $callback->();
 431         if (! $ret) {
 432             # Unset watch_id to reflect that this FD is (about to be) removed.
 433             $self->{'watch_id'} = 0;
 434         }
 435         return $ret;
 436     };
 437
 438     $self->{'watch_id'} = $self->{EventLoop}->add_fd_watch(
 439         $self->{socket}->fileno(),
 440         $directions,
 441         $callback_wrapped,
 442     );
 443 }
 444
 445 sub remove_fd_watch {
 446     my ($self) = @_;
 447
 448     if ($self->{'watch_id'}) {
 449         $self->{EventLoop}->remove_fd_watch($self->{'watch_id'});
 450         $self->{'watch_id'} = undef;
 451     }
 452 }
 453
 454 sub close {
 455     my ($self) = @_;
 456
 457     # Remove FD watch if present and close underlying socket.
 458     $self->remove_fd_watch();
 459     if ($self->{'socket'}) {
 460         $self->{'socket'}->close();
 461     }
 462 }
 463
 464 ###############################################################################
 465 #+-----------------------------------------------------------------------------
 466 #| Accept Functions
 467 #+-----------------------------------------------------------------------------
 468 ###############################################################################
 469
 470 ###############################################################################
 471 #
 472 # accept - When we are accepting new connections, we need to do the SOCKS
 473 #          handshaking before we return a usable socket.
 474 #
 475 ###############################################################################
 476 sub accept
 477 {
 478     my $self = shift;
 479
 480     croak("Undefined IO::Socket::Socks object passed to accept.")
 481         unless defined($self);
 482
 483     my $client = $self->SUPER::accept(@_);
 484
 485     if (!$self)
 486     {
 487         $SOCKS_ERROR = "Proxy accept new client failed.";
 488         return;
 489     }
 490
 491     my $authmech = $self->_socks5_accept($client);
 492     return unless defined($authmech);
 493
 494     if ($authmech == AUTHMECH_USERPASS)
 495     {
 496         return unless $self->_socks5_accept_auth($client);
 497     }
 498
 499     return unless $self->_socks5_accept_command($client);
 500
 501     return $client;
 502 }
 503
 504
 505 ###############################################################################
 506 #
 507 # _socks5_accept - Wait for an opening handsake, and reply.
 508 #
 509 ###############################################################################
 510 sub _socks5_accept
 511 {
 512     my $self = shift;
 513     my $client = shift;
 514
 515     #--------------------------------------------------------------------------
 516     # Read the auth mechanisms
 517     #--------------------------------------------------------------------------
 518     my %accept;
 519     $accept{version} = $client->_socks_read();
 520     $accept{num_methods} = $client->_socks_read();
 521     $accept{methods} = [];
 522     foreach (0..($accept{num_methods}-1))
 523     {
 524         push(@{$accept{methods}},$client->_socks_read());
 525     }
 526
 527     $self->_debug_connect("Recv",\%accept);
 528
 529     if ($accept{num_methods} == 0)
 530     {
 531         $SOCKS_ERROR = "No auth methods sent.";
 532         return;
 533     }
 534
 535     my $authmech;
 536
 537     foreach my $method (@{$accept{methods}})
 538     {
 539         if ($self->{AuthMethods}->[$method] == 1)
 540         {
 541             $authmech = $method;
 542             last;
 543         }
 544     }
 545
 546     if (!defined($authmech))
 547     {
 548         $authmech = AUTHMECH_INVALID;
 549     }
 550
 551     #--------------------------------------------------------------------------
 552     # Send the reply
 553     #--------------------------------------------------------------------------
 554     my %accept_reply;
 555     $accept_reply{version} = SOCKS5_VER;
 556     $accept_reply{auth_method} = AUTHMECH_INVALID;
 557     $accept_reply{auth_method} = $authmech if defined($authmech);
 558
 559     $client->_socks_send($accept_reply{version});
 560     $client->_socks_send($accept_reply{auth_method});
 561     $client->_socks_flush;
 562
 563     $self->_debug_connect_reply("Send",\%accept_reply);
 564
 565     if ($authmech == AUTHMECH_INVALID)
 566     {
 567         $SOCKS_ERROR = "No available auth methods.";
 568         return;
 569     }
 570
 571     return $authmech;
 572 }
 573
 574
 575 ###############################################################################
 576 #
 577 # _socks5_accept_auth - Send and receive a SOCKS5 auth handshake
 578 #
 579 ###############################################################################
 580 sub _socks5_accept_auth
 581 {
 582     my $self = shift;
 583     my $client = shift;
 584
 585     #--------------------------------------------------------------------------
 586     # Send the auth
 587     #--------------------------------------------------------------------------
 588     my %auth;
 589     $auth{version} = $client->_socks_read();
 590     $auth{user_length} = $client->_socks_read();
 591     $auth{user} = $client->_socks_read_raw($auth{user_length});
 592     $auth{pass_length} = $client->_socks_read();
 593     $auth{pass} = $client->_socks_read_raw($auth{pass_length});
 594
 595     $self->_debug_auth("Recv",\%auth);
 596
 597     my $status = 0;
 598     if (defined($self->{UserAuth}))
 599     {
 600         $status = &{$self->{UserAuth}}($auth{user},$auth{pass});
 601     }
 602
 603     #--------------------------------------------------------------------------
 604     # Read the reply
 605     #--------------------------------------------------------------------------
 606     my %auth_reply;
 607     $auth_reply{version} = 1;
 608     $auth_reply{status} = AUTHREPLY_SUCCESS;
 609     $auth_reply{status} = AUTHREPLY_FAILURE if !$status;
 610
 611     $client->_socks_send($auth_reply{version});
 612     $client->_socks_send($auth_reply{status});
 613     $client->_socks_flush;
 614
 615     $self->_debug_auth_reply("Send",\%auth_reply);
 616
 617     if ($auth_reply{status} != AUTHREPLY_SUCCESS)
 618     {
 619         $SOCKS_ERROR = "Authentication failed with SOCKS5 proxy.";
 620         return;
 621     }
 622
 623     return 1;
 624 }
 625
 626
 627 ###############################################################################
 628 #
 629 # _socks5_acccept_command - Process a SOCKS5 command request.  Since this is
 630 #                           a library and not a server, we cannot process the
 631 #                           command.  Let the parent program handle that.
 632 #
 633 ###############################################################################
 634 sub _socks5_accept_command
 635 {
 636     my $self = shift;
 637     my $client = shift;
 638
 639     #--------------------------------------------------------------------------
 640     # Read the command
 641     #--------------------------------------------------------------------------
 642     my %command;
 643     $command{version} = $client->_socks_read();
 644     $command{command} = $client->_socks_read();
 645     $command{reserved} = $client->_socks_read();
 646     $command{atype} = $client->_socks_read();
 647
 648     if ($command{atype} == ADDR_DOMAINNAME)
 649     {
 650         $command{host_length} =  $client->_socks_read();
 651         $command{host} = $client->_socks_read_raw($command{host_length});
 652     }
 653     elsif ($command{atype} == ADDR_IPV4)
 654     {
 655         $command{host} = unpack("N",$client->_socks_read_raw(4));
 656     }
 657     else
 658     {
 659         $client->_socks_accept_command_reply(REPLY_ADDR_NOT_SUPPORTED);
 660         $SOCKS_ERROR = $CODES{REPLY}->[REPLY_ADDR_NOT_SUPPORTED];
 661         return;
 662     }
 663
 664     $command{port} = unpack("n",$client->_socks_read_raw(2));
 665
 666     $self->_debug_command("Recv",\%command);
 667
 668     ${*$client}->{SOCKS}->{COMMAND} = [$command{command},$command{host},$command{port}];
 669
 670     return 1;
 671 }
 672
 673
 674 ###############################################################################
 675 #
 676 # _socks5_acccept_command_reply - Answer a SOCKS5 command request.  Since this
 677 #                                 is a library and not a server, we cannot
 678 #                                 process the command.  Let the parent program
 679 #                                 handle that.
 680 #
 681 ###############################################################################
 682 sub _socks5_accept_command_reply
 683 {
 684     my $self = shift;
 685     my $reply = shift;
 686     my $host = shift;
 687     my $port = shift;
 688
 689     if (!defined($reply) || !defined($host) || !defined($port))
 690     {
 691         croak("You must provide a reply, host, and port on the command reply.");
 692     }
 693
 694     #--------------------------------------------------------------------------
 695     # Send the reply
 696     #--------------------------------------------------------------------------
 697     my %command_reply;
 698     $command_reply{version} = SOCKS5_VER;
 699     $command_reply{status} = $reply;
 700     $command_reply{reserved} = 0;
 701     $command_reply{atype} = ADDR_DOMAINNAME;
 702     $command_reply{host_length} = length($host);
 703     $command_reply{host} = $host;
 704     $command_reply{port} = $port;
 705
 706     $self->_debug_command_reply("Send",\%command_reply);
 707
 708     $self->_socks_send($command_reply{version});
 709     $self->_socks_send($command_reply{status});
 710     $self->_socks_send($command_reply{reserved});
 711     $self->_socks_send($command_reply{atype});
 712     $self->_socks_send($command_reply{host_length});
 713     $self->_socks_send_raw($command_reply{host});
 714     $self->_socks_send_raw(pack("n",$command_reply{port}));
 715     $self->_socks_flush;
 716 }
 717
 718
 719 ###############################################################################
 720 #
 721 # command_reply - public reply wrapper to the client.
 722 #
 723 ###############################################################################
 724 sub command_reply
 725 {
 726     my $self = shift;
 727     $self->_socks5_accept_command_reply(@_);
 728 }
 729
 730
 731
 732
 733
 734 ###############################################################################
 735 #+-----------------------------------------------------------------------------
 736 #| Helper Functions
 737 #+-----------------------------------------------------------------------------
 738 ###############################################################################
 739
 740 ###############################################################################
 741 #
 742 # _socks_read - send over the socket after packing according to the rules.
 743 #
 744 ###############################################################################
 745 sub _socks_send
 746 {
 747     my $self = shift;
 748     my $data = shift;
 749
 750     $data = pack("C",$data);
 751     $self->_socks_send_raw($data);
 752 }
 753
 754
 755 ###############################################################################
 756 #
 757 # _socks_send_raw - send raw data across the socket.
 758 #
 759 ###############################################################################
 760 sub _socks_send_raw
 761 {
 762     my $self = shift;
 763     my $data = shift;
 764
 765     push @{$self->{data}}, $data;
 766 }
 767
 768 sub _socks_flush {
 769     my $self = shift;
 770     my $data = $self->{data};
 771     undef $self->{data};
 772
 773     $data = join '', @$data;
 774
 775     $self->{socket}->syswrite($data,length($data));
 776 }
 777
 778
 779 ###############################################################################
 780 #
 781 # _socks_read - read from the socket, and then unpack according to the rules.
 782 #
 783 ###############################################################################
 784 sub _socks_read
 785 {
 786     my $self = shift;
 787     my $length = shift;
 788     $length = 1 unless defined($length);
 789
 790     my $data = $self->_socks_read_raw($length);
 791     $data = unpack("C",$data);
 792     return $data;
 793 }
 794
 795
 796 ###############################################################################
 797 #
 798 # _socks_read_raw - read raw bytes off of the socket
 799 #
 800 ###############################################################################
 801 sub _socks_read_raw
 802 {
 803     my $self = shift;
 804     my $length = shift;
 805     $length = 1 unless defined($length);
 806
 807     my $data;
 808     sysread($self->{socket}, $data, $length);
 809     return $data;
 810 }
 811
 812
 813
 814
 815 ###############################################################################
 816 #+-----------------------------------------------------------------------------
 817 #| Debug Functions
 818 #+-----------------------------------------------------------------------------
 819 ###############################################################################
 820
 821 sub _debug_connect
 822 {
 823     my $self = shift;
 824     my $tag = shift;
 825     my $connect = shift;
 826
 827     return unless $self->{Debug};
 828
 829     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
 830     print "$tag: | Vers | Auth |";
 831     if ($connect->{num_methods} > 0)
 832     {
 833         print " Meth "," "x(4*($connect->{num_methods}-1)),"|\n";
 834     }
 835     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
 836
 837     print "$tag: | ";
 838     printf("\\%02X",$connect->{version});
 839     print "  | ";
 840     printf("\\%02X",$connect->{num_methods});
 841     print "  | ";
 842     if ($connect->{num_methods} > 0)
 843     {
 844         foreach my $method (@{$connect->{methods}})
 845         {
 846             printf("\\%02X ",$method);
 847         }
 848         print " |";
 849     }
 850
 851     print "\n";
 852     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
 853     print "\n";
 854 }
 855
 856
 857 sub _debug_connect_reply
 858 {
 859     my $self = shift;
 860     my $tag = shift;
 861     my $connect_reply = shift;
 862
 863     return unless $self->{Debug};
 864
 865     print "$tag: +------+------+\n";
 866     print "$tag: | Vers | Auth |\n";
 867     print "$tag: +------+------+\n";
 868     print "$tag: | ";
 869
 870     printf("\\%02X",$connect_reply->{version});
 871     print "  | ";
 872     printf("\\%02X",$connect_reply->{auth_method});
 873     print "  |\n";
 874
 875     print "$tag: +------+------+\n";
 876     print "\n";
 877 }
 878
 879
 880 sub _debug_auth
 881 {
 882     my $self = shift;
 883     my $tag = shift;
 884     my $auth = shift;
 885
 886     return unless $self->{Debug};
 887
 888     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
 889     print "$tag: | Vers | UsrL | User "," "x($auth->{user_length}-4),"| PasL | Pass"," "x($auth->{pass_length}-4)," |\n";
 890     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
 891     print "$tag: | ";
 892
 893     printf("\\%02X",$auth->{version});
 894     print "  | ";
 895     printf("\\%02d",$auth->{user_length});
 896     print "  | ";
 897     print $auth->{user}," "x(4-$auth->{user_length});
 898     print " | ";
 899     printf("\\%02d",$auth->{pass_length});
 900     print "  | ";
 901     print $auth->{pass}," "x(4-$auth->{pass_length});
 902
 903     print " |\n";
 904     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
 905     print "\n";
 906 }
 907
 908
 909 sub _debug_auth_reply
 910 {
 911     my $self = shift;
 912     my $tag = shift;
 913     my $auth_reply = shift;
 914
 915     return unless $self->{Debug};
 916
 917     print "$tag: +------+------+\n";
 918     print "$tag: | Vers | Stat |\n";
 919     print "$tag: +------+------+\n";
 920     print "$tag: | ";
 921
 922     printf("\\%02X",$auth_reply->{version});
 923     print "  | ";
 924     printf("\\%02X",$auth_reply->{status});
 925     print "  |\n";
 926
 927     print "$tag: +------+------+\n";
 928     print "\n";
 929 }
 930
 931
 932 sub _debug_command
 933 {
 934     my $self = shift;
 935     my $tag = shift;
 936     my $command = shift;
 937
 938     return unless $self->{Debug};
 939
 940     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
 941     print "$tag: | Vers | Comm | Resv | ATyp | Host  "," "x$command->{host_length}," | Port  |\n";
 942     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
 943     print "$tag: | ";
 944
 945     printf("\\%02X",$command->{version});
 946     print "  | ";
 947     printf("\\%02X",$command->{command});
 948     print "  | ";
 949     printf("\\%02X",$command->{reserved});
 950     print "  | ";
 951     printf("\\%02X",$command->{atype});
 952     print "  | ";
 953     printf("\\%02d",$command->{host_length});
 954     print " - ";
 955     print $command->{host};
 956     print " | ";
 957     printf("%-5d",$command->{port});
 958
 959     print " |\n";
 960     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
 961     print "\n";
 962 }
 963
 964
 965 sub _debug_command_reply
 966 {
 967     my $self = shift;
 968     my $tag = shift;
 969     my $command_reply = shift;
 970
 971     return unless $self->{Debug};
 972
 973     print "$tag: +------+------+";
 974     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
 975         if ($command_reply->{status} == 0);
 976     print "\n";
 977
 978     print "$tag: | Vers | Stat |";
 979     print " Resv | ATyp | Host  "," "x$command_reply->{host_length}," | Port  |"
 980         if ($command_reply->{status} == 0);
 981     print "\n";
 982
 983     print "$tag: +------+------+";
 984     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
 985         if ($command_reply->{status} == 0);
 986     print "\n";
 987
 988     print "$tag: | ";
 989
 990     printf("\\%02X",$command_reply->{version});
 991     print "  | ";
 992     printf("\\%02X",$command_reply->{status});
 993     if ($command_reply->{status} == 0)
 994     {
 995         print "  | ";
 996         printf("\\%02X",$command_reply->{reserved});
 997         print "  | ";
 998         printf("\\%02X",$command_reply->{atype});
 999         print "  | ";
1000         printf("\\%02d",$command_reply->{host_length});
1001         print " - ";
1002         print $command_reply->{host};
1003         print " | ";
1004         printf("%-5d",$command_reply->{port});
1005     }
1006     else
1007     {
1008         print " ";
1009     }
1010     print " |\n";
1011
1012     print "$tag: +------+------+";
1013     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
1014         if ($command_reply->{status} == 0);
1015     print "\n";
1016     print "\n";
1017 }
1018
1019
1020 1;