#!/usr/local/bin/perl

=pod

	upgrade perl..

	also some of these modules can be replaced by only a few lines of code..

	also memory leaks are killing us..

=cut

use warnings;	# only enable warnings for this program and not for those buggy modules (perl -w)
use strict;

use threads;
use threads::shared;
use IO::Socket;
use IO::Select;

use Net::SOCKS;				# probably replaceable
use Thread::Semaphore;			# maybe
use NetAddr::IP;			# probably easy

use Carp;


# prototypes
#
sub scan($@);
sub testsocks($$);
sub beginscan;
sub syn_sent;
sub monitor;
sub address_server(@);
sub getaddress;
sub testaddress(@);
sub shuffle(@);


# test smtp server address
# we try to connect to this server through any proxies we find
# this server should have an smtp server listening on port 25 or we'll get false negatives
#
my $SMTPADDR		= '66.249.132.126';


# number of worker threads
# increasing this will increase the number of threads that we will spawn
# each thread requires a considerable amount of memory
#
my $NUMTHREADS		= 40;


# concurrent connection attempts per thread
#
my $SIMULSCAN 		= 800;


# tcp connect timeout in seconds
# having this too low will increase the chances of getting false negatives
# having this set high slows our scan
#
my $TCP_TIMEOUT		= 3;


# timeout for socks connection attempt
# this should be set high or else we risk timing out before detecting a proxy (false negative)
# we don't spend very much time testing socks anyway so it shouldn't be a problem
#
my $SOCKS_TIMEOUT	= 10;


# maximum number of SYN_SENT connections
#
my $MAXOPENPORTS	= 2000;


# maximum number of open sockets
#
my $MAXOPENSOCK		= 4000;


# tcp port number for our address server
#
my $ADDRSVRPORT		= 10101;


# number of addresses to ping simultaneously
#
my $ADDRBLOCKSIZE	= 128;


my @addr;					# addresses to scan
my $n;						# NetAddr::IP object
#my $spawnlock	= new Thread::Semaphore;	# lock newly spawned threads
my $addrsvrlock	= new Thread::Semaphore;	# get exclusive access to the address server
my $scanned	: shared = 0;			# scan count
my $opensyn	: shared = 0;			# open syn_sent connections
my $opensock	: shared = 0;			# open socket count
my $tbs		: shared = 0;			# threads currently building sockets
my $tbc		: shared = 0;			# threads currently building connections
my $wso		: shared = 0;
my $wsy		: shared = 0;
my $op_c	: shared = 0;			# open ports count
my $prx_c	: shared = 0;			# proxy count
my $count	: shared;			# total number of addresses
my @ports	= shuffle(80, 1025..65535);	# ports to scan

select STDOUT; $|++;				# unbuffer output
select STDERR; $|++;


# check arguments
#
unless(defined($ARGV[0])) {
	print STDERR "usage: $0 <cidr block>\n";
	exit -1;
}


# build NetAddr::IP object and check for valid cidr block
#
eval {
	$n = NetAddr::IP->new($ARGV[0]);
};
if($@) {
	print STDERR "$@";
	print STDERR "invalid cidr block\n";
	print STDERR "usage: $0 <cidr block>\n";
	exit -1;
}

my @thread;			# this list holds our thread objects
my $thread_num;			# this is the current thread's number (integer starting at 0)


=pod

$SIG{'ABRT'}	= sub { print "caught signal " . 'ABRT' . "\n"; };
$SIG{'TRAP'}	= sub { print "caught signal " . 'TRAP' . "\n"; };
$SIG{'HUP'}	= sub { print "caught signal " . 'HUP' . "\n"; };
$SIG{'FPE'}	= sub { print "caught signal " . 'FPE' . "\n"; };
$SIG{'EMT'}	= sub { print "caught signal " . 'EMT' . "\n"; };
$SIG{'XCPU'}	= sub { print "caught signal " . 'XCPU' . "\n"; };
$SIG{'TTOU'}	= sub { print "caught signal " . 'TTOU' . "\n"; };
$SIG{'IOT'}	= sub { print "caught signal " . 'IOT' . "\n"; };
$SIG{'IO'}	= sub { print "caught signal " . 'IO' . "\n"; };
$SIG{'URG'}	= sub { print "caught signal " . 'URG' . "\n"; };
$SIG{'STOP'}	= sub { print "caught signal " . 'STOP' . "\n"; };
$SIG{'TTIN'}	= sub { print "caught signal " . 'TTIN' . "\n"; };
$SIG{'PROF'}	= sub { print "caught signal " . 'PROF' . "\n"; };
$SIG{'TSTP'}	= sub { print "caught signal " . 'TSTP' . "\n"; };
$SIG{'XFSZ'}	= sub { print "caught signal " . 'XFSZ' . "\n"; };
$SIG{'INT'}	= sub { print "caught signal " . 'INT' . "\n"; };
$SIG{'SEGV'}	= sub { print "$thread_num - caught signal " . 'SEGV' . "\n"; croak; };
$SIG{'QUIT'}	= sub { print "caught signal " . 'QUIT' . "\n"; };
$SIG{'PIPE'}	= sub { print "caught signal " . 'PIPE' . "\n"; };
$SIG{'USR2'}	= sub { print "caught signal " . 'USR2' . "\n"; };
$SIG{'INFO'}	= sub { print "caught signal " . 'INFO' . "\n"; };
$SIG{'SYS'}	= sub { print "caught signal " . 'SYS' . "\n"; };
$SIG{'VTALRM'}	= sub { print "caught signal " . 'VTALRM' . "\n"; };
$SIG{'CONT'}	= sub { print "caught signal " . 'CONT' . "\n"; };
$SIG{'USR1'}	= sub { print "caught signal " . 'USR1' . "\n"; };
$SIG{'WINCH'}	= sub { print "caught signal " . 'WINCH' . "\n"; };
$SIG{'ILL'}	= sub { print "caught signal " . 'ILL' . "\n"; };
#$SIG{'TERM'}	= sub { print "caught signal " . 'TERM' . "\n"; exit; };
$SIG{'BUS'}	= sub { print "caught signal " . 'BUS' . "\n"; };

#$SIG{'KILL'}	= sub { print "caught signal " . 'KILL' . "\n"; };
#$SIG{'CHLD'}	= sub { print "caught signal " . 'CHLD' . "\n"; };

=cut


$SIG{'ALRM'}	= sub { print "$thread_num - caught signal " . 'ALRM' . "\n"; };



$addrsvrlock->down;	# wait for address server to become available

# spawn our threads
#
for($thread_num = 0; $thread_num < $NUMTHREADS; $thread_num++) {
	$thread[$thread_num] = threads->create('beginscan', $thread_num);
	defined($thread[$thread_num]) or die "could not create thread: $!";
	$thread[$thread_num]->detach;
}


sleep(1);

print STDERR "shuffling addresses\n";
@addr = shuffle($n->hostenum());

$count  = scalar(@addr);
$count *= scalar(@ports);



# spawn address server thread
#
my $address_thread = threads->create('address_server', @addr);
defined($address_thread) or die "could not create thread: $!";
$address_thread->detach;




$addrsvrlock->up;
monitor;




# address server thread
#
sub address_server(@) {
	my $server;
	my $client;

	print STDERR "spawned address server thread\n";

	$server = IO::Socket::INET->new(	Proto		=> 'tcp',
						LocalAddr	=> '127.0.0.1',
						LocalPort	=> $ADDRSVRPORT,
						Listen		=> 1,
						Type		=> SOCK_STREAM,
						ReuseAddr	=> 1,
						Blockin		=> 1		) or die "socket: $!";

	while(scalar(@_)) {
		my @block = splice(@_, 0, $ADDRBLOCKSIZE);

		$client = $server->accept();
		$client->autoflush(1);

		for(@block) {
			print $client "$_\n";	
		}

		close($client);
	}
}


# monitor
#
sub monitor {

	my $starttime	= time;
	my $numports	= scalar(@ports);

	sleep(1);

	for(;;) {
		$opensyn = syn_sent();		# update opensyn regularly

#		my $c_scanned	= sprintf("%07d", ($scanned / 1024));
#		my $c_count	= $count / 1024;
#
#		$c_scanned	=~ s/(\d+)(\d{3})(\d{3})$/$1,$2,$3/;
#		$c_count	=~ s/(\d+)(\d{3})(\d{3})$/$1,$2,$3/;

my $c_scanned = $scanned;
my $c_count = $count;

		print STDERR "\n" . "so=" .
			sprintf("%04d", $opensock) . " sy=" .
			sprintf("%04d", $opensyn) . " tbs=" .
			sprintf("%02d", $tbs) . " tbc=" .
			sprintf("%02d", $tbc) . " wso=" .
			sprintf("%02d", $wso) . " wsy=" .
			sprintf("%02d", $wsy) . " op=" .
			sprintf("%02d", $op_c) . " prx=" .
			sprintf("%02d", $prx_c) . 
			" - " . $c_scanned . "k of " . $c_count . "k - " . 
			sprintf("%2.2f", (($scanned / (time - $starttime)) / $numports)) .
			"h/s - " .
			sprintf("%2.2f", ($scanned / $count) * 100) . "%\n\n";

		sleep(5);
	}	
}


# connect to address server and retrieve an address
#
sub getaddress {
	my $remote;

	$addrsvrlock->down;		# one thread at a time

	{
		$remote = IO::Socket::INET->new(	Proto		=> 'tcp',
							PeerAddr	=> '127.0.0.1',
							PeerPort	=> $ADDRSVRPORT) or do {

			print STDERR "$thread_num - socket: $!\n";
			sleep(5);
			redo;
		};
	}


	my $line;
	my @block;

	while(defined($line = <$remote>)) {
		chomp($line);
		$line =~ s/\/32*//;
		push(@block, $line);
	}

	close($remote);
	$addrsvrlock->up;
	return(@block);
}

# borrowed from List::Util
#
sub shuffle(@) {
	my @a=\(@_);
	my $n;
	my $i=@_;
	map {
		$n = rand($i--);
		(${$a[$n]}, $a[$n] = $a[$i])[0];
	} @_;
}

# test reachability of list of addresses
#
sub testaddress(@) {
	my $testcmd = '/usr/local/sbin/fping -r1 -t2000 -i10 ';

	for(@_) {
		$testcmd .= "$_ ";
	}
	$testcmd .= '2>&1 | /usr/bin/grep "is alive$" | sed "s/ is alive//"';

	my @block = readpipe($testcmd);

	for(@block) {
		chomp($_);
	}

	return(@block);
}


# begin the scanning process
#
sub beginscan {
	my @ports_tmp;
	my $total_ports	= scalar(@ports);
	my @ports_block;
	my @open;
	my @block;

	print STDERR "spawned thread " . sprintf("%02d", $thread_num) . "\n";

ADDRESS: {
		@block = testaddress(getaddress());

		my $addrinblock = scalar(@block);

		print STDERR sprintf("%02d", $thread_num) . 
			"\t\t\t" . localtime(time) . "\tblock contains " . $addrinblock .
			" reachable " . (($addrinblock == 1) ? "host" : "hosts") . "\n";

		$scanned += (($ADDRBLOCKSIZE - $addrinblock) * $total_ports);	# count skipped hosts

		redo ADDRESS unless($addrinblock);

		threads->yield();

		for my $address (@block) {

			print STDERR sprintf("%02d", $thread_num) . 
				"\t\t\t" . localtime(time) . "\tscanning $address\n";

			my $scan_count = 0;			# ports scanned for this target
			my $starttime = time;
			@ports_tmp = @ports;
PORTS:			{
				threads->yield();

				# grab a "small" block to simul-scan
				#
				@ports_block = splice(@ports_tmp, 0, $SIMULSCAN);

				my $numports = scalar(@ports_block);
				my $portsleft = scalar(@ports_tmp);

				if($numports) {
					$scan_count += $numports;

					# simul-scan our block
					#
					@open = scan($address, @ports_block);

					# exit if there was a fatal error
					#
					defined($open[0]) and ($open[0] == -1) and return;

					# test socks on all open ports
					#
					for(@open) {
						testsocks($address, $_);
					}

					$scanned += $numports;
					redo PORTS;		# continue until we've tested all ports
				}
			}
			print STDERR sprintf("%02d", $thread_num) .
				"   finished scanning $address in " .
				(time - $starttime) . " seconds\t" . 
				($scan_count / (time - $starttime)) . "p/s\n";
		}
		redo ADDRESS;
	}
}


# return number tcp sockets in SYN_SENT according to netstat
#
sub syn_sent {
	my $op = `/usr/bin/netstat -n | /usr/bin/grep SYN_SENT | /usr/bin/wc -l`;
	$op =~ s/\s//g;
	return $op;
}


# perform a seriously brutal port scan
#
sub scan($@) {
	my ($victim, @ports)	= @_;
	my $sel			= new IO::Select();	# select object
	my @sock;					# list of sockets
	my @open;					# list of open ports
	my $starttime		= time;
	my $numports		= scalar(@ports);


#
# this is crude..
#

	# wait for open socket count to drop
	#
	if(($opensock + (($numports * ($tbs + 1)) / 2)) > $MAXOPENSOCK) {
		$wso++;
		while(($opensock + (($numports * ($tbs + 1)) / 2)) > $MAXOPENSOCK) {
			threads->yield();
			sleep(1);
		}
		$wso--;
	}

	$tbs++;				# threads building sockets counter

	for my $port (@ports) {
		threads->yield();

		# create some non-blocking sockets
		#
		eval {
			$sock[$port] = IO::Socket::INET->new(
					Proto		=> 'tcp',
					Blocking	=> 0		) or die "$!";
		};
		if($@) {
			print STDERR "$thread_num - $victim:$port - socket: $@";
			return(-1);	# just end the thread if we can't create a socket
		}
		$opensock++;
	}

	$tbs--;

	# wait for SYN_SENT count to drop
	#
	if(($opensyn + (($numports * ($tbc + 1)) / 2)) > $MAXOPENPORTS) {
		$wsy++;
		while(($opensyn + (($numports * ($tbc + 1)) / 2)) > $MAXOPENPORTS) {
			threads->yield();
			sleep(1);
		}
		$wsy--;
	}

	$tbc++;				# threads building connections counter

	for my $port (@ports) {
		threads->yield();

		my $iaddr = inet_aton($victim);
		my $paddr = sockaddr_in($port, $iaddr);

		eval {							# connect to all of them
			connect($sock[$port], $paddr); # or die "$!";
		};
		if($@) {
			unless($!{EINPROGRESS}) {			# non-blocking
				print STDERR "$thread_num - $victim:$port - connect: $@";
			}
		}
		$sel->add($sock[$port]);				# select them
	}

	for($sel->can_write($TCP_TIMEOUT)) {			# look for any writable sockets
		my $peerport = $_->peerport();
		if($peerport) {					# that are actually connected
			$op_c++;
			push(@open, $peerport);

			my @nmap = `/usr/local/bin/nmap -P0 -A --version-all -p T:$peerport $victim`;

			print STDERR "\n**** $victim:$peerport is open\n"; 
			for(@nmap) {
				print STDERR if(/(tcp open|Service Info)/);
			}
			print "\n\n";
		}
	}

	$tbc--;	

	for my $port (@ports) {
		threads->yield();
		if(defined($sock[$port])) {
			close($sock[$port]);			# close sockets
			$sel->remove($sock[$port]);		# and stop selecting them
		}
		$opensock--;
	}

	return @open
}


# test socks connectivity for a host and port
#
sub testsocks($$) {
	my ($a, $port) = @_;
	my ($sock, $c);
	my $p_res;

	for my $proto (4, 5) {						# test SOCKS4/5
		threads->yield();

		$sock = new Net::SOCKS(	socks_addr		=> $a,
					socks_port		=> $port,
					protocol_version	=> $proto);

		eval {

			local($SIG{'ALRM'}) = sub { die "alarm" };	# set timeout
			alarm($SOCKS_TIMEOUT);

			$c = $sock->connect(	peer_addr		=> $SMTPADDR,
						peer_port		=> 25);

			alarm(0);
		};
		if($@) {
			print STDERR "\n$thread_num - " . localtime(time) . 
				" - $a:$port - socks timeout\n\n";
			$sock->close();
			return;
		}

		if($c) {						# if connected

#			print STDERR "\n$thread_num - " . localtime(time) . 
#				" - $a:$port - connected\n\n";

			my $line = <$c>;				# look for Sendmail banner
			(($line) and ($line =~ /Sendmail/)) and do {
				print STDERR "$thread_num - \"$line\"\n";
				print "\n\n\t\t**** $a:$port is a SOCKS$proto proxy\n\n\n";
				$prx_c++;
			};
		}
		$sock->close();
	}
}