news.utdallas.edu!hermes.chpc.utexas.edu!cs.utexas.edu!sun-barr!olivea!tymix!grimoire!mooring Thu Feb 25 18:32:10 CST 1993
Article: 1233 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1233
Path: feenix.metronet.com!news.utdallas.edu!hermes.chpc.utexas.edu!cs.utexas.edu!sun-barr!olivea!tymix!grimoire!mooring
From: [email protected] (Ed Mooring)
Newsgroups: comp.lang.perl
#Subject: Re: socket-based server (not from inetd)
Message-ID: <[email protected]>
Date: 25 Feb 93 20:04:18 GMT
References: <[email protected]>
Sender: [email protected]
Organization: BT Tymnet Bit Bucket Brigade
Lines: 170
Nntp-Posting-Host: grimoire

In article <[email protected]> [email protected] (Tom Limoncelli) writes:
>In the past people have posted code fragments that show how to write a
>perl program that is started via "inetd".
>
>I would like to develop a long-running daemon that accepts connections
>via sockets but never spawns.  (i.e. all connections are handled by one
>program, a lot like INN's innd).
>
>Does anyone have sample Perl code?  I'd rather not have to re-invent
>the wheel.
>
>Thanks in advance,
>Tom

Here's something I posted a while back that covers most of the
basics.  It listens to stdin and broadcasts what it gets to all
connected sockets.

#/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 = "\0" x 8;
# 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, 5);
   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;
                       }
                       if ($inetaddr != 0x7f000001 && ($inetaddr & 0xffff0000) != 0x83920000)
                       {
                           #
                           # not a tymnet host, 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};
                       close($sock);
                   }
                   elsif ($incount < 0)
                   {
                       # error
                       die "Error from socket($!)\n" if ($! !~ /Interrupted/);
                   }
               }
           }
       }
   }
   elsif ($nfound < 0)
   {
       die "Error ($!) on select\n" unless $! =~ /Interrupted/;
   }
}
exit 0;

Regards,
Ed Mooring ([email protected] 408-922-7504)

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.