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