#/usr/local/bin/perl -s

$pat = 'S n C4 x8';
$inet = 2;
$echo = 7;
$smtp = 25;
$nntp = 119;

die "Usage:  $0 port \n" unless @ARGV;
$this = pack($pat,$inet,$ARGV[0], 0,0,0,0);
#$this = pack($pat,$inet,2345, 0,0,0,0);

socket(LISTENER,2,1,6) || die "Socket $!\n";
bind(LISTENER,$this) || die "Bind $!\n";
listen(LISTENER,5) || die "Listen $!\n";

$readbits = $writebits = 8 x "\0";
# always read from standard input
vec($readbits,0,1) = 1;

# and look for new connections
#
vec($readbits,fileno(LISTENER),1) = 1;

$listener = fileno(LISTENER);

$0 = $0;
#
# prototype file name
#
$sockp = 'clientaa';
while (1)
{
    $rbits = $readbits;
    $wbits = $writebits;
    grep(vec($wbits,$_,1) = 1, keys %bcastpending);
    ($nfound, $timeleft) = select($rbits, $wbits, undef, undef);
    if ($nfound > 0)
    {
	#
	# we got a hit of some sort
	# first see if anything to write
	if ($wbits =~ /[^\0]/)
	{
	    $bstr = unpack('b*',$wbits);
	    for($fd = index($bstr,'1'); $fd >= 0; $fd = index($bstr,'1',$fd+1))
	    {
		# we just ignore errors here
		#
		$sock = $filenames[$fd];
		send($sock,$bcastdata,0);
		delete $bcastpending{$fd};
	    }
	}
	if ($rbits =~ /[^\0]/)
	{
	    $bstr = unpack('b*',$rbits);
	    for($fd = index($bstr,'1'); $fd >= 0; $fd = index($bstr,'1',$fd+1))
	    {
		if ($fd == 0)
		{
		    # deal with stdin
		    $incount = sysread(STDIN,$bcastdata,1024);
		    if ($incount == 0)
		    {
			# lost our connection
			die "EOF from source\n";
		    }
		    elsif ($incount < 0)
		    {
			# error
			die "Error from source($!)\n" if ($! !~ /Interrupted/);
		    }
		    grep($bcastpending{$_} = 1, keys %active);
		}
		elsif ($fd == $listener)
		{
		    # deal with cloning new socket
		    $newsock = $sockp++;
		    if ($addr = accept($newsock,LISTENER))
		    {
			#
			# see if we like this host
			#
			($fam,$port,$inetaddr) = unpack('SSL',$addr);
			if ($verbose)
			{
			    $hostname = gethostbyaddr($addr, 2);
			    printf "Connection from $hostname %x %d\n", $inetaddr, $port;
			}
			# change inet address to match your site
			if ($inetaddr != 0x7f000001 && $inetaddr & 0xffff0000 != 0x83920000)
			{
			    #
			    # not a host we like, bounce it.
			    #
			    close ($newsock);
			    if ($verbose)
			    {
				$hostname = gethostbyaddr($addr, 2);
				printf "Connection refused from $hostname %x %d\n", $inetaddr, $port;
			    }
			}

			#
			# set bit vectors for later use
			#
			vec($readbits,fileno($newsock),1) = 1;
			$bcastpending{fileno($newsock)} = 1 if length $bcastdata;
			$active{fileno($newsock)} = 1;
			$filenames[fileno($newsock)] = $newsock;
		    }
		    else
		    {
			die "Error on accept $!\n";
		    }
		}
		else
		{
		    # read data from socket and toss, check for eof
		    $sock = $filenames[$fd];
		    $incount = read($sock,$waste,1024);
		    if ($incount == 0)
		    {
			# lost our connection
			#
			# reset bit vectors
			#
			vec($readbits,$fd,1) = 0;
			$filenames[$fd] = '';
			delete $bcastpending{$fd};
			delete $active{$fd};
		    }
		    elsif ($incount < 0)
		    {
			# error
			die "Error from socket($!)\n" if ($! !~ /Interrupted/);
		    }
		}
	    }
	}
    }
    elsif ($nfound < 0)
    {
	die "Error ($!) on select\n" unless $! =~ /Interrupted/;
    }
}
exit 0;