use IO::Socket; use strict; my ($server, $client, $input, $pid, $kid, %kids); $server = IO::Socket::INET->new( Proto => 'tcp', LocalPort => 8000, Listen => 1, Reuse => 1 ); die "Can't set up server" unless $server; print "Server accepting connections.\n"; $pid = $$; MAIN: while ($client = $server->accept()) { $client->autoflush(1); defined (my $kid = fork) or die "Cannot fork: $!\n"; if ($kid) { $kids{$kid} = 1; } else { while (1) { $input = uc getInput($client); chomp $input; if ($input eq 'KILL') { `kill $pid`; exit; } if ($input eq 'EXIT') { exit; } if ($input eq 'DATE') { sendOutput($client, time()); } else { sendOutput($client, $input); } } } close $client; } ### Get input from socket sub getInput { my $handle = $_[0]; my $input; while (<$handle>) { last if !m/\S/; $input .= $_; } return $input; } ### Send to socket sub sendOutput { my ($handle, $output) = @_; $output .= "\n" if $output !~ /\n$/; print $handle $output; print $handle "\n"; }