use IO::Socket;
# optional stuff to make init.d calling work
my $pidFile = '/var/run/something.pid';
my $pid = fork;
if ($pid) # parent: save PID
{
open PIDFILE, ">$pidFile" or die "Can't open PID file: $!\n";
print PIDFILE $pid;
close PIDFILE;
exit 0;
}
# end of optional init.d stuff
my $port = 8000;
my $proto = 'tcp';
my %kids = ();
# do stuff when we are forced to exit
$SIG{"TERM"} = "cleanup_and_exit";
sub cleanup_and_exit {
my $sig = @_;
foreach my $kid (keys %kids) {
# attempt to reap the kiddies
warn ("Failed to reap child pid: $kid") unless kill 9, $kid;
}
# it's a good idea to exit when you are told to
exit(0);
}
# set up a socket
my $listen_socket = IO::Socket::INET->new(LocalPort => $port,
Listen => 10,
Proto => $proto,
Reuse => 1);
while (my $connection = $listen_socket->accept)
{
my $child;
# perform the fork or exit
die "Can't fork: $!" unless defined ($child = fork());
if ($child == 0) { # i'm the child!
# close the child's listen socket, we dont need it.
$listen_socket->close;
# call the main child rountine
&some_routine($connection);
# if the child returns, then record and exit;
undef $kids{$child};
exit 0;
} else { # i'm the parent!
# remember the pid of any children for later reaping
$kids{$child} = 1;
# close the connection, the parent has already passed
# it off to a child.
$connection->close();
}
# go back and listen for the next connection!
}
sub some_routine {
my $socket = shift;
# go for it here ...
# but don't forget to exit
exit(0);
}
| 