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