#!/usr/bin/perl -w
 use IO::Socket;
 use Net::hostent;              # for OO version of gethostbyaddr


 $PORT = 9000;                  # pick something not in use


 $server = IO::Socket::INET->new( Proto     => 'tcp',
                                  LocalPort => $PORT,
                                  Listen    => SOMAXCONN,
                                  Reuse     => 1);


 die "can't setup server" unless $server;
 print "[Server $0 accepting clients]\n";


 while ($client = $server->accept()) {
   $client->autoflush(1);
   print $client "Welcome to $0; type help for command list.\n";
   $hostinfo = gethostbyaddr($client->peeraddr);
   printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
   print $client "\nCommand? ";
   while ( <$client>) {
     next unless /\S/;       # blank line
     if    (/quit|exit/i)    { print STDOUT "[Client says goodbye]\n"; last;                                     }
     elsif (/date|time/i)    { printf $client "%s\n", scalar localtime;  }
     elsif (/who/i )         { print  $client `who 2>&1`;                }
     elsif (/cookie/i )      { print  $client `/usr/games/fortune 2>&1`; }
     elsif (/motd/i )        { print  $client `cat /etc/motd 2>&1`;      }
     else {
       print $client "Commands: quit date who cookie motd\n";
     }
   } continue {
      print $client "\nCommand? ";
   }
   close $client;
 }

##</code><code>##

#!/usr/bin/perl -w
    use strict;
    use IO::Socket;
    my ($host, $port, $kidpid, $handle, $line);


    unless (@ARGV == 2) { die "usage: $0 host port" }
    ($host, $port) = @ARGV;


    # create a tcp connection to the specified host and port
    $handle = IO::Socket::INET->new(Proto     => "tcp",
                                    PeerAddr  => $host,
                                    PeerPort  => $port)
           or die "can't connect to port $port on $host: $!";


    $handle->autoflush(1);              # so output gets there right away
    print STDERR "[Connected to $host:$port]\n";


    # split the program into two processes, identical twins
    die "can't fork: $!" unless defined($kidpid = fork());


    # the if{} block runs only in the parent process
    if ($kidpid) {
        # copy the socket to standard output
        while (defined ($line = <$handle>)) {
            print STDOUT $line;
        }
        kill("TERM", $kidpid);                  # send SIGTERM to child
    }
    # the else{} block runs only in the child process
    else {
        # copy standard input to the socket
        while (defined ($line = <STDIN>)) {
            print $handle $line;
        }
    }