Simple Socks5 Server for Perl

From RubberDuck, 4 Years ago, written in Perl, viewed 712 times.
URL http://paste.security-portal.cz/view/e455ca67 Embed
Download Paste or View Raw
  1. #!/usr/bin/perl
  2. #sss.pl v0.1.4 (03/05/10)
  3.  
  4. use warnings; use strict;
  5.  
  6. =head1 NAME
  7.  
  8. Simple SOCKS5 Server for Perl
  9.  
  10. =head1 DESCRIPTION
  11.  
  12. SSS is a Simple SOCKS Server written in perl that implements the SOCKS v5 protocol.
  13.  
  14. It will accept username/password authentication.
  15.  
  16. The script runs in the background as a daemon.
  17.  
  18. =head2 HISTORY
  19.  
  20. Originally I was looking for a simple SOCKS5 Server (with user/pass auth) that
  21. would run as a non-root user on FreeBSD.
  22.  
  23. I checked the FreeBSD ports for various SOCKS5 solutions and tried them all,
  24. only to discover that each one had a reason why it would not work, or why I
  25. could not use it.
  26.  
  27. I figured this could be done in perl, but found that there was no well
  28. maintained perl based solutions.
  29.  
  30. I hacked together this solution (with help from public domain scripts) and
  31. cleaned it up, ready for release.
  32.  
  33. Its simple, a feature I intend to maintain, however there is scope for much more
  34. potential, especially with user feedback.
  35.  
  36. You can read the full story here:
  37.   http://www.hm2k.com/posts/freebsd-socks-proxy-for-mirc
  38.  
  39. =head2 INSTALL
  40.  
  41.   wget http://ssspl.svn.sourceforge.net/viewvc/ssspl/sss.pl
  42.   chmod 755 sss.pl
  43.  
  44. OR
  45.  
  46.   http://ssspl.svn.sourceforge.net/viewvc/ssspl.tar.gz?view=tar
  47.   tar zxvf ssspl.tar.gz
  48.   chmod 755 ssspl/sss.pl
  49.  
  50. =head2 USAGE
  51.  
  52. You run the script using the following command:
  53.         ./sss.pl <local_host> <local_port> [auth_login(:auth_pass)]
  54. Note: the auth_pass must be an md5 (hex) hash
  55.         eg: ./sss.pl hostname.example.com 34567 test:ae2b1fca515949e5d54fb22b8ed95575
  56.  
  57. Once up and running you can use the server in mIRC using the following command:
  58.         /firewall [-cmN[+|-]d] [on|off] <server> <port> <userid> <password>
  59. For more information on this command issue: /help /firewall in mIRC.
  60.         eg: /firewall -m5 on hostname.example.com 34567 test testing
  61.  
  62. =head1 PREREQUISITES
  63.  
  64. Operating System: Tested on FreeBSD 6.x and CentOS 4.x, should work on others.
  65.  
  66. Required modules: C<IO::Socket::INET>, C<Digest::MD5>.
  67.  
  68. =head1 CHANGES
  69. v0.1.4  (03/05/10)  - Improved documentation and logging subs
  70. v0.1.3  (24/11/09)  - Improved documentation and code
  71.                     - PID is displayed during fork
  72.                     - Added logging (for Katlyn`)
  73. v0.1.2  (27/02/09)  - Fixed a bug (Thanks Andreas)
  74. v0.1.1  (02/10/08)  - Improved documentation
  75. v0.1    (12/09/08)  - Initial release.
  76.  
  77. =head1 TODO
  78. * Restrict IP access to the listening port <Reeve>
  79. * Need a log format, see: http://en.wikipedia.org/wiki/Common_Log_Format
  80. * Mozilla Firefox support/GSSAPI authentication support <OutCast3k, kingvis>
  81. ** See: http://forums.mozillazine.org/viewtopic.php?f=38&t=847655
  82. ** Alternative: http://blogs.techrepublic.com.com/security/?p=421
  83. * IPv6 support
  84. * BIND method
  85. * UDP ASSOCIATE method
  86. * pid file <mrakus>
  87. * perl threads instead of fork()? <mrakus>
  88.  
  89. =head2 FAQ
  90. * Why is there multiple processes in my process list?
  91. ** Each new connection spawns a new process, so it is easier to manage.
  92. * Why does $serverip in mIRC return 255.255.255.255?
  93. ** 255.255.255.255 is the default value of a non-resolved address (INADDR_NONE).
  94. ** mIRC does not need to resolve the IRC server address.
  95. ** See: http://tinyurl.com/yjs8kyf
  96. * Why is DCC SEND or DCC CHAT is not working?
  97. ** It should work, contact me to diagnose further.
  98. ** See: http://www.mirc.com/help/help-dcc.txt
  99. * How do I create an md5 hash?
  100. ** In mIRC do: //echo -a $md5(password)
  101. ** You can visit: http://pajhome.org.uk/crypt/md5/
  102. ** I also added a -getmd5 option which you can use
  103. * Why doesnt this work with Mozilla Firefox?
  104. ** Because Mozilla wont add SOCKS5 username/password auth support
  105. ** Because Ive not added GSSAPI support yet (donations please)
  106.  
  107. =head2 NOTES
  108. * http://en.wikipedia.org/wiki/SOCKS
  109. * http://ftp.icm.edu.pl/packages/socks/socks4/SOCKS4.protocol
  110. * http://ftp.icm.edu.pl/packages/socks/socks4/SOCKS4A.protocol
  111. * http://tools.ietf.org/html/rfc1928
  112. * http://tools.ietf.org/html/rfc1929
  113. * http://tools.ietf.org/html/rfc1961
  114. * http://tools.ietf.org/html/rfc3089
  115. * http://tools.ietf.org/html/draft-ietf-aft-mcast-fw-traversal-01
  116. * http://tools.ietf.org/html/draft-ietf-aft-socks-chap-01
  117. * http://tools.ietf.org/html/draft-ietf-aft-socks-eap-00
  118. * http://tools.ietf.org/html/draft-ietf-aft-socks-ext-00
  119. * http://tools.ietf.org/html/draft-ietf-aft-socks-gssapi-revisions-01
  120. * http://tools.ietf.org/html/draft-ietf-aft-socks-maf-01
  121. * http://tools.ietf.org/html/draft-ietf-aft-socks-multiple-traversal-00
  122. * http://tools.ietf.org/html/draft-ietf-aft-socks-pro-v5-04
  123. * http://tools.ietf.org/html/draft-ietf-aft-socks-v6-req-00
  124. * http://tools.ietf.org/html/draft-ietf-aft-socks-ssl-00
  125. * http://www.iana.org/assignments/socks-methods
  126. * http://developer.mozilla.org/index.php?title=En/Integrated_Authentication
  127.  
  128. =head1 COPYRIGHT
  129.  
  130. Copyright (c) 2008-2010, <a href="http://www.hm2k.com/">HM2K</a>. All rights reserved.
  131.  
  132. Released as Open Source under the BSD License.
  133.  
  134. =head1 LICENSE
  135.  
  136. Redistribution and use in source and binary forms, with or without modification, are
  137. permitted provided that the following conditions are met:
  138.  * Redistributions of source code must retain the above copyright notice, this list of
  139.    conditions and the following disclaimer.
  140.  * Redistributions in binary form must reproduce the above copyright notice, this list
  141.    of conditions and the following disclaimer in the documentation and/or other
  142.    materials provided with the distribution.
  143.  * Neither the name of the author nor the names of its contributors may be used to
  144.    endorse or promote products derived from this software without specific prior
  145.    written permission.
  146.  
  147. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
  148. EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  149. OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
  150. SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  151. INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
  152. TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  153. BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  154. CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY
  155. WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  156.  
  157. =head1 CREDITS
  158.  
  159. Satanic Socks Server v0.8.031206-perl
  160. datapipe.pl by CuTTer
  161.  
  162. Also, thanks to #perlhelp @ EFnet
  163.  
  164. =pod OSNAMES
  165.  
  166. any
  167.  
  168. =pod SCRIPT CATEGORIES
  169.  
  170. Networking
  171.  
  172. =cut
  173.  
  174. ## Settings
  175. our $daemon   = 1; #run as a daemon or not (0/1)
  176. our $logging  = 0; #logging on or off (0/1)
  177. our $logfile  = 'sss.log';
  178.  
  179. ## Language
  180. my $lang_daemon="Process (%s) has entered into background.\n";
  181. my $lang_usage="Usage: $0 <local_host> <local_port> [auth_login(:auth_pass)]\n".
  182.                 "Note: the auth_pass must be an md5 (hex) hash\n".
  183.                 "eg: $0 localhost 34567 test:098f6bcd4621d373cade4e832627b4f6\n";
  184. my $lang_bind="Could not bind to %s:%s\n";
  185. my $lang_sockopen="Could not open a socket to %s:%s\n";
  186. my $lang_file_open="Could not open log file.";
  187.  
  188. ## Usage
  189. if (!$ARGV[1]) { die $lang_usage; }
  190.  
  191. ## Requirements
  192. # Install using: perl -MCPAN -e'install %module'
  193. use IO::Socket::INET;
  194. use Digest::MD5 qw(md5_hex);
  195.  
  196. ##-md5 option
  197. if ($ARGV[0] eq '-getmd5') {
  198.   shift;
  199.   print md5_hex(shift);
  200.   exit(0);
  201. }
  202.  
  203. ## Arguments
  204. our $local_host = shift;
  205. our $local_port = shift;
  206. our $auth_login = shift;
  207. our $auth_pass;
  208.  
  209. #Parse auth part
  210. if ($auth_login && $auth_login =~ m/:/) {
  211.         ($auth_login,$auth_pass)=split(':', $auth_login);
  212. }
  213.  
  214. #Open listening port
  215. $SIG{'CHLD'} = 'IGNORE';
  216. my $bind = socks_open(  Listen=>5,
  217.                         LocalAddr=>$local_host.':'.$local_port,
  218.                         ReuseAddr=>1)
  219.                         or die sprintf($lang_bind,$local_host,$local_port);
  220.  
  221. #Run as daemon
  222. if ($daemon) {
  223.   our $pid=fork();
  224.   if ($pid) {
  225.     printf($lang_daemon,$pid);
  226.     close(); exit();
  227.   }
  228. }
  229.  
  230. # Start client
  231. our $client;
  232. while($client = $bind->accept()) {
  233.         $client->autoflush();
  234.         if (fork()){ socks_close($client); }
  235.         else { socks_close($bind); new_client($client); exit(); }
  236. }
  237.  
  238. # New client subroutine
  239. sub new_client {
  240.         my($t, $i, $buff, $ord, $success);
  241.         my $client = shift;
  242.  
  243.         socks_sysread($client, $buff, 1);
  244.         if (ord($buff) != 5) { return; } #must be SOCKS 5
  245.        
  246.         socks_sysread($client, $buff, 1);
  247.         $t=ord($buff);
  248.         unless(socks_sysread($client, $buff, $t) == $t) { return; }
  249.  
  250.         $success=0;
  251.         for($i=0; $i < $t; $i++) {
  252.          $ord = ord(substr($buff, $i, 1));
  253.          if ($ord == 0 && !$auth_login) {
  254.            socks_syswrite($client, "\x05\x00", 2);
  255.            $success++;
  256.            last;
  257.          }
  258.          elsif ($ord == 1 && $auth_login) {
  259.            #GSSAPI auth support
  260.            #socks_syswrite($client, "\x05\x01", 2);
  261.            #$success++;
  262.            #last;
  263.          }
  264.          elsif ($ord == 2 && $auth_login) {
  265.            unless(do_login_auth($client)){ return; }
  266.            $success++;
  267.            last;
  268.          }
  269.         }
  270.  
  271.         if ($success) {
  272.          $t = socks_sysread($client, $buff, 3);
  273.  
  274.          if (substr($buff, 0, 1) eq "\x05") {
  275.            if (ord(substr($buff, 2, 1)) == 0) { # reserved
  276.                  my($host, $raw_host) = socks_get_host($client);
  277.                  if (!$host) { return; }
  278.                  my($port, $raw_port) = socks_get_port($client);
  279.                  if (!$port) { return; }
  280.                  $ord = ord(substr($buff, 1, 1));
  281.                  $buff = "\x05\x00\x00".$raw_host.$raw_port;
  282.                  socks_syswrite($client, $buff, length($buff));
  283.                  socks_do($ord, $client, $host, $port);
  284.            }
  285.          }
  286.         }
  287.         else { socks_syswrite($client, "\x05\xFF", 2); }
  288.  
  289.         socks_close($client);
  290. }
  291.  
  292. # Do login authentication subroutine
  293. sub do_login_auth {
  294.         my($buff, $login, $pass);
  295.         my $client = shift;
  296.  
  297.         socks_syswrite($client, "\x05\x02", 2);
  298.         socks_sysread($client, $buff, 1);
  299.  
  300.         if (ord($buff) == 1) {
  301.                 socks_sysread($client, $buff, 1);
  302.                 socks_sysread($client, $login, ord($buff));
  303.                 socks_sysread($client, $buff, 1);
  304.                 socks_sysread($client, $pass, ord($buff));
  305.  
  306.                 if ($auth_login && $auth_pass && $login eq $auth_login && md5_hex($pass) eq $auth_pass) {
  307.                         socks_syswrite($client, "\x01\x00", 2);
  308.                         return 1;
  309.                 }
  310.                 else { socks_syswrite($client, "\x01\x01", 2); }
  311.         }
  312.  
  313.         socks_close($client);
  314.         return 0;
  315. }
  316.  
  317. # Get socks hostname subrouteine
  318. sub socks_get_host {
  319.         my $client = shift;
  320.         my ($t, $ord, $raw_host);
  321.         my $host = "";
  322.         my @host;
  323.  
  324.         socks_sysread($client, $t, 1);
  325.         $ord = ord($t);
  326.         if ($ord == 1) {
  327.         socks_sysread($client, $raw_host, 4);
  328.         @host = $raw_host =~ /(.)/g;
  329.         $host = ord($host[0]).'.'.ord($host[1]).'.'.ord($host[2]).'.'.ord($host[3]);
  330.         } elsif ($ord == 3) {
  331.         socks_sysread($client, $raw_host, 1);
  332.         socks_sysread($client, $host, ord($raw_host));
  333.         $raw_host .= $host;
  334.         } elsif ($ord == 4) {
  335.          #ipv6
  336.         }
  337.  
  338.         return ($host, $t.$raw_host);
  339. }
  340.  
  341. #Get socks port subroutine
  342. sub socks_get_port {
  343.         my $client = shift;
  344.         my ($raw_port, $port);
  345.         socks_sysread($client, $raw_port, 2);
  346.         $port = ord(substr($raw_port, 0, 1)) << 8 | ord(substr($raw_port, 1, 1));
  347.         return ($port, $raw_port);
  348. }
  349.  
  350. #Socks command
  351. sub socks_do {
  352.         my($t, $client, $host, $port) = @_;
  353.  
  354.         if ($t == 1) { socks_connect($client, $host, $port); }
  355.         elsif ($t == 2) { socks_bind($client, $host, $port); }
  356.         elsif ($t == 3) { socks_udp_associate($client, $host, $port); }
  357.         else { return 0; }
  358.  
  359.         return 1;
  360. }
  361.  
  362. #Connect socks client to target server
  363. our $target;
  364. sub socks_connect {
  365.         my($client, $host, $port) = @_;
  366.         my $target = socks_open(LocalHost => $local_host,
  367.                           PeerAddr => $host.':'.$port,
  368.                           Proto => 'tcp',
  369.                           Type => SOCK_STREAM)
  370.                           or die sprintf($lang_sockopen,$host,$port);
  371.  
  372.         unless($target) { return; }
  373.  
  374.         $target->autoflush();
  375.         while($client || $target) {
  376.         my $rin = "";
  377.         vec($rin, fileno($client), 1) = 1 if $client;
  378.         vec($rin, fileno($target), 1) = 1 if $target;
  379.         my($rout, $eout);
  380.         select($rout = $rin, undef, $eout = $rin, 120);
  381.         if (!$rout  &&  !$eout) { return; }
  382.         my $cbuffer = "";
  383.         my $tbuffer = "";
  384.  
  385.         if ($client && (vec($eout, fileno($client), 1) || vec($rout, fileno($client), 1))) {
  386.          my $result = socks_sysread($client, $tbuffer, 1024);
  387.          if (!defined($result) || !$result) { return; }
  388.         }
  389.  
  390.         if ($target  &&  (vec($eout, fileno($target), 1)  || vec($rout, fileno($target), 1))) {
  391.          my $result = socks_sysread($target, $cbuffer, 1024);
  392.          if (!defined($result) || !$result) { return; }
  393.         }
  394.  
  395.         while (my $len = length($tbuffer)) {
  396.          my $res = socks_syswrite($target, $tbuffer, $len);
  397.          if ($res > 0) { $tbuffer = substr($tbuffer, $res); } else { return; }
  398.         }
  399.  
  400.         while (my $len = length($cbuffer)) {
  401.          my $res = socks_syswrite($client, $cbuffer, $len);
  402.          if ($res > 0) { $cbuffer = substr($cbuffer, $res); } else { return; }
  403.         }
  404.         }
  405. }
  406.  
  407. sub socks_bind {
  408.         my($client, $host, $port) = @_;
  409.         # not supported yet
  410. }
  411.  
  412. sub socks_udp_associate {
  413.         my($client, $host, $port) = @_;
  414.         # not supported yet
  415. }
  416.  
  417. ## Logging functions
  418. our $log;
  419. sub socks_open {
  420.   socks_log('|open>');
  421.   return IO::Socket::INET->new(@_);
  422. }
  423. sub socks_close {
  424.   my $sock = shift;
  425.   socks_log('<close|');
  426.   return $sock->close();
  427. }
  428. sub socks_sysread {
  429.   my $result = sysread($_[0], $_[1], $_[2]);
  430.   socks_log("<read|$_[1]");
  431.   return $result;
  432. }
  433. sub socks_syswrite {
  434.   socks_log("|write>$_[1]");
  435.   return syswrite($_[0], $_[1], $_[2]);
  436. }
  437.  
  438. sub socks_log {
  439.   if (!$logging){ return; }
  440.   open(LOG, ">>$logfile") or die $lang_file_open;;
  441.   print LOG shift;
  442.   print LOG "\n";
  443.   close(LOG);
  444. }
  445.  
  446. #EOF#EOF

Reply to "Simple Socks5 Server for Perl"

Here you can reply to the paste above