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