#!/usr/bin/perl -w




#########
#
# This script written by Bob Niederman.  http://bob-n.com
#
# It is licensed
# under the GPL.  See http://www.fsf.org 
#
#
##########

select STDERR; $|++;
select STDOUT; $|++;

use Socket;
use Data::Dumper;
use Getopt::Long;
;

%opt_ctl = (         
	"timeout_for_gets|t=i", 	\$timeout,
	"fork|f=i", 				\$frk,
	"show_usage|h!", 			\$sho_usage,
	"debug|d!", 				\$debug,

);

$def_timeout = 10;
$def_max_proc = 10;
Getopt::Long::Configure( qw(no_auto_abbrev) );

$debug = 0;

if ( not GetOptions(%opt_ctl) or $sho_usage ) { usage() }

sub usage
{
	$out = 
	"\n
	usage: $0 [ -t timeout ] [ -f max_num_processes ] input_file

	Accept a list of opennap servers in the format used in 
	~/.napster/servers.  Print out on the ones that can connected to 
	in less than a given number o seconds as specified in '-t timeout' 
	(see below).  Use I/O redierction (eg end the command line w/ >filename 
	then copy filename to ~/.napster/servers to use the output.

	Timeout is how long to try connecting to the server ebfore 
	declarng it bad.  This defaults to $def_timeout.  A longer timeout means 
	the program takes loner to run.  A shorter timeout increases the odds 
	of a useable server being marked bad.
	
	max_num_processes is the maximum number of processes
	this program will create.  More processes means faster completion,
	as many servers will not reject the connection, but must timeout.  
	More processes also means more meory consumption.  Default is $def_max_proc.
	
	This script written by Bob Niederman.  http://bob-n.com

	It is licensed under the GPL.  See http://www.fsf.org 
	";
	
	print $out;
	exit;

}



$timeout ||= $def_timeout;
$frk ||= $def_max_proc;

warn "\$timeout = $timeout and \$frk = $frk\n" if $debug;

while(<>)
{
	@f = split;
	push @srvrs, [ $f[0], $_];
}

SRVR:
while ( @srvrs )
{
	for (1..$frk) 
	{
		my $ar_s = shift @srvrs or last SRVR;

		##### comment starting here if fork is not supported.
		warn "forking for @$ar_s\n" if $debug;
		$pid = fork;
		if ( $pid ) { push @pids, $pid }
		else
		##### comment ending here if fork is not supported.
		{
			{
				( $addr, $port ) = split(':', $ar_s->[0]);


				socket(SOCKET, PF_INET, SOCK_STREAM, getprotobyname('tcp'));

				$iaddr = inet_aton($addr);
				$paddr = sockaddr_in($port, $iaddr);



				eval 
				{
					local $SIG{ALRM} = sub { die "connection timeout for $addr:$port\n" }; # NB: \n required
					alarm $timeout;
					connect(SOCKET, $paddr) or die "$! for $addr:$port\n";
					alarm 0;
				};

				if ( $@ )
				{
					if ( $debug )
					{
						warn "connection timeout for $addr:$port" if $@ =~ /connection timeout/; 
						warn "$@" if $@ !~ /connection timeout/; 
					}
				}
				else
				{
					warn "Connection to port $addr:$port worked" if $debug;
					print "$ar_s->[1]";
				}

				close (SOCKET)            || warn "close: $!";
			}
			exit;
		}
	}

	##### comment starting here if fork is not supported.
	warn "PIDs = @pids\n" if $debug;
	if ( $pid )
	{
		for ( @pids )
		{
			my $kid = waitpid($_, 0);
			warn "$kid has finished\n" if $debug;
		}
	} 
	##### comment ending here if fork is not supported.
}

sleep 3;

__END__