#!/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;
use LWP::Simple;

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

);

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

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

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

	Get a new list of servers from www.napigator.com (if -g is used),

	OR

	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 of seconds as specified in '-t timeout' 
	(see below).  Use I/O redirection (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 before 
	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 memory 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;

}


$debug ||= 0;
$get_new ||= 0;
$timeout ||= $def_timeout;
$frk ||= $def_max_proc;

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

if ( $get_new )
{
	warn "Getting fresh list from www.napigator.com\n" if $debug;
	$url = "http://www.napigator.com/servers.php?version=107&client=gnapster";
	$list = get($url);
	die "Failed to get new server list at '$url'\n" unless defined $list;
	@list = split("\n", $list);
	$list = '';
	pop @list; # ignore last line
	for (@list) # put in format gnapster expects/uses
	{
		s/^([^ ]+) /$1:/;
		@f = split;
		$nline = join(' ' , $f[0], qq("$f[1]"), $f[5], @f[2..4]);
		$list .= "$nline\n";
	}
}
else
{
	warn "Using list from input file\n" if $debug;
	while(<>) 
	{
		$list .= $_;
	}
}

warn "START:\n$list\nEND of unfiltered list" if $debug;

for ( (split("\n", $list)) )
{
	@f = split;
	push @srvrs, [ $f[0], $_];
}


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

		warn "forking for @$ar_s\n" if $debug;
		$pid = fork;
		if ( $pid ) 
		{
			push @pids, $pid
		}
		elsif ( defined $pid )
		{
			{
				( $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" };
					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]\n";
				}

				close (SOCKET)            || warn "close: $!";
			}
			exit;
		}
		else
		{
			die "fork failed\n";
		}
	}

	warn "PIDs = @pids\n" if $debug;
	if ( $pid )
	{
		PID:
		for ( @pids )
		{
			my $kid = waitpid($_, 0);
			warn "$kid has finished\n" if $debug;
		}
	} 
}
__END__