package Monkey::OpenProxy;

# Written by Sunir Shah.
# Available under the BSD license.
# http://www.opensource.org/licenses/bsd-license.php
#
# In general, you will want to use this in conjunction with a self-ban
# mechanism. So, you would start the scan as so:
#
#     Monkey::OpenProxy::Scan(
#         $ip_to_test,
#         "$SiteBase$ScriptName?action=$SelfBan", # Location of the self-ban action
#         "Congratulations.*?banned"              # String to verify banishment
#     );
#
# The scanner will make the proxy detector load the self-ban action.
# The self-ban action should (if the IP address hasn't already been banned)
#     a) ban the IP address,
#     b) print a confirmation string, e.g. "Congratulations, you've been banned!"
#     c) start a new open proxy scan of the current IP address
# 
# The latter action is to detect rotating proxy clusters. Otherwise,
# while you ban the user's current proxy, they will already be onto the
# next one. This way you'll get them all, eventually.

use Socket;
use threads;
use Fcntl;

our $TIMEOUT = 3;

sub TestProxy {
    my ($host, $port, $request) = @_;

    if ($port =~ /\D/) {
        $port = getservbyname($port, 'tcp')
    }
    die "No port" unless $port;

    my $destination = gethostbyname($host);
       $destination = sockaddr_in($port, $destination);

    my $protocol = getprotobyname('tcp');

    local (*SOCK);
    socket(SOCK, PF_INET, SOCK_STREAM, $protocol) || die "socket: $!";

    # From perldoc -f fcntl -- Make non-blocking. Some servers
    # hold the connection open without responding in order to
    # delay port scans.
    my $flags = fcntl(SOCK, F_GETFL, 0) or die "fcntl, get flags: $!";
    $flags = fcntl(SOCK, F_SETFL, $flags | O_NONBLOCK) or die "fcntl, set flags: $!";
    
    connect(SOCK, $destination);
    
    # http://lists.puremagic.com/pipermail/greylist-users/2004-June/000621.html
    my ($rin, $win, $ein) = ('','','');
    my ($rout, $wout, $eout);
    vec($rin, fileno(SOCK), 1) = 1;
    vec($win, fileno(SOCK), 1) = 1;

    my $methods_found = select( $rin, $win, undef, $TIMEOUT );
    return unless $methods_found > 0;

    syswrite( SOCK, $request, length($request) );

    my @result;
    while(1) {
        my $buffer;
        my $length = sysread( SOCK, $buffer, 1024 );
        next if $! == 11; # EAGAIN -- would block; wait until there is data
        last unless $length;
        push @result, $buffer;
    }
    close (SOCK) || die "close: $!";
    return join '', @result;
}

sub Scan {
    my ($host, $url, $test) = @_;
    my @ports = (
        80,81,1075,3128,4480,5490,6588,7033,8000,
        8080,8081,8085,8090,8095,8100,8105,8110
    );
    my ($base_url, $query_string) = $url =~ /^(.*?)\?(.*)$/;
    my $content_length = length($query_string);
    my ($domain) = $url =~ m@\w+:/*(.*?)(/|$)@;
    
    my @requests = (
        <<EOF ,
POST $base_url HTTP/1.0
Host: $domain
Cache-Control: no-cache
Pragma: no-cache
User-Agent: detector 1.0
Content-Type: application/x-www-form-urlencoded
Content-Length: $content_length

$query_string
EOF

        <<EOF ,
GET $url HTTP/1.0
Host: $domain
Cache-Control: no-cache
Pragma: no-cache
User-Agent: detector 1.0

EOF
    );

    my $segment_size = 1;
    local @threads;
    while(@ports) {
        my @segment = splice @ports, 0, $segment_size;
        my $thread = threads->new( \&scan_thread, [
            $host,
            \@segment,
            \@requests,
            $test,
        ]);
        push @threads, $thread;
    }

    my $proxy_port;
    while (@threads) {
        my $thread = shift @threads;
        $proxy_port = $thread->join;
        last if $proxy_port;
    }

    foreach(@threads) { $thread->detach if $thread; }
    return $proxy_port;
}

sub scan_thread {
    my ($host, $ports, $requests, $test) = @{$_[0]};
    $test = qr/\S/ unless $test;
    foreach my $port (@$ports) {
        threads->yield;
        foreach my $request (@$requests) {
            my $output = TestProxy( $host, $port, $request );
            if( $output =~ /$test/s ) {
                return $port;
            }
        }
    }
    return;
}

1;
