SOCKS-0.03/ 40755 144 144 0 6530270664 5356 SOCKS-0.03/Changes100644 144 144 1106 6530271347 6750 Revision history for Perl extension Net::SOCKS. 0.03 Tue May 19 04:51:20 PDT 1998 - SOCKS v5 support. - SOCKS v5 Username/password support. - POD cleanup. 0.02 Sun Dec 28 21:37:15 PDT 1997 - Methods now use a hash (or reference to a hash) for parameters. - connect() and accept() now return a reference to a Net::Socket::INET object instead of a response code. - Access to Net::SOCKS variables are now through the param() method. - Added status codes and human readable status messages. 0.01 Tue Dec 16 15:36:36 PDT 1997 - original version; created by h2xs 1.16 SOCKS-0.03/MANIFEST100644 144 144 610 6525534311 6562 Changes - revision history example - sample code to try out Net::SOCKS MANIFEST - this file Makefile.PL - "perl Makefile.PL" to get things started README - read this first lib/Net/SOCKS.pm - the main module t/none.t - test script (empty - for version 0.03) TODO - list of features planned for next release SOCKS-0.03/Makefile.PL100644 144 144 362 6525534717 7421 use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Net::SOCKS', 'VERSION_FROM' => 'lib/Net/SOCKS.pm', # finds $VERSION ); SOCKS-0.03/README100644 144 144 1464 6530300061 6326 Introduction ------------ This is a SOCKS client module that can communicate with SOCKS v4 and v5 servers. It currently allows you to make outgoing and incoming TCP connections. UDP is not yet supported and is first on the TODO list. Included in this distribution is a sample program called "example" to show you how to use this module. Net::SOCKS documentation is available on your system by doing a "perldoc Net::SOCKS". Resources on the Internet ------------------------- The latest Net::SOCKS module can be found at: http://www.perl.com/CPAN/modules/by-module/Net/ General SOCKS information: http://www.socks.nec.com/ Installing ---------- To install, do the usual "perl Makefile.PL ; make ; make test ; make install". Cheers, Clinton Wong clintdw@netcom.com http://postmaster.net/~clintdw/ May 19, 1998 SOCKS-0.03/t/ 40755 144 144 0 6525534254 5623 SOCKS-0.03/t/none.t100644 144 144 1217 6445610204 7041 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use Net::SOCKS; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): SOCKS-0.03/TODO100644 144 144 403 6530275271 6124 Support for: - UDP associate - Challenge Handshake Authentication (CHAP) Protocol - Generic Security Service (GSS) API - Extensible Authentication Protocol (EAP) Authentication - Multi-authentication Framework Method (MAF) - SOCKS5 multicast extension SOCKS-0.03/example100744 144 144 2620 6530270663 7036 #!/usr/local/bin/perl -w use strict; use Net::SOCKS; print "Attempting to connect to 192.168.1.3 at port 79 using the socks\n"; print "server at 192.168.1.3 port 1080\n"; my $sock = new Net::SOCKS(socks_addr => '192.168.1.3', socks_port => 1080, #user_id => 'the_user', #user_password => 'the_password', #force_nonanonymous => 1, protocol_version => 5); my $f= $sock->connect(peer_addr => '192.168.1.3', peer_port => 79); print "connect status: ", Net::SOCKS::status_message($sock->param('status_num')), "\n"; if ($sock->param('status_num') == SOCKS_OKAY) { print $f "clintdw\n"; while (<$f>) { print } $sock->close(); } print "Attempting to listen() using the server at 192.168.1.3 port 1080\n"; $sock = new Net::SOCKS(socks_addr => '192.168.1.3', socks_port => 1080, #user_id => 'the_user', #user_password => 'the_password', #force_nonanonymous => 1, protocol_version => 5); my ($ip, $ip_dot_dec, $port) = $sock->bind(peer_addr => "192.168.1.3", peer_port => 9999); print "bind status: ", Net::SOCKS::status_message($sock->param('status_num')), "\n"; if ($sock->param('status_num') == SOCKS_OKAY) { print "Listening at the IP of ", $ip_dot_dec, " at port ", $port, "\n"; $f= $sock->accept(); } print "accept status: ", Net::SOCKS::status_message($sock->param('status_num')), "\n"; if ($sock->param('status_num') == SOCKS_OKAY) { while (<$f>) { print } } $sock->close(); SOCKS-0.03/lib/ 40755 144 144 0 6525533560 6125 SOCKS-0.03/lib/Net/ 40755 144 144 0 6525533566 6661 SOCKS-0.03/lib/Net/SOCKS.pm100644 144 144 41255 6530274627 10226 package Net::SOCKS; # Copyright (c) 1997-1998 Clinton Wong. All rights reserved. # This program is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. use strict; use vars qw($VERSION @ISA @EXPORT); use IO::Socket; use Carp; require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader); @EXPORT = qw(); $VERSION = '0.03'; # Status code exporter adapted from HTTP::Status by Gisle Aas. # Please note - users of this module should not use hard coded numbers # in their programs. Always use the SOCKS_ version of # the status code, which are the descriptions below # converted to uppercase and _ replacing dash and SPACE. my %status_code = ( 1 => "general SOCKS server failure", # SOCKS5 2 => "connection not allowed by ruleset", 3 => "network unreachable", 4 => "host unreachable", 5 => "connection refused", 6 => "TTL expired", 7 => "command not supported", 8 => "address type not supported", 90 => "okay", # SOCKS4 91 => "failed", 92 => "no ident", 93 => "user mismatch", 100 => "incomplete auth", # generic 101 => "bad auth", 102 => "server denies auth method", 202 => "missing SOCKS server net data", 203 => "missing peer net data", 204 => "SOCKS server unavailable", 205 => "timeout", 206 => "unsupported protocol version", 207 => "unsupported address type", 208 => "hostname lookup failure" ); my $mnemonic_code = ''; my ($code, $message); while (($code, $message) = each %status_code) { # create mnemonic subroutines $message =~ tr/a-z \-/A-Z__/; $mnemonic_code .= "sub SOCKS_$message () { $code }\t"; $mnemonic_code .= "push(\@EXPORT, 'SOCKS_$message');\n"; } eval $mnemonic_code; # only one eval for speed die if $@; sub status_message { return undef unless exists $status_code{ $_[0] }; $status_code{ $_[0] }; } 1; __END__ =head1 NAME Net::SOCKS - a SOCKS client class =head1 SYNOPSIS Establishing a connection: my $sock = new Net::SOCKS(socks_addr => '192.168.1.3', socks_port => 1080, user_id => 'the_user', user_password => 'the_password', force_nonanonymous => 1, protocol_version => 5); # connect to finger port and request finger information for some_user my $f= $sock->connect(peer_addr => '192.168.1.3', peer_port => 79); print $f "some_user\n"; # example writing to socket while (<$f>) { print } # example reading from socket $sock->close(); Accepting an incoming connection: my $sock = new Net::SOCKS(socks_addr => '192.168.1.3', socks_port => 1080, user_id => 'the_user', user_password => 'the_password', force_nonanonymous => 1, protocol_version => 5); my ($ip, $ip_dot_dec, $port) = $sock->bind(peer_addr => "128.10.10.11", peer_port => 9999); $f= $sock->accept(); print $f "Hi! Type something.\n"; # example writing to socket while (<$f>) { print } # example reading from socket $sock->close(); =head1 DESCRIPTION my $sock = new Net::SOCKS(socks_addr => '192.168.1.3', socks_port => 1080, user_id => 'the_user', user_password => 'the_password', force_nonanonymous => 1, protocol_version => 5); To connect to a SOCKS server, specify the SOCKS server's hostname, port number, SOCKS protocol version, username, and password. Username and password are optional if you plan to use a SOCKS server that doesn't require any authentication. If you would like to force the connection to be nonanoymous, set the force_nonanonymous parameter. my $f= $sock->connect(peer_addr => '192.168.1.3', peer_port => 79); To connect to another machine using SOCKS, use the connect method. Specify the host and port number as parameters. my ($ip, $ip_dot_dec, $port) = $sock->bind(peer_addr => "192.168.1.3", peer_port => 9999); If you wanted to accept a connection with SOCKS, specify the host and port of the machine you expect a connection from. Upon success, bind() returns the ip address and port number that the SOCKS server is listening at on your behalf. $f= $sock->accept(); If a call to bind() returns a success status code SOCKS_OKAY, a call to the accept() method will return when the peer host connects to the host/port that was returned by the bind() method. Upon success, accept() returns SOCKS_OKAY. $sock->close(); Closes the connection. =head1 SEE ALSO RFC 1928, RFC 1929. =head1 AUTHOR Clinton Wong, clintdw@netcom.com =head1 COPYRIGHT Copyright (c) 1997-1998 Clinton Wong. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # constructor new() # We don't do any parameter error checking here because the programmer # should be able to get an object back from new(). A croak # isn't graceful and returning undef isn't descriptive enough. # Error checking happens when connect() or bind() calls _validate(). # Error messages are retrieved through status_message() and # param('status_num'). sub new { my $class = shift; my $self = {}; bless $self, $class; ${*self}{status_num} = SOCKS_OKAY; $self->_import_args(@_); $self; } # connect() opens a socket through _request() and sends a command # code of 1 to the SOCKS server. It returns a reference to a socket # upon success or undef upon failure. sub connect { my $self = shift; if (${*self}{protocol_version}==4) { if ( $self->_request(1, @_) == SOCKS_OKAY ) { return ${*self}{fh} } } elsif (${*self}{protocol_version}==5) { if ( $self->_request5(1, @_) == SOCKS_OKAY ) { return ${*self}{fh} } } else { ${*self}{status_num} = SOCKS_UNSUPPORTED_PROTOCOL_VERSION; } return undef; } # bind() opens a socket through _request() and sends a command # code of 2 to the SOCKS server. Upon success, it returns # an array of (32 bit IP address, IP address as dotted decimal, # port number) where the SOCKS server is listening on the # client's behalf. Upon failure, return undef. sub bind { my $self = shift; if (${*self}{protocol_version}==4) { $self->_request(2, @_); } elsif (${*self}{protocol_version}==5) { $self->_request5(2, @_); } else { ${*self}{status_num} = SOCKS_UNSUPPORTED_PROTOCOL_VERSION; } if (${*self}{status_num} != SOCKS_OKAY) { return undef; } # if we're working with an IPv4 address if (${*self}{protocol_version}==4 || (${*self}{protocol_version}==5 && defined ${*self}{addr_type} && ${*self}{addr_type}==1)) { # if the listen address is zero, assume it is the same as the socks host if (defined ${*self}{listen_addr} && ${*self}{listen_addr} == 0) { ${*self}{listen_addr} = ${*self}{socks_addr}; } my $dotted_dec = inet_ntoa( pack ("N", ${*self}{listen_addr} ) ); if (${*self}{status_num}==SOCKS_OKAY) { return (${*self}{listen_addr}, $dotted_dec, ${*self}{listen_port}) } } else { # not a 32 bit IPv4 address. FQDN or IPv6 then. if (${*self}{addr_type}==4) { # IPv6? ${*self}{status_num} = SOCKS_UNSUPPORTED_ADDRESS_TYPE; return undef; } if (${*self}{addr_type}==3) { # FQDN? my $addr = gethostbyname(${*self}{listen_addr}); # -> 32 bit IPv4 ${*self}{listen_hostname} = ${*self}{listen_addr}; if (! defined $addr) { ${*self}{status_num}=SOCKS_HOSTNAME_LOOKUP_FAILURE; return undef; } my $dotted_dec = inet_ntoa( pack ("N", $addr ) ); return ($addr, $dotted_dec, ${*self}{listen_port}) } } return undef; } # Upon success, return a reference to a socket. Otherwise, return undef. sub accept { my ($self) = @_; if (${*self}{protocol_version}==4) { if ($self->_get_response() == SOCKS_OKAY ) { return ${*self}{fh} } } elsif (${*self}{protocol_version}==5) { $self->_get_resp5(); if (${*self}{status_num} != SOCKS_OKAY) {return undef} if (${*self}{addr_type}==4) { # IPv6? ${*self}{status_num} = SOCKS_UNSUPPORTED_ADDRESS_TYPE; return undef; } if (${*self}{addr_type}==3) { # FQDN? my $addr = gethostbyname(${*self}{listen_addr}); # -> 32 bit IPv4 ${*self}{listen_hostname} = ${*self}{listen_addr}; if (! defined $addr) { ${*self}{status_num}=SOCKS_HOSTNAME_LOOKUP_FAILURE; return undef; } ${*self}{listen_addr}=$addr; # we expect IPv4 to live there } return ${*self}{fh} } else { ${*self}{status_num} = SOCKS_UNSUPPORTED_PROTOCOL_VERSION; } return undef; } sub close { my ($self) = @_; if (defined ${*self}{fh}) {close(${*self}{fh})} } # Validate that destination host/port exists sub _validate { my $self = shift; # check the method parameters unless (defined ${*self}{socks_addr} && length ${*self}{socks_addr}) { return ${*self}{status_num} = SOCKS_MISSING_SOCKS_SERVER_NET_DATA; } unless (defined ${*self}{socks_port} && ${*self}{socks_port} > 0) { return ${*self}{status_num} = SOCKS_MISSING_SOCKS_SERVER_NET_DATA; } unless (defined ${*self}{peer_addr} && length ${*self}{peer_addr}) { return ${*self}{status_num} = SOCKS_MISSING_PEER_NET_DATA; } unless (defined ${*self}{peer_port} && ${*self}{peer_port} > 0) { return ${*self}{status_num} = SOCKS_MISSING_PEER_NET_DATA; } unless (defined ${*self}{protocol_version} && (${*self}{protocol_version}==4 || ${*self}{protocol_version}==5) ) { return ${*self}{status_num} = SOCKS_UNSUPPORTED_PROTOCOL_VERSION; } if (${*self}{protocol_version}==5 && defined ${*self}{user_id} && length(${*self}{user_id})>0 && (! defined ${*self}{user_password} || length(${*self}{user_password}) == 0 ) ) { return ${*self}{status_num} = SOCKS_INCOMPLETE_AUTH; } if ( ! defined ${*self}{user_id} ) { ${*self}{user_id}='' } return ${*self}{status_num} = SOCKS_OKAY; } sub _request { my $self = shift; my $req_num = shift; my $rc; $self->_import_args(@_); $rc=$self->_validate(); if ($rc != SOCKS_OKAY) { return ${*self}{status_num} = $rc } # connect to the SOCKS server $rc=$self->_connect(); if ($rc==SOCKS_OKAY) { #fixme - check to make sure peer_addr is dotted decimal or do name # resolution on it first # send the request print { ${*self}{fh} } pack ('CCn', 4, $req_num, ${*self}{peer_port}) . inet_aton(${*self}{peer_addr}) . ${*self}{user_id} . (pack 'x'); # get server response, returns server response code return $self->_get_response(); } return ${*self}{status_num} = $rc; } # reads response from server, returns status_code, sets object values sub _get_response { my ($self) = @_; my $received = ''; while ( read(${*self}{fh}, $received, 8) && (length($received) < 8) ) {} ( ${*self}{vn}, ${*self}{cd}, ${*self}{listen_port}, ${*self}{listen_addr} ) = unpack 'CCnN', $received; return ${*self}{status_num} = ${*self}{cd}; } sub _request5 { my $self = shift; my $req_num = shift; my $rc; $self->_import_args(@_); $rc=$self->_validate(); if ($rc != SOCKS_OKAY) { return ${*self}{status_num} = $rc } # connect to the SOCKS server ${*self}{status_num}=$self->_connect(); if (${*self}{status_num} != SOCKS_OKAY) {return ${*self}{status_num}} # send method request $self->_method_request5(); if (${*self}{status_num} != SOCKS_OKAY) {return ${*self}{status_num}} # get server method response $self->_method_response5(); if (${*self}{status_num} != SOCKS_OKAY) {return ${*self}{status_num}} if ( ${*self}{returned_method} == 2) { # username/password needed $self->_user_request5(); if (${*self}{status_num} != SOCKS_OKAY) {return ${*self}{status_num}} $self->_user_response5(); if (${*self}{status_num} != SOCKS_OKAY) {return ${*self}{status_num}} } my $addr_type; my $dest_addr; if (${*self}{peer_addr} =~ /[a-z][A-Z]/) { # FQDN? $addr_type=3; $dest_addr = length(${*self}{peer_addr}) . ${*self}{peer_addr}; } else { # nope. Must be dotted-dec. $addr_type = 1; $dest_addr = inet_aton(${*self}{peer_addr}); } print { ${*self}{fh} } pack ('CCCC', 5, $req_num, 0, $addr_type); print { ${*self}{fh} } $dest_addr . pack('n', ${*self}{peer_port}); $self->_get_resp5(); return ${*self}{status_num}; } # reads response from server, returns status_code, sets object values sub _get_resp5 { my ($self) = @_; my $received = ''; while ( read(${*self}{fh}, $received, 4) && (length($received) < 4) ) {} ( ${*self}{vn}, ${*self}{cd}, ${*self}{socks_flag}, ${*self}{addr_type})= unpack('CCCC', $received); if ( ${*self}{addr_type} == 3) { # FQDN $received = ''; # get length of hostname (pascal style string) while ( read(${*self}{fh}, $received, 1) && (length($received) < 1) ) {} my $length = unpack('C', $received); $received = ''; while ( read(${*self}{fh}, $received, $length) && (length($received) < $length) ) {} ${*self}{listen_addr} = $received; } elsif ( ${*self}{addr_type} == 1) { # IPv4 32 bit $received = ''; while ( read(${*self}{fh}, $received, 4) && (length($received) < 4) ) {} ${*self}{listen_addr}=unpack('N', $received); } else { # IPv6, others ${*self}{status_num} = SOCKS_UNSUPPORTED_ADDRESS_TYPE; } $received = ''; while ( read(${*self}{fh}, $received, 2) && (length($received) < 2) ) {} ${*self}{listen_port} = unpack('n', $received); if (${*self}{cd} == 0) { # convert SOCKS5 success status code into the one SOCKS4 uses ${*self}{cd} = SOCKS_OKAY; } return ${*self}{status_num} = ${*self}{cd}; } sub _method_request5 { my $self = shift; my $method = ''; # add anonymous to method list if the user didn't specify force_nonanonymous if ( !defined ${*self}{force_nonanonymous} || ${*self}{force_nonanonymous}==0) { # add anonymous connect to method list $method.=pack('C', 0); # anonymous } if ( defined ${*self}{user_id} && length (${*self}{user_id})>0 ) { $method.=pack('C', 2); # user/pass } if (length($method)==0) { return ${*self}{status_num} = SOCKS_INCOMPLETE_AUTH; } print { ${*self}{fh} } pack ('CC', 5, length($method)), $method; return SOCKS_OKAY; } sub _method_response5 { my ($self) = @_; my $received = ''; while ( read(${*self}{fh}, $received, 2) && (length($received) < 2) ) {} my ($ver, $method) = unpack 'CC', $received; if ($ver!=5) {return SOCKS_UNSUPPORTED_PROTOCOL_VERSION} if ($method==255) {return SOCKS_SERVER_DENIES_AUTH_METHOD} ${*self}{returned_method} = $method; } # code to send username/password to socks5 server sub _user_request5 { my ($self) = @_; # check to make sure the user passed in a user/pass field if (! defined ${*self}{user_id} || ! defined ${*self}{user_password} || length(${*self}{user_id}) == 0 || length(${*self}{user_password}) == 0) { return ${*self}{status_num} = SOCKS_INCOMPLETE_AUTH; } print { ${*self}{fh} } pack ('CC', 1, length(${*self}{user_id})), ${*self}{user_id}, pack ('C', length(${*self}{user_password})), ${*self}{user_password}; return ${*self}{status_num} = SOCKS_OKAY; } sub _user_response5 { my ($self) = @_; my $received = ''; while ( read(${*self}{fh}, $received, 2) && (length($received) < 2) ) {} my ($ver, $status) = unpack 'CC', $received; if ($status != 0) { return ${*self}{status_num} = SOCKS_BAD_AUTH; } return ${*self}{status_num} = SOCKS_OKAY; } # connect to socks server sub _connect { my ($self) = @_; ${*self}{fh} = new IO::Socket::INET ( PeerAddr => ${*self}{socks_addr}, PeerPort => ${*self}{socks_port}, Proto => 'tcp' ) || return ${*self}{status_num} = SOCKS_FAILED; my $old_fh = select(${*self}{fh}); $|=1; select($old_fh); return ${*self}{status_num} = SOCKS_OKAY; } sub _import_args { my $self = shift; my (%arg, $key); # if a reference was passed, dereference it first if (ref($_[0]) eq 'HASH') { %arg = %{$_[0]} } else { %arg = @_ } foreach $key (keys %arg) { ${*self}{$key} = $arg{$key} } } # get/set an internal variable # Currently known are: # socks_addr, socks_port, listen_addr, listen_port, # peer_addr, peer_port, fh, user_id, vn, cd, status_num. sub param { my ($self, $key, $value) = @_; if (! defined $value) { # No value given. We're doing a "get" if ( defined ${*self}{$key} ) { return ${*self}{$key} } else { return undef } } # Value given. We're doing a "set" ${*self}{$key} = $value; return $value; } 1;