#!/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_fil
+e

    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/ >fil
+ename 
    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 o
+dds 
    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 $de
+f_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=gn
+apster";
    $list = get($url);
    die "Failed to get new server list at '$url'\n" unless defined $li
+st;
    @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('t
+cp'));

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

                eval 
                {
                    local $SIG{ALRM} = sub { die "connection timeout f
+or $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 $d
+ebug;
                    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__
[download]