#!/afs/athena/contrib/perl/p 
$debug = 1;

$SIG{'PIPE'}='IGNORE';

require "sys/socket.ph";
require "fcntl.ph";
require "errno.ph";
# These are magic numbers.  
(defined($AF_INET))     || ($AF_INET = 2);
(defined($SOCK_STREAM)) || ($SOCK_STREAM = 1);
$sockaddr = 'S n a4 x8';


$proto = ((getprotobyname("tcp"))[2] || 0);
$port  = ((getservbyname("finger", "tcp"))[2] || 79);

$time_start=time;

foreach $i (0 .. 20) {
    $SOCKS[$i]="SOCK_$i";
    &generate_socket($SOCKS[$i]);
    warn &tmark."\t"."socketted $SOCKS[$i]" if $debug;
}
$MAX_FREE_SOCKETS=$#free_sockets;

@hosts = &get_host_list();

$max_fileno=-1;
$win=$rin='';
while (($#hosts >=0) ||
       ($#free_sockets < $MAX_FREE_SOCKETS)) 
{
    if  (($#free_sockets >= 0) 
	 && ($#hosts >= 0)) {
	# make a new connection
  	warn &tmark."\t". "new connection (free:$#free_sockets,hosts:$#hosts)" if $debug;
	$given_name=shift(@hosts);
	($canon_name, $host) = (gethostbyname($given_name))[0,4];
	if (!defined($host)) 
	{
	    print "gethostbyname on $given_name failed $!\n";
	    next;
	}
	$new_sock=pop(@free_sockets);
	$canon_names{$new_sock}=$canon_name;
	$given_names{$new_sock}=$given_name;
	$new_fileno=fileno($new_sock);
	$fileno_array[$new_fileno]=$new_sock;
	$max_fileno=$new_fileno if $new_fileno>$max_fileno;
	warn &tmark."\t". "connecting $new_sock to ${given_name}[$canon_name]{$new_fileno}" if $debug;
	$result=connect($new_sock, pack($sockaddr, $AF_INET, $port, $host));
	if (!$result && $! != &EINPROGRESS)
	{
	    print "connect to ${given_name}[$canon_name] failed: $!\n";
	    &generate_socket($new_sock);
	    next;
	}
	vec($win,$new_fileno,1)=1;
	$wbits=unpack("b*", $win);
	warn &tmark."\t". "win now set to $wbits" if $debug;
    } else  
    {

	$wbits=unpack("b*", $win);
	warn &tmark."\t". "polling for connections (free:$#free_sockets,hosts:$#hosts,win:$wbits)" if $debug;
	if (unpack("b*",$win) !~ /^0*$/)
	{
	    $nready=select(undef,$wout=$win, undef, ($#hosts>-1?0:10));
	    $wbits=unpack("b*", $wout);
	    warn &tmark."\t". "select returned $nready ready (wout:$wbits)" if $debug;
	    if ($nready != 0)
	    {
		$readybits=$wout;
		foreach $i (0..$max_fileno)
		{
		    next unless (vec($readybits,$i,1)==1);
		    $ready_sock=$fileno_array[$i];
		    warn &tmark."\t". "sending newline to $ready_sock,$given_names{$ready_sock}{$i}" if $debug;
		    $result=send($ready_sock,"\n",0);
		    if (!$result) 
		    {
			print "[$canon_names{$ready_sock}]: $!\n";
			vec($rin,$i,1)=0;
			vec($win,$i,1)=0;
			&generate_socket($ready_sock);
			next;
		    }
		    vec($win,$i,1)=0; 
		    vec($rin,$i,1)=1;
		    $wbits=unpack("b*", $win);
		    $rbits=unpack("b*", $rin);
		    warn &tmark."\t". "win:$wbits, rin:$rbits" if $debug;
		    $nready--;
		}
		warn &tmark."\t". "nready didn't check (nready-found = $nready)" if ($debug && ($nready!=0));
	    }
	}

	#check for a response
	$rbits=unpack("b*", $rin);
	warn &tmark."\t". "waiting for data to read (free:$#free_sockets,hosts:$#host,rin:$rbits)" if $debug;
	if (unpack("b*",$rin) !~ /^0*$/)	
	{
	    warn &tmark."\t". "selecting (rin:$rbits)" if $debug;
	    $nready=select($rout=$rin, undef, undef, 10);
	    $rbits=unpack("b*", $rout);
	    warn &tmark."\t". "select returned $nready ready (rout:$rbits)" if $debug;
	    next if $nready = 0;
	    $readybits=$rout;
	    foreach $i (0..$max_fileno)
	    {
		next unless (vec($readybits,$i,1)==1);
		$ready_sock=$fileno_array[$i];
		&print_output($ready_sock);
		vec($rin,$i,1)=0; 
		&generate_socket($ready_sock);
		$nready--;
	    }
	    warn &tmark."\t". "nready didn't check (nready-found = $nready)" if ($debug && ($nready!=0));
	}
    }
}

sub print_output {
    local($fhandle)= @_;
    select(STDOUT);
    warn &tmark."\t". "printing data for $fhandle, ($given_names{$fhandle}[$canon_names{$fhandle}])" if $debug;
    print "\n[$canon_names{$fhandle}]\n";
#    fcntl($fhandle, &F_GETFL, $tmp='') ||
#	die "fcntl(\&F_GETFL) failed: $!";
#    fcntl($fhandle, &F_SETFL, $tmp ^= &O_NDELAY);
#	die "fcntl(\&F_SETFL) failed: $!";
    while (<$fhandle>) 
    { 
	s/\r$//;
	print;
    }
}
    
sub get_host_list {
    (
"yaz", "oliver", "adam", "eve", "wile-e", "w20-575-2", "w20-575-3", 
"gene-simmons", "banana-sr", "btc", "bug", "jerk", "granola", "bad_host", "mack", "tess-turbo", "potato-cow", "pal-1",
	      "pal2",
	      "pal3",
	      "pal4",
	      "pal5",
	      "pal6",
	      "pal7",
	      "pal8",
	      "pal9",
	      "pal10",
	      "pal11",
	      "pal12",
	      "pal13",
	      "pal14",
	      "pal15",
	      "pal16",
	      "pal17",
	      "pal18",
	      "pal19",
	      "pal20",
	      "pal21",
	      "pal22",
	      "pal23",
		 "e40-008-5.MIT.EDU",
		 "vongole.MIT.EDU",
		 "carbonara.MIT.EDU",
		 "marinara.MIT.EDU",
		 "alfredo.MIT.EDU",
		 "al-burro.MIT.EDU",
		 "primavera.MIT.EDU",
		 "cacciatore.MIT.ED",
		 "bolognese.MIT.EDU",
	       "safety-pup", "snow-goon",
	       "the-other-woman", "weyr", "akom", "tla", "blaster",
	       "justforfun", "hal", "sofa", 
     )
    }
sub generate_socket {
    local($fhandle)=@_;
    socket($fhandle, $AF_INET, $SOCK_STREAM, $proto) ||
	die "socket: $!\n";
    fcntl($fhandle, &F_GETFL, $tmp='') ||
	die "fcntl(\&F_GETFL) failed: $!";
    fcntl($fhandle, &F_SETFL, $tmp | &FNDELAY) ||
	die "fcntl(\&F_SETFL) failed: $!";
    push(@free_sockets, $fhandle);
}

sub tmark {time-$time_start}