socks-proxy.pl

#!/usr/bin/env perl
use 5.010;
use strict;
use utf8;
use warnings qw(all);

use Carp qw(croak);
use IO::Socket;

my $proxy = IO::Socket::INET->new(
    Proto    => q(tcp),
    PeerAddr => q(localhost),
    PeerPort => 9050,
) or croak qq(can't connect: $!);
$proxy->autoflush(1);

my $host = q(ifconfig.me);
my $port = 80;
my $socks_user = q();

my @request = (
    4,          # SOCKS version number, 1 byte
    1,          # command code, 1 byte: establish a TCP/IP stream connection
    $port,      # network byte order port number, 2 bytes
    "\0\0\0\1", # IP address, 4 bytes
    $socks_user,# the user ID string, variable length
);

my $request;
unless (grep { m{socks4a}ix } @ARGV) {
    $request[-2] = inet_aton $host;
    $request = pack q(CCna4Z*) => @request;
} else {
    push @request => $host;
    $request = pack q(CCna4Z*Z*) => @request;
}

$proxy->syswrite($request);
while ($proxy->sysread(my $chunk, 8)) {
    my ($status, $dst_port, $dst_ipn) = unpack q(xCna4) => $chunk;
    my $dst_ip = inet_ntoa $dst_ipn;
    given ($status) {
        when (0x5a) {
            last;
        } when (0x5b) {
            croak q(request rejected or failed);
        } when (0x5c) {
            croak q(request failed because client is not running identd (or not reachable from the server));
        } when (0x5d) {
            croak q(request failed because client's identd could not confirm the user ID string in the request);
        } default {
            croak q(server is not SOCKS);
        }
    }
}

$proxy->syswrite(qq(GET /all HTTP/1.0\r\n\r\n));
print while <$proxy>;