1#!/usr/local/bin/perl 2#sss.pl v0.1.4 (03/05/10) 3 4use warnings; use strict; 5 6=head1 NAME 7 8Simple SOCKS5 Server for Perl 9 10=head1 DESCRIPTION 11 12SSS is a Simple SOCKS Server written in perl that implements the SOCKS v5 protocol. 13 14It will accept username/password authentication. 15 16The script runs in the background as a daemon. 17 18=head2 HISTORY 19 20Originally I was looking for a simple SOCKS5 Server (with user/pass auth) that 21would run as a non-root user on FreeBSD. 22 23I checked the FreeBSD ports for various SOCKS5 solutions and tried them all, 24only to discover that each one had a reason why it would not work, or why I 25could not use it. 26 27I figured this could be done in perl, but found that there was no well 28maintained perl based solutions. 29 30I hacked together this solution (with help from public domain scripts) and 31cleaned it up, ready for release. 32 33Its simple, a feature I intend to maintain, however there is scope for much more 34potential, especially with user feedback. 35 36You 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 44OR 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 52You run the script using the following command: 53 ./sss.pl <local_host> <local_port> [auth_login(:auth_pass)] 54Note: the auth_pass must be an md5 (hex) hash 55 eg: ./sss.pl hostname.example.com 34567 test:ae2b1fca515949e5d54fb22b8ed95575 56 57Once up and running you can use the server in mIRC using the following command: 58 /firewall [-cmN[+|-]d] [on|off] <server> <port> <userid> <password> 59For 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 64Operating System: Tested on FreeBSD 6.x and CentOS 4.x, should work on others. 65 66Required modules: C<IO::Socket::INET>, C<Digest::MD5>. 67 68=head1 CHANGES 69v0.1.4 (03/05/10) - Improved documentation and logging subs 70v0.1.3 (24/11/09) - Improved documentation and code 71 - PID is displayed during fork 72 - Added logging (for Katlyn`) 73v0.1.2 (27/02/09) - Fixed a bug (Thanks Andreas) 74v0.1.1 (02/10/08) - Improved documentation 75v0.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 130Copyright (c) 2008-2010, <a href="http://www.hm2k.com/">HM2K</a>. All rights reserved. 131 132Released as Open Source under the BSD License. 133 134=head1 LICENSE 135 136Redistribution and use in source and binary forms, with or without modification, are 137permitted 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 147THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY 148EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 149OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT 150SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 151INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 152TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 153BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 154CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY 155WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 156 157=head1 CREDITS 158 159Satanic Socks Server v0.8.031206-perl 160datapipe.pl by CuTTer 161 162Also, thanks to #perlhelp @ EFnet 163 164=pod OSNAMES 165 166any 167 168=pod SCRIPT CATEGORIES 169 170Networking 171 172=cut 173 174## Settings 175our $daemon = 1; #run as a daemon or not (0/1) 176our $logging = 0; #logging on or off (0/1) 177our $logfile = 'sss.log'; 178 179## Language 180my $lang_daemon="Process (%s) has entered into background.\n"; 181my $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"; 184my $lang_bind="Could not bind to %s:%s\n"; 185my $lang_sockopen="Could not open a socket to %s:%s\n"; 186my $lang_file_open="Could not open log file."; 187 188## Usage 189if (!$ARGV[1]) { die $lang_usage; } 190 191## Requirements 192# Install using: perl -MCPAN -e'install %module' 193use IO::Socket::INET; 194use Digest::MD5 qw(md5_hex); 195 196##-md5 option 197if ($ARGV[0] eq '-getmd5') { 198 shift; 199 print md5_hex(shift); 200 exit(0); 201} 202 203## Arguments 204our $local_host = shift; 205our $local_port = shift; 206our $auth_login = shift; 207our $auth_pass; 208 209#Parse auth part 210if ($auth_login && $auth_login =~ m/:/) { 211 ($auth_login,$auth_pass)=split(':', $auth_login); 212} 213 214#Open listening port 215$SIG{'CHLD'} = 'IGNORE'; 216my $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 222if ($daemon) { 223 our $pid=fork(); 224 if ($pid) { 225 printf($lang_daemon,$pid); 226 close(); exit(); 227 } 228} 229 230# Start client 231our $client; 232while($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 239sub 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 293sub 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 318sub 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 342sub 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 351sub 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 363our $target; 364sub 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 407sub socks_bind { 408 my($client, $host, $port) = @_; 409 # not supported yet 410} 411 412sub socks_udp_associate { 413 my($client, $host, $port) = @_; 414 # not supported yet 415} 416 417## Logging functions 418our $log; 419sub socks_open { 420 socks_log('|open>'); 421 return IO::Socket::INET->new(@_); 422} 423sub socks_close { 424 my $sock = shift; 425 socks_log('<close|'); 426 return $sock->close(); 427} 428sub socks_sysread { 429 my $result = sysread($_[0], $_[1], $_[2]); 430 socks_log("<read|$_[1]"); 431 return $result; 432} 433sub socks_syswrite { 434 socks_log("|write>$_[1]"); 435 return syswrite($_[0], $_[1], $_[2]); 436} 437 438sub 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