#!perl
# Simple SOCKS(4/5) sorter and checker
# Author: biophreak (s-teals.org)
# Todo: print results to text files, use threads
use warnings;
use strict;
use Socket;
use IO::Handle;
use threads;
use Fcntl;
use Errno;
my $timeout = 2;
my $DEBUG = 1;
my $sockslist = shift || die '[ERROR] Specify sockslist!';

(open S, $sockslist and my @socks = <S> and close S) or die "Cannot open file $sockslist: $!\n";
my %SOCKS4_CONNECT_RESPONSES = (
    90 => "request granted",
    91 => "request rejected or failed",
    92 => "request rejected, ident required",
    93 => "request rejected, ident mismatch",
);
my %SOCKS5_METHODS = (
    0 => "no authentication required",
    1 => "GSSAPI",
    2 => "username/password",
    255 => "no acceptable methods",
);
my %SOCKS5_CONNECT_RESPONSES = (
    0 => "succeeded",
    1 => "general SOCKS server failure",
    2 => "connection not allowed by ruleset",
    3 => "Network unreachable",
    4 => "Host unreachable",
    5 => "Connection refused",
    6 => "TTL expired",
    7 => "Command not supported",
    8 => "Address type not supported",
);
my $answer;
while (scalar @socks) {
        my ($server, $port) = split(/:/, shift @socks);
        checkSocks($server,$port);
}


sub checkSocks
{
    my ($server, $port) = @_;
    chomp($server, $port);
    print "Cheking $server:$port\n";
    socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or (print "Cannot open socket: $!\n" and exit);
        SOCK->autoflush(1);
        bind(SOCK, sockaddr_in(0, INADDR_ANY));
        fcntl(SOCK, F_SETFL, O_NONBLOCK) or die "fcntl: $!";
    unless(connect(SOCK, sockaddr_in($port, inet_aton($server)))){
        Errno::EINPROGRESS == $! or Errno::EWOULDBLOCK or die "connect: $!";
        vec(my $win = '', fileno(SOCK), 1) = 1;
                unless (select(undef, $win, undef, $timeout)) {
                        close (SOCK);
                        print "Time out\n";
                        next;
                }
    }
    if (defined (my $ret = getsockopt(SOCK, SOL_SOCKET, SO_ERROR))) {
        next if $! = unpack('i', $ret);
     } elsif (!getpeername(SOCK)) {
        next;
        print "connection failed: $!" if $DEBUG == 1;
     }
    fcntl(SOCK, F_SETFL, 0);

    print SOCK pack("CCC",5,1,0);
    sysread(SOCK,$answer,1) or die "Can not read from socket: $!\n";
    close SOCK;
    if ($answer eq pack('C',00)){
                print "$server:$port is SOCKS4/SOCKS4a proxy.\nChecking...\n" if $DEBUG == 1;
        checkSocks4($server,$port);
    } elsif ($answer eq pack('C',05)) {
        print "$server:$port is SOCKS5 proxy.\nChecking...\n" if $DEBUG == 1;
        checkSocks5($server,$port);
    } else {
        print "$server:$port is not SOCKS4/SOCKS5 proxy\n";
    }
        close(SOCK);
}


sub checkSocks4
{
    my($server,$port) = @_;
    my($mssg, $repcode, $repmssg);
    socket(SOCK, AF_INET, SOCK_STREAM, getprotobyname('tcp'))
        or (print "Cannot open socket: $!\n" and return 0);
    connect(SOCK, sockaddr_in($port, inet_aton($server)))
        or (print "Cannot connect to $server $port: $!\n" and return 0);
    SOCK->autoflush(1);
    print SOCK pack("CCnA4x", 4, 1, 80, inet_aton('www.google.com'));
    sysread(SOCK,$mssg,8)
        or (print "Cannot read from socket: $!\n" and return 0);
    $repcode = (unpack("C*", $mssg))[1];
    $repmssg = $SOCKS4_CONNECT_RESPONSES{$repcode}
        || "unknown reply code";
    print "$server:$port reply code = $repcode ($repmssg)\n"
        if $DEBUG == 1;
#    print "[ERROR] $server:$port is alive,but isn't usable: $repcode ($repmssg)\n"
#        if $repcode != 90;
    (return 0 and close SOCK) unless ($repcode == 90);
    print "$server:$port is good SOCKS4/SOCKS4a proxy\n"; # Print to file...
    close SOCK;
    return 1;
}

sub checkSocks5
{
    my($server,$port) = @_;
    my($mssg, $repcode, $repmssg);
    socket(SOCK, AF_INET, SOCK_STREAM, getprotobyname('tcp'))
        or (print "Cannot open socket: $!\n" and return 0);
    connect(SOCK, sockaddr_in($port, inet_aton($server)))
        or (print "Cannot connect to $server $port: $!\n" and return 0);
    SOCK->autoflush(1);
    print SOCK pack("CCC", 5, 1, 0)
        or (print "Cannot send to socket: $!\n" and return 0);;
    sysread(SOCK,$mssg,2)
        or (print "Cannot read from socket: $!\n" and return 0);
    $repcode = (unpack("C*", $mssg))[1];
    $repmssg = $SOCKS5_METHODS{$repcode}
        || "unknown or reserved reply code";
    print "$server:$port reply code = $repcode ($repmssg)\n"
        if $DEBUG == 1;
#    print "[ERROR] $server:$port is alive,but isn't usable: $repcode ($repmssg)\n"
#        if $repcode != 0;
    (return 0 and close SOCK) unless($repcode == 0);
    print SOCK pack("CCCCa4n", 5, 1, 0, 1, inet_aton('www.ya.ru'), 80)
        or (warn "Cannot send to socket: $!\n" and return 0);;
    sysread(SOCK,$mssg,10)
        or (warn "Cannot read from socket: $!\n" and return 0);
    $repcode = (unpack("C*", $mssg))[1];
    $repmssg = $SOCKS5_CONNECT_RESPONSES{$repcode}
        || "unknown or reserved reply code";
    print "$server:$port reply code = $repcode ($repmssg)\n"
        if $DEBUG == 1;
#    print "[ERROR] $server:$port is alive,but isn't usable: $repcode ($repmssg)\n"
#        if $repcode != 0;
    (return 0 and close SOCK) unless($repcode == 0);
    print "$server:$port is good SOCKS5 proxy\n"; # Print to file...
    close SOCK;
    return 1;
}