#!/usr/bin/perl

($them, $port, $user, $password) = @ARGV;
$them = "daisy.learning.cs.cmu.edu" unless $them;
$port = 4201 unless $port;
$user = "packet" unless $user;
$password = "bounce" unless $password;

do 'sys/socket.h' || die "Can't do sys/socket.h: $@";

$SIG{'INT'} = 'dokill';
sub dokill { kill 9,$child if $child; }

$sockaddr = 'S n a4 x8';
chop($hostname = `hostname`);

($name, $aliases, $proto) = getprotobyname('tcp');
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);

$this = pack($sockaddr, &AF_INET, 0, $thisaddr);
$that = pack($sockaddr, &AF_INET, $port, $thataddr);

socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind(S, $this) || die "bind: $!";
connect(S, $that) || die "connect: $!";

print "% Connected to $them port $port.\n";

print "/E { % name action clientdata => -\n";
print "  createevent begin\n";
print "    /ClientData exch def  /Action exch def  /Name exch def\n";
print "  currentdict end sendevent\n";
print "} def\n";

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

if ($child = fork) {
    print "% Connecting to $user ...\n";
    print S "connect $user $password\n";
    print S "OUTPUTPREFIX ##PREFIX REPLY\n";
    print S "OUTPUTSUFFIX ##SUFFIX REPLY\n";
    while (<>) {
      if (/^##PERL /) {
	s/^##PERL //;
	eval $_;
      } else {
	print S;
      }
    }
    sleep 1;
    do dokill();
} else {
    while (<S>) {
      if (/^##PREFIX REPLY/) {
	s/##PREFIX REPLY ?(.*)/$1/;
	print "/MudReply ";
	chop;
	if ($_ eq "") {
	  print "null\n";
	} else {
	  &printPSstring($_);
	  print "\n";
	}
	print "[\n";
	while (<S>) {
	  if (/^##SUFFIX REPLY/) {
	    last;
	  } else {
	    print "  ";
	    &printPSstring($_);
	    print "\n";
	  }
	}
	print "] E\n";
      } else {
	print "/MudMessage ";
	chop;
	$action = $_;
	
	if ($action =~ s/([^ ]*) .*/$1/) {
	  &printPSstring($action);
	  print "cvn\n";
	} else {
	  print "null\n";
	}
	print "  ";
	&printPSstring($_);
	print "E\n";
      }
      $| = 1; $| = 0;
    }
}

sub printPSstring {
  local ($str) = @_;
  $str =~ s/[\000-\017]//g;
  $str =~ s/\(/\(/g;
  $str =~ s/\)/\)/g;
  print "($str)";
}
