Article 2240 of comp.lang.perl:
Xref: feenix.metronet.com comp.infosystems.gopher:2068 comp.lang.perl:2240
Newsgroups: comp.infosystems.gopher,comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!usc!elroy.jpl.nasa.gov!swrinde!network.ucsd.edu!munnari.oz.au!uniwa!cujo!peter
From: peter@cujo.curtin.edu.au (Peter N Lewis)
Subject: Perl daemon server instead of inetd process - code
Message-ID: <1993Apr18.070732.6317@cujo.curtin.edu.au>
Organization: Curtin University of Technology
Date: Sun, 18 Apr 1993 07:07:32 GMT
Lines: 62

Hi All,

A while back I posted a perl gopher server that ran as an inetd process,
and there were a few complaints that this meant perl had to reparse for
every connection, which especially for a gopher server was a bad idea,
since it gets so many connections and does so little work for each
connection.  Well, at the time I didn't know how to do otherwise,
however, I've since found some code that does it, so here it is  This is
just code to do a permanently running server (run it from the rc file
for instance), not a gopher server.  Someone else can retrofit it to the
perl gopher server if they like (I checked out version 1.2, and its
strewn with exits, so they'd obviously have to go before this would
work).  Anyway, here is the code, no strings attached, do whatever you
want with it. Note, of course, that if the code fails for any reason, it
means the service stops working for everyone, whereas launching via
inetd would keep going.

trivial-server:
#!/bin/perl

$ourservice='gopher';   # Service to look up
$ourport=70;            # port to fall back on if service can't be found

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

($name, $aliases, $proto) = getprotobyname('tcp');

# convert service to port number
if ($ourservice) {
  ($name, $aliases, $port) = getservbyname($ourservice, 'tcp');
  $ourport=$port if $port;
}

$sockaddr = 'S n x4 x8';
$this = pack($sockaddr, 2, $ourport, 0);

select(CON); $| = 1; select(stdout);

socket(S, 2, 1, $proto) || die("socket: $!");
bind(S, $this) || die("bind: $!");
listen(S, 5) || die("connect: $!");
select(S); $| = 1; select(stdout);

for(;;) {
  ($addr = accept(CON,S)) || die("Accept:$!");
  select CON;
  $saddr = 'S n a4';
  ($af,$remote_port,$remote_ip) = unpack($saddr,$addr);

# Insert code here
  ($i1,$i2,$i3,$i4) = unpack("C C C C",$remote_ip);
  print "Thanks for connecting from $i1.$i2.$i3.$i4 $remote_port\r\n";
  
  close CON;
}

Enjoy,
   Peter.

-- 
_______________________________________________________________________
Peter N Lewis <peter@ncrpda.curtin.edu.au>           Ph: +61 9 368 2055