#!/usr/bin/env perl

# Simple socks4 server
# implemented with IO::Socket::Socks module

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

# allow socks4a protocol extension
$IO::Socket::Socks::SOCKS4_RESOLVE = 1;

# create socks server
my $server = IO::Socket::Socks->new(SocksVersion => 4, 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)
            {
                # request granted
                $client->command_reply(REQUEST_GRANTED, $socket->sockhost, $socket->sockport);
            }
            else
            {
                # request rejected or failed
                $client->command_reply(REQUEST_FAILED, $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)
            {
                # request granted
                $client->command_reply(REQUEST_GRANTED, $socket->sockhost, $socket->sockport);
            }
            else
            {
                # request rejected or failed
                $client->command_reply(REQUEST_FAILED, $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(REQUEST_GRANTED, $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;
            }
        }
        else
        {
            warn 'Unknown command';
        }
        
        $client->close();
    }
    else
    {
        warn $SOCKS_ERROR;
    }
}

sub auth
{ # add `UserAuth => \&auth' to the server constructor if you want to authenticate user by its id
    my $userid = shift;
    
    my %allowed_users = (root => 1, oleg => 1, ryan => 1);
    return exists($allowed_users{$userid});
}

# tested with `curl --socks4' and `curl --socks4a'