The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use lib '../lib';
use IO::Socket::Socks qw(:constants $SOCKS_ERROR);
use IO::Select;
use strict;

# return bind address as ip address like most socks5 proxyes does
$IO::Socket::Socks::SOCKS5_RESOLVE = 1;

# create socks server
my $server = IO::Socket::Socks->new(SocksVersion => 5, SocksDebug => 1, ProxyAddr => 'localhost', ProxyPort => 1080, Listen => 10)
    or die $SOCKS_ERROR;

# accept connections
while()
{
    my $client = $server->accept();
    
    if($client)
    {
        my ($cmd, $host, $port) = @{$client->command()};
        if($cmd == CMD_CONNECT)
        { # connect
            # create socket with requested host
            my $socket = IO::Socket::INET->new(PeerHost => $host, PeerPort => $port, Timeout => 10);
            
            if($socket)
            {
                # success
                $client->command_reply(REPLY_SUCCESS, $socket->sockhost, $socket->sockport);
            }
            else
            {
                # Host Unreachable
                $client->command_reply(REPLY_HOST_UNREACHABLE, $host, $port);
                $client->close();
                next;
            }
            
            my $selector = IO::Select->new($socket, $client);
            
            MAIN_CONNECT:
            while()
            {
                my @ready = $selector->can_read();
                foreach my $s (@ready)
                {
                    my $readed = $s->sysread(my $data, 1024);
                    unless($readed)
                    {
                        # error or socket closed
                        warn 'connection closed';
                        $socket->close();
                        last MAIN_CONNECT;
                    }
                    
                    if($s == $socket)
                    {
                        # return to client data readed from remote host
                        $client->syswrite($data);
                    }
                    else
                    {
                        # return to remote host data readed from the client
                        $socket->syswrite($data);
                    }
                }
            }
        }
        elsif($cmd == CMD_BIND)
        { # bind
            # create listen socket
            my $socket = IO::Socket::INET->new(Listen => 10);
            
            if($socket)
            {
                # success
                $client->command_reply(REPLY_SUCCESS, $socket->sockhost, $socket->sockport);
            }
            else
            {
                # request rejected or failed
                $client->command_reply(REPLY_HOST_UNREACHABLE, $host, $port);
                $client->close();
                next;
            }
            
            while()
            {
                # accept new connection needed proxifycation
                my $conn = $socket->accept()
                    or next;
                
                $socket->close();
                if($conn->peerhost ne join('.', unpack('C4', (gethostbyname($host))[4])))
                {
                    # connected host should be same as specified in the client bind request
                    last;
                }
                
                $client->command_reply(REPLY_SUCCESS, $conn->peerhost, $conn->peerport);
                
                my $selector = IO::Select->new($conn, $client);
                
                MAIN_BIND:
                while()
                {
                    my @ready = $selector->can_read();
                    foreach my $s (@ready)
                    {
                        my $readed = $s->sysread(my $data, 1024);
                        unless($readed)
                        {
                            # error or socket closed
                            warn 'connection closed';
                            $conn->close();
                            last MAIN_BIND;
                        }
                        
                        if($s == $conn)
                        {
                            # return to client data readed from remote host
                            $client->syswrite($data);
                        }
                        else
                        {
                            # return to remote host data readed from the client
                            $conn->syswrite($data);
                        }
                    }
                }
                
                last;
            }
        }
        elsif($cmd == CMD_UDPASSOC)
        { # UDP associate
            # who really need it?
            # you could send me a patch
            
            warn 'UDP assoc: not implemented';
            $client->command_reply(REPLY_GENERAL_FAILURE, $host, $port);
        }
        else
        {
            warn 'Unknown command';
        }
        
        $client->close();
    }
    else
    {
        warn $SOCKS_ERROR;
    }
}

sub auth
{ # add `UserAuth => \&auth, RequireAuth => 1' to the server constructor if you want to authenticate user by login and password
    my $login = shift;
    my $password = shift;
    
    my %allowed_users = (root => 123, oleg => 321, ryan => 213);
    return $allowed_users{$login} eq $password;
}

# tested with `curl --socks5'