#! /s/perl/bin/perl


($infile, $port) = @ARGV;

$infile = 'stdin' unless $infile;
$port = 6006 unless $port;

# What to say when waiting
$wait_message = "WAIT:\n";

$SIG{'INT'} = 'close_serv_sock';

if ($infile ne 'stdin') {
    open(INFILE,$infile) || die "could not open file $infile\n";
    $use_stdin = 0;
    print "reading input from file $infile\n";
} else {
    $use_stdin = 1;
}

$AF_INET = 2;
$SOCK_STREAM = 1;

$sockaddr = 'S n a4 x8';

($name, $aliases, $proto) = getprotobyname('tcp');

if ($port !~ /^\d+$/) {
    ($name, $aliases, $port) = getservbyport($port, 'tcp');
}

print "Serving port: $port\n";

$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");

select(NS); $| = 1; select(stdout);

socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";

$ntrys = 0;
while (!  bind(S,$this)) {
  if ($ntrys % 10 == 0) {
    print "bind: $!\n";
    print "retrying...\n";
  }
  sleep 5;
  $ntrys++;
  die "repeated bind() failures...\n" if ($ntrys > 100);
}

listen(S,5) || die "connect: $!";

select(NS); $| = 1; select(stdout);

print "Listening for connection....\n";

for ($con=1; ; $con++) {

    ($addr = accept(NS,S)) || die $!;

    if (($child = fork()) == 0) {

      print "accepted.\n";
      $SIG{'INT'} = '';

      ($af, $port, $inetaddr) = unpack($sockaddr,$addr);
      @inetaddr = unpack('C4',$inetaddr);
      print "$con: $af $port @inetaddr\n";

        if ($child = fork() ) {

          if ($use_stdin) {
            while (<STDIN>) {
                print NS;
            }
          } else {
            while (<INFILE>) {
              if (/^WAIT/) {
                  if (/^WAIT\s+(\d+)/) {
                      $nsecs = $1;
                  } else {
                      $nsecs = 0;
                  }
                  print NS $wait_message if $wait_message;
                  $nsecs = $nsecs + 0;
                  sleep($nsecs) if ($nsecs);
              } else {
                  print NS;
              }
            }
          }

          sleep 1;
          exit 0;
          kill 9,$child if $child;

        } else {

          while (<NS>) {
            print "Receivd:$_";
          }
        }

      close(NS);
      exit 0;
    }
    close(NS);
}

&close_serv_sock;

sub close_serv_sock {

    print "ow.\n";
    close(S);
    exit 0;
}