Listing 8. serverfork.pl
#!/usr/bin/perl -w
# serverfork.pl - a server that forks a child
# process to handle client connections
use strict;
use IO::Socket;
use Sys::Hostname;
use POSIX qw(:sys_wait_h);
sub REAP {
1 until (-1 == waitpid(-1, WNOHANG));
$SIG{CHLD} = \&REAP;
}
$SIG{CHLD} = \&REAP;
my $sock = new IO::Socket::INET(
LocalHost => 'localhost',
LocalPort => 7890,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1);
$sock or die "no socket :$!";
STDOUT->autoflush(1);
my($new_sock, $buf, $kid);
while ($new_sock = $sock->accept()) {
# execute a fork, if this is
# the parent, its work is done,
# go straight to continue
next if $kid = fork;
die "fork: $!" unless defined $kid;
# child now...
# close the server - not needed
close $sock;
while (defined($buf = <$new_sock>)) {
chop $buf;
foreach ($buf) {
/^HELLO$/ and
print($new_sock "Hi\n"),
last;
/^NAME$/ and
print($new_sock
hostname(),"\n"),
last;
/^DATE$/ and
print($new_sock
scalar(localtime),
"\n"),
last;
# default case:
print $new_sock "DEFAULT\n";
}
}
exit;
} continue {
# parent closes the client since
# it is not needed
close $new_sock;
}