#/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;