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;
</div><div class="naked_ctrl">
<form action="/index.cgi/contrast" method="get" name="gate">
<p><a href="http://altstyle.alfasado.net">AltStyle</a> によって変換されたページ <a href="http://sunir.org/meatball/OpenProxy/OpenProxy.pm">(-&gt;オリジナル)</a>
/ <label>アドレス: <input type="text" name="naked_post_url" value="http://sunir.org/meatball/OpenProxy/OpenProxy.pm" size="22" /></label> <label>モード: <select name="naked_post_mode">
<option value="default">デフォルト</option>
<option value="speech">音声ブラウザ</option>
<option value="ruby">ルビ付き</option>
<option value="contrast" selected="selected">配色反転</option>
<option value="larger-text">文字拡大</option>
<option value="mobile">モバイル</option>
</select>
<input type="submit" value="表示" />
</p>
</form>
</div>