Toy SOCKS5 proxy server

[ambrus]

This is a toy SOCKS5 server. I wrote this to understand how a SOCKS5 proxy works.

This is not a full-featured server, only a toy, but nevertheless, it works enough that I could post this writeup through it.

Usage

1. Run the program below.
2. In Iceweasel (or Firefox) browser, go to Preferences dialog (from Edit menu), choose Advanced then Network tab, click on Connection Settings button. In the dialog you get, choose Manual proxy configuration, then enter "localhost" as SOCKS Host and "1080" as SOCKS Port, and choose the "SOCKS v5" option. Accept all this configuration with the Ok buttons. (Something similar may work in any other browser that supports SOCKS5 proxies.)
3. Load webpages in Firefox. It should tunnel HTTP and HTTPS requests through proxy server, which you can see in the debug output of proxy. DNS requests will probably not go through proxy.
4. If program dies or hangs, kill and restart it.
5. Don't forget to restore your previous proxy settings (probably "No proxy") in the same dialog box of the browser later.

Limitations.

1. Supports only outbound tcp connections (not listening to inbound tcp nor udp), and only through ipv4 addresses (not domain names or ipv6 addresses).
2. Ungraceful: dies on some errors, ignores some others.
3. Blocking: hangs in some cases, such as when it can't write to some socket etc.
4. No access control, apart from that it allows use from localhost only (though you can change this).
5. Never closes sockets, so it may eventually run out of file descriptors. (Update:) It also leaks memory (more than just the socket handles) with each connection.
6. Nonportable: works on Linux (mostly) but probably not many other systems. (Update: if you want to try this on Windows, be sure to at least throw in some binmodes.)

Code

#!perl
# a toy SOCKS 5 server

use warnings; use strict; use 5.012; 
use EV;
use AnyEvent; 
use IO::Handle; use Socket;
use AnyEvent::Util qw"fh_nonblocking"; 

$EV::DIED = sub { warn @_; exit 1; };
socket our $S, PF_INET(), SOCK_STREAM(), 0 or die "socket S"; 
setsockopt $S,SOL_SOCKET(),SO_REUSEADDR(),pack("i",1) or die "SO_REUSE
+ADDR S"; 
bind $S, pack_sockaddr_in(1080, INADDR_LOOPBACK()) or die "bind S"; 
listen $S,1 or die "listen S"; 
say "listening S"; 
fh_nonblocking $S,1;
our $mna = 0;
our $ws = AE::io $S, 0, sub {

    my $na = $mna++;
    my $din = accept my$A,$S or die "accept A,S: $!"; 
    $A->autoflush; 
    fh_nonblocking $A, 0;
    my($pin,$ain) = unpack_sockaddr_in $din; 
    warn "accepted A[$na] from remote host " . inet_ntoa($ain) . " por
+t " . $pin; 
    read $A, my$m0, 2 or die "read A m1: $!"; 
    my($sve, $nau) = unpack "CC", $m0; 
    5 == $sve or die "wrong socks version magic: $sve"; 
    read $A, my$m1, $nau or die "read A m1"; 
    my @wau = unpack"C*",$m1; 
    print $A pack"CC", 5, 0 or die "print A authentication method repl
+y"; 
    read $A, my$m2, 4 or die "read A m2"; 
    my($_sve, $cmd, $_res, $adt)=unpack "CCCC", $m2; 
    1 == $cmd or die "wrong socks command (1=connect, 2=bind, 3=udp_as
+soc): " . $cmd; 
    1 == $adt or die "wrong address type (1=inet, 3=domainname, 4=inet
+6): " . $adt; 
    read $A, my$m3, 4+2 or die "read A m3"; 
    my($oa, $op) = unpack "A4n", $m3; 
    say "wants connect O[$na] to host " . inet_ntoa($oa) . " port " . 
+$op; 
    my $dsz = 2**12;

    socket my $O, PF_INET(),SOCK_STREAM(),0 or die "socket O"; 
    $O->autoflush;
    fh_nonblocking $O, 1;
    connect $O, pack_sockaddr_in($op,$oa);

    my $wc;
    $wc = AE::io $O, 1, sub {

        $wc = undef;
        length(my $r = getsockopt $O, SOL_SOCKET(), SO_ERROR()) or war
+n "error SO_ERROR O[$na]: $!";
        my $e = unpack "i", $r;
        if ($e) {
            say "error connect O[$na] to host " . inet_ntoa($oa) . " p
+ort " . $op . " : " . ($! = $e);
            print $A pack "CCCCx4x2", 5,5,0,1 or die "print A error re
+ply";
            return;
        }
        say "connect O[$na] to host " . inet_ntoa($oa) . " port " . $o
+p . " ok";
        printflush $A pack "CCCCx4x2", 5,0,0,1 or die "print A success
+ reply";
        
        my $wa;
        $wa = AE::io $A, 0, sub {
            fh_nonblocking $A, 1;
            my $r = sysread $A, my$b, 2**14;
            if (0 < $r) {
                my $d = $b;
                $d =~ y/\x00-\x1f\x7f-\xff/|/;
                my $dp = 0 <= ($dsz -= length $d);
                say "read A[$na] $r bytes " . ($dp ? "($d)" : "");
                fh_nonblocking $O, 0;
                printflush $O $b or die "print O[$na] data";
                say "wrote O[$na] $r bytes";
            } else {
                say "eof A[$na] " . (defined($r) ? "" : $!);
                $wa = undef;
                shutdown $O, 1;
            }
        };
        
        my $wo;
        $wo = AE::io $O, 0, sub {
            fh_nonblocking $O, 1;
            my $r = sysread $O, my$b, 2**14;
            if (0 < $r) {
                say "read O[$na] $r bytes";
                fh_nonblocking $A, 0;
                printflush $A $b or die "print A[$na] data";
                say "wrote A[$na] $r bytes";
            } else {
                say "eof O[$na] " . (defined($r) ? "" : $!);
                $wo = undef;
                shutdown $A, 1;
            }
        };

    };
    
};

my $whbeat = AE::timer 10, 10, sub {
    say "heartbeat " . AE::now;
};

EV::run();

__END__

See also

Update: see SOCKS4 Server in Perl.

[ciderpunx]

Cool, thanks for sharing.