#!perl
$| = 1;
do 'sys/socket.ph' || die "can't do sys/socket.ph: $@";
push(@INC,'/afs/athena.mit.edu/user/e/eichin/perl/NKRB');
require "zasend.perl";

package udplisten;

$debug = 1;
$sockaddr = 'S n a4 x8';
$fileDescs = '';

($port,$fileno)=&startListener("ztoy");
vec($fileDescs,$fileno,1)=1;
$zsend'zport = $port;

&main'zsend(&main'zpacket(undef,		# figure out uid
			  "ZEPHYR_CTL",
			  "ZEPHYR_CTL_CLIENT",
			  "SUBSCRIBE_NODEFS", # opcode
			  "$ENV{\"USER\"}@ATHENA.MIT.EDU", # sender
			  "",	# recipient
			  "",	# format
			  "login\0*\0\0".
			  ""
));


$debug_packet=1;

if($ARGV[0] eq "nodebug") { $debug_packet=0; $debug=0; }

$| = 1;
while (1) {
    $nfound = select($rout = $fileDescs, undef, undef, undef);
    if ($nfound == -1) {
        if ($! == &EINTR) {
            next;
        } else {
            die "select: $!";
        }
    }
    if (vec($rout, $fileno, 1)) {
	print "got packet...\n" if $debug;
	&process_packet("ztoy");
    }
}

sub startListener {
    local($service) = @_;
    $name = pack($sockaddr, &main'AF_INET, 0, "\0\0\0\0");
    ($pname, $paliases, $proto) = getprotobyname("udp");
    die "Couldn't get proto by name $protoName: $!" if ($pname eq "");
    socket($service, &main'PF_INET, &main'SOCK_DGRAM, $proto) || 
            die "socket ($serviceName): $!";
    bind($service, $name) || die "bind($serviceName): $!";
    ($family,$port,$myaddr)=unpack($sockaddr,getsockname($service));

    print "SL: got port $port on fd ",fileno($service),"\n" if $debug;
    open(WGF,">".$ENV{'WGFILE'});
    print WGF "$port\n" if $debug;
    close(WGF);
    
    ($port,fileno($service));
}


sub process_packet {
    local($service)=@_;
    local($/) = undef;
    local($data)="\0" x 2000; # bug still there!!!!
    local($addr);

    # packet_len = recvfrom(ZGetFD(), packet, sizeof(packet), 0, 
    # (struct sockaddr *)&from, &from_len);
#    read($service,$data,2000);
#          $hersockaddr = getpeername($service);
#          ($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
#    printf "0x%x\n",$heraddr;

    $addr = recv($service,$data,2000,0); # keeps dumping core...
    print "recv worked\n" if $debug_packet;
    local($family, $port, $heraddr) = unpack($sockaddr,$addr);
    printf "%d (%d, %d, 0x%x) \n",length($addr),$family,$port,unpack("N",$heraddr) if $debug_packet;

#    print "got one: $data\n";
    @fields=split("\0",$data);
    for (@fields) {
	print "[",$_,"]" if $debug_packet;
    }
    print "\n" if $debug_packet;
    # ZParseNotice uses ntohl on all of these... is it needed?
    $z_version = shift(@fields);
    $z_nfields = oct(shift(@fields));
    $z_kind = ("UNSAFE", "UNACKED", "ACKED", 
	       "HMACK", "HMCTL",
	       "SERVACK", "SERVNAK", "CLIENTACK", "STAT")[oct(shift(@fields))];
    @z_uid = split(' ',shift(@fields));
       $z_uid_ipaddr = oct(shift(@z_uid));
       $z_uid_time_sec = oct(shift(@z_uid));
       $z_uid_time_usec = oct(shift(@z_uid));
    $z_port = oct(shift(@fields));
    $z_auth = oct(shift(@fields));
    # $z_auth = unpack("C",pack("N",oct(shift(@fields))));
    $z_authlen = oct(shift(@fields));
    $z_authent = shift(@fields);
    $z_class = shift(@fields);
    $z_inst = shift(@fields);
    $z_opcode = shift(@fields);
    $z_sender = shift(@fields);
    $z_recipient = shift(@fields);
    $z_default_format = shift(@fields);
    $z_checksum = oct(shift(@fields));
    $z_multinotice = shift(@fields);
    @z_multi_uid = split(' ',shift(@fields));
       $z_multi_uid_ipaddr = oct(shift(@z_multi_uid));
       $z_multi_uid_time_sec = oct(shift(@z_multi_uid));
       $z_multi_uid_time_usec = oct(shift(@z_multi_uid));
    # at this point, @fields is all of the remaining data...
    $z_message = join("\0",@fields);
    if ($z_kind ne "HMACK" && $z_kind ne "SERVACK" &&
	$z_kind ne "SERVNAK" && $z_kind ne "CLIENTACK") {
	local(@ackfields)=split("\0",$data);
#	$ackfields[1] = "0x00000010"; # no fields
	$ackfields[2] = "0x00000007"; # CLIENTACK;
	
#	$ackfields[5] = "0x00000000"; # no auth
#	$ackfields[14] = "0x00000000"; # no cksum either...
	splice(@ackfields,17);
	push(@ackfields,"");

	send($service,join("\0",@ackfields),0,$addr) || die "Send error $!";
	print join(":",@ackfields)." acked to server.\n" if $debug_packet;
    }
    if($debug) {
	print "---\n$z_default_format\n---\n===\n",&make_def_format($z_default_format,@fields),"\n===\n";
    } else {
	if($z_opcode ne "PING") {
	    print "\n",&make_def_format($z_default_format,@fields),"\n===\n";
	}
    }
}


sub make_def_format {
    local($form,@fs)=@_;
    local($x,$x1,$x2,$x3,$x4,$x5,$x6,$x7,$x8,$x9);
    local($i)=1;
    for (@fs) {
	eval '$x'.$i++.'= $_;';
    }
    local($recipient) = $z_recipient;
    local($class) = $z_class;
    local($instance) = $z_inst;
    local($opcode) = $z_opcode;
    local($sender) = $z_sender;
    local($time) = "Time";
    local($date) = "Date";
    $form =~ s/\$(\d+)/\$x$1/g;
    eval "\$x = qq\0$form\0";
    $x;
}


#
# Class MESSAGE, Instance PERSONAL:
# To: @bold(eichin@ATHENA.MIT.EDU)
# @bold(Jonathan I. Kamens) <jik@ATHENA.MIT.EDU>
# 
# I think I'm using the zwrite in the zephyr locker.
# I also send all of my instance messages will all authentication, pinging,
# etc. turned off.
# 
# ===