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     }
 451 }
 452
 453 sub close {
 454     my ($self) = @_;
 455
 456     # Remove FD watch if present and close underlying socket.
 457     $self->remove_fd_watch();
 458     if ($self->{'socket'}) {
 459         $self->{'socket'}->close();
 460     }
 461 }
 462
 463 ###############################################################################
 464 #+-----------------------------------------------------------------------------
 465 #| Accept Functions
 466 #+-----------------------------------------------------------------------------
 467 ###############################################################################
 468
 469 ###############################################################################
 470 #
 471 # accept - When we are accepting new connections, we need to do the SOCKS
 472 #          handshaking before we return a usable socket.
 473 #
 474 ###############################################################################
 475 sub accept
 476 {
 477     my $self = shift;
 478
 479     croak("Undefined IO::Socket::Socks object passed to accept.")
 480         unless defined($self);
 481
 482     my $client = $self->SUPER::accept(@_);
 483
 484     if (!$self)
 485     {
 486         $SOCKS_ERROR = "Proxy accept new client failed.";
 487         return;
 488     }
 489
 490     my $authmech = $self->_socks5_accept($client);
 491     return unless defined($authmech);
 492
 493     if ($authmech == AUTHMECH_USERPASS)
 494     {
 495         return unless $self->_socks5_accept_auth($client);
 496     }
 497
 498     return unless $self->_socks5_accept_command($client);
 499
 500     return $client;
 501 }
 502
 503
 504 ###############################################################################
 505 #
 506 # _socks5_accept - Wait for an opening handsake, and reply.
 507 #
 508 ###############################################################################
 509 sub _socks5_accept
 510 {
 511     my $self = shift;
 512     my $client = shift;
 513
 514     #--------------------------------------------------------------------------
 515     # Read the auth mechanisms
 516     #--------------------------------------------------------------------------
 517     my %accept;
 518     $accept{version} = $client->_socks_read();
 519     $accept{num_methods} = $client->_socks_read();
 520     $accept{methods} = [];
 521     foreach (0..($accept{num_methods}-1))
 522     {
 523         push(@{$accept{methods}},$client->_socks_read());
 524     }
 525
 526     $self->_debug_connect("Recv",\%accept);
 527
 528     if ($accept{num_methods} == 0)
 529     {
 530         $SOCKS_ERROR = "No auth methods sent.";
 531         return;
 532     }
 533
 534     my $authmech;
 535
 536     foreach my $method (@{$accept{methods}})
 537     {
 538         if ($self->{AuthMethods}->[$method] == 1)
 539         {
 540             $authmech = $method;
 541             last;
 542         }
 543     }
 544
 545     if (!defined($authmech))
 546     {
 547         $authmech = AUTHMECH_INVALID;
 548     }
 549
 550     #--------------------------------------------------------------------------
 551     # Send the reply
 552     #--------------------------------------------------------------------------
 553     my %accept_reply;
 554     $accept_reply{version} = SOCKS5_VER;
 555     $accept_reply{auth_method} = AUTHMECH_INVALID;
 556     $accept_reply{auth_method} = $authmech if defined($authmech);
 557
 558     $client->_socks_send($accept_reply{version});
 559     $client->_socks_send($accept_reply{auth_method});
 560     $client->_socks_flush;
 561
 562     $self->_debug_connect_reply("Send",\%accept_reply);
 563
 564     if ($authmech == AUTHMECH_INVALID)
 565     {
 566         $SOCKS_ERROR = "No available auth methods.";
 567         return;
 568     }
 569
 570     return $authmech;
 571 }
 572
 573
 574 ###############################################################################
 575 #
 576 # _socks5_accept_auth - Send and receive a SOCKS5 auth handshake
 577 #
 578 ###############################################################################
 579 sub _socks5_accept_auth
 580 {
 581     my $self = shift;
 582     my $client = shift;
 583
 584     #--------------------------------------------------------------------------
 585     # Send the auth
 586     #--------------------------------------------------------------------------
 587     my %auth;
 588     $auth{version} = $client->_socks_read();
 589     $auth{user_length} = $client->_socks_read();
 590     $auth{user} = $client->_socks_read_raw($auth{user_length});
 591     $auth{pass_length} = $client->_socks_read();
 592     $auth{pass} = $client->_socks_read_raw($auth{pass_length});
 593
 594     $self->_debug_auth("Recv",\%auth);
 595
 596     my $status = 0;
 597     if (defined($self->{UserAuth}))
 598     {
 599         $status = &{$self->{UserAuth}}($auth{user},$auth{pass});
 600     }
 601
 602     #--------------------------------------------------------------------------
 603     # Read the reply
 604     #--------------------------------------------------------------------------
 605     my %auth_reply;
 606     $auth_reply{version} = 1;
 607     $auth_reply{status} = AUTHREPLY_SUCCESS;
 608     $auth_reply{status} = AUTHREPLY_FAILURE if !$status;
 609
 610     $client->_socks_send($auth_reply{version});
 611     $client->_socks_send($auth_reply{status});
 612     $client->_socks_flush;
 613
 614     $self->_debug_auth_reply("Send",\%auth_reply);
 615
 616     if ($auth_reply{status} != AUTHREPLY_SUCCESS)
 617     {
 618         $SOCKS_ERROR = "Authentication failed with SOCKS5 proxy.";
 619         return;
 620     }
 621
 622     return 1;
 623 }
 624
 625
 626 ###############################################################################
 627 #
 628 # _socks5_acccept_command - Process a SOCKS5 command request.  Since this is
 629 #                           a library and not a server, we cannot process the
 630 #                           command.  Let the parent program handle that.
 631 #
 632 ###############################################################################
 633 sub _socks5_accept_command
 634 {
 635     my $self = shift;
 636     my $client = shift;
 637
 638     #--------------------------------------------------------------------------
 639     # Read the command
 640     #--------------------------------------------------------------------------
 641     my %command;
 642     $command{version} = $client->_socks_read();
 643     $command{command} = $client->_socks_read();
 644     $command{reserved} = $client->_socks_read();
 645     $command{atype} = $client->_socks_read();
 646
 647     if ($command{atype} == ADDR_DOMAINNAME)
 648     {
 649         $command{host_length} =  $client->_socks_read();
 650         $command{host} = $client->_socks_read_raw($command{host_length});
 651     }
 652     elsif ($command{atype} == ADDR_IPV4)
 653     {
 654         $command{host} = unpack("N",$client->_socks_read_raw(4));
 655     }
 656     else
 657     {
 658         $client->_socks_accept_command_reply(REPLY_ADDR_NOT_SUPPORTED);
 659         $SOCKS_ERROR = $CODES{REPLY}->[REPLY_ADDR_NOT_SUPPORTED];
 660         return;
 661     }
 662
 663     $command{port} = unpack("n",$client->_socks_read_raw(2));
 664
 665     $self->_debug_command("Recv",\%command);
 666
 667     ${*$client}->{SOCKS}->{COMMAND} = [$command{command},$command{host},$command{port}];
 668
 669     return 1;
 670 }
 671
 672
 673 ###############################################################################
 674 #
 675 # _socks5_acccept_command_reply - Answer a SOCKS5 command request.  Since this
 676 #                                 is a library and not a server, we cannot
 677 #                                 process the command.  Let the parent program
 678 #                                 handle that.
 679 #
 680 ###############################################################################
 681 sub _socks5_accept_command_reply
 682 {
 683     my $self = shift;
 684     my $reply = shift;
 685     my $host = shift;
 686     my $port = shift;
 687
 688     if (!defined($reply) || !defined($host) || !defined($port))
 689     {
 690         croak("You must provide a reply, host, and port on the command reply.");
 691     }
 692
 693     #--------------------------------------------------------------------------
 694     # Send the reply
 695     #--------------------------------------------------------------------------
 696     my %command_reply;
 697     $command_reply{version} = SOCKS5_VER;
 698     $command_reply{status} = $reply;
 699     $command_reply{reserved} = 0;
 700     $command_reply{atype} = ADDR_DOMAINNAME;
 701     $command_reply{host_length} = length($host);
 702     $command_reply{host} = $host;
 703     $command_reply{port} = $port;
 704
 705     $self->_debug_command_reply("Send",\%command_reply);
 706
 707     $self->_socks_send($command_reply{version});
 708     $self->_socks_send($command_reply{status});
 709     $self->_socks_send($command_reply{reserved});
 710     $self->_socks_send($command_reply{atype});
 711     $self->_socks_send($command_reply{host_length});
 712     $self->_socks_send_raw($command_reply{host});
 713     $self->_socks_send_raw(pack("n",$command_reply{port}));
 714     $self->_socks_flush;
 715 }
 716
 717
 718 ###############################################################################
 719 #
 720 # command_reply - public reply wrapper to the client.
 721 #
 722 ###############################################################################
 723 sub command_reply
 724 {
 725     my $self = shift;
 726     $self->_socks5_accept_command_reply(@_);
 727 }
 728
 729
 730
 731
 732
 733 ###############################################################################
 734 #+-----------------------------------------------------------------------------
 735 #| Helper Functions
 736 #+-----------------------------------------------------------------------------
 737 ###############################################################################
 738
 739 ###############################################################################
 740 #
 741 # _socks_read - send over the socket after packing according to the rules.
 742 #
 743 ###############################################################################
 744 sub _socks_send
 745 {
 746     my $self = shift;
 747     my $data = shift;
 748
 749     $data = pack("C",$data);
 750     $self->_socks_send_raw($data);
 751 }
 752
 753
 754 ###############################################################################
 755 #
 756 # _socks_send_raw - send raw data across the socket.
 757 #
 758 ###############################################################################
 759 sub _socks_send_raw
 760 {
 761     my $self = shift;
 762     my $data = shift;
 763
 764     push @{$self->{data}}, $data;
 765 }
 766
 767 sub _socks_flush {
 768     my $self = shift;
 769     my $data = $self->{data};
 770     undef $self->{data};
 771
 772     $data = join '', @$data;
 773
 774     $self->{socket}->syswrite($data,length($data));
 775 }
 776
 777
 778 ###############################################################################
 779 #
 780 # _socks_read - read from the socket, and then unpack according to the rules.
 781 #
 782 ###############################################################################
 783 sub _socks_read
 784 {
 785     my $self = shift;
 786     my $length = shift;
 787     $length = 1 unless defined($length);
 788
 789     my $data = $self->_socks_read_raw($length);
 790     $data = unpack("C",$data);
 791     return $data;
 792 }
 793
 794
 795 ###############################################################################
 796 #
 797 # _socks_read_raw - read raw bytes off of the socket
 798 #
 799 ###############################################################################
 800 sub _socks_read_raw
 801 {
 802     my $self = shift;
 803     my $length = shift;
 804     $length = 1 unless defined($length);
 805
 806     my $data;
 807     sysread($self->{socket}, $data, $length);
 808     return $data;
 809 }
 810
 811
 812
 813
 814 ###############################################################################
 815 #+-----------------------------------------------------------------------------
 816 #| Debug Functions
 817 #+-----------------------------------------------------------------------------
 818 ###############################################################################
 819
 820 sub _debug_connect
 821 {
 822     my $self = shift;
 823     my $tag = shift;
 824     my $connect = shift;
 825
 826     return unless $self->{Debug};
 827
 828     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
 829     print "$tag: | Vers | Auth |";
 830     if ($connect->{num_methods} > 0)
 831     {
 832         print " Meth "," "x(4*($connect->{num_methods}-1)),"|\n";
 833     }
 834     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
 835
 836     print "$tag: | ";
 837     printf("\\%02X",$connect->{version});
 838     print "  | ";
 839     printf("\\%02X",$connect->{num_methods});
 840     print "  | ";
 841     if ($connect->{num_methods} > 0)
 842     {
 843         foreach my $method (@{$connect->{methods}})
 844         {
 845             printf("\\%02X ",$method);
 846         }
 847         print " |";
 848     }
 849
 850     print "\n";
 851     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
 852     print "\n";
 853 }
 854
 855
 856 sub _debug_connect_reply
 857 {
 858     my $self = shift;
 859     my $tag = shift;
 860     my $connect_reply = shift;
 861
 862     return unless $self->{Debug};
 863
 864     print "$tag: +------+------+\n";
 865     print "$tag: | Vers | Auth |\n";
 866     print "$tag: +------+------+\n";
 867     print "$tag: | ";
 868
 869     printf("\\%02X",$connect_reply->{version});
 870     print "  | ";
 871     printf("\\%02X",$connect_reply->{auth_method});
 872     print "  |\n";
 873
 874     print "$tag: +------+------+\n";
 875     print "\n";
 876 }
 877
 878
 879 sub _debug_auth
 880 {
 881     my $self = shift;
 882     my $tag = shift;
 883     my $auth = shift;
 884
 885     return unless $self->{Debug};
 886
 887     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
 888     print "$tag: | Vers | UsrL | User "," "x($auth->{user_length}-4),"| PasL | Pass"," "x($auth->{pass_length}-4)," |\n";
 889     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
 890     print "$tag: | ";
 891
 892     printf("\\%02X",$auth->{version});
 893     print "  | ";
 894     printf("\\%02d",$auth->{user_length});
 895     print "  | ";
 896     print $auth->{user}," "x(4-$auth->{user_length});
 897     print " | ";
 898     printf("\\%02d",$auth->{pass_length});
 899     print "  | ";
 900     print $auth->{pass}," "x(4-$auth->{pass_length});
 901
 902     print " |\n";
 903     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
 904     print "\n";
 905 }
 906
 907
 908 sub _debug_auth_reply
 909 {
 910     my $self = shift;
 911     my $tag = shift;
 912     my $auth_reply = shift;
 913
 914     return unless $self->{Debug};
 915
 916     print "$tag: +------+------+\n";
 917     print "$tag: | Vers | Stat |\n";
 918     print "$tag: +------+------+\n";
 919     print "$tag: | ";
 920
 921     printf("\\%02X",$auth_reply->{version});
 922     print "  | ";
 923     printf("\\%02X",$auth_reply->{status});
 924     print "  |\n";
 925
 926     print "$tag: +------+------+\n";
 927     print "\n";
 928 }
 929
 930
 931 sub _debug_command
 932 {
 933     my $self = shift;
 934     my $tag = shift;
 935     my $command = shift;
 936
 937     return unless $self->{Debug};
 938
 939     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
 940     print "$tag: | Vers | Comm | Resv | ATyp | Host  "," "x$command->{host_length}," | Port  |\n";
 941     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
 942     print "$tag: | ";
 943
 944     printf("\\%02X",$command->{version});
 945     print "  | ";
 946     printf("\\%02X",$command->{command});
 947     print "  | ";
 948     printf("\\%02X",$command->{reserved});
 949     print "  | ";
 950     printf("\\%02X",$command->{atype});
 951     print "  | ";
 952     printf("\\%02d",$command->{host_length});
 953     print " - ";
 954     print $command->{host};
 955     print " | ";
 956     printf("%-5d",$command->{port});
 957
 958     print " |\n";
 959     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
 960     print "\n";
 961 }
 962
 963
 964 sub _debug_command_reply
 965 {
 966     my $self = shift;
 967     my $tag = shift;
 968     my $command_reply = shift;
 969
 970     return unless $self->{Debug};
 971
 972     print "$tag: +------+------+";
 973     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
 974         if ($command_reply->{status} == 0);
 975     print "\n";
 976
 977     print "$tag: | Vers | Stat |";
 978     print " Resv | ATyp | Host  "," "x$command_reply->{host_length}," | Port  |"
 979         if ($command_reply->{status} == 0);
 980     print "\n";
 981
 982     print "$tag: +------+------+";
 983     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
 984         if ($command_reply->{status} == 0);
 985     print "\n";
 986
 987     print "$tag: | ";
 988
 989     printf("\\%02X",$command_reply->{version});
 990     print "  | ";
 991     printf("\\%02X",$command_reply->{status});
 992     if ($command_reply->{status} == 0)
 993     {
 994         print "  | ";
 995         printf("\\%02X",$command_reply->{reserved});
 996         print "  | ";
 997         printf("\\%02X",$command_reply->{atype});
 998         print "  | ";
 999         printf("\\%02d",$command_reply->{host_length});
1000         print " - ";
1001         print $command_reply->{host};
1002         print " | ";
1003         printf("%-5d",$command_reply->{port});
1004     }
1005     else
1006     {
1007         print " ";
1008     }
1009     print " |\n";
1010
1011     print "$tag: +------+------+";
1012     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
1013         if ($command_reply->{status} == 0);
1014     print "\n";
1015     print "\n";
1016 }
1017
1018
1019 1;