#!/usr/bin/perl

# library of routines to help in dealing with the world outside this program
$debug=0;
require '/pkg/arpa/demo.0/require.pl';

##########
# set up $AF_INEET and $SOCK_STREAM and $SOCK_DGRAM
 
# just in case 'h2ph' wasn't run ...
eval `cat /usr/include/sys/socket.h | /pkg/bin/h2ph` unless defined &AF_INET;
 
if (defined &AF_INET) {
    $AF_INET= &AF_INET;
} else {                        # still didn't work ?!
    $AF_INET = 2;               # take a guess
    print STDERR "Warning, AF_INET= $AF_INET assumed!\n";
}
if (defined &SOCK_STREAM) {
    $SOCK_STREAM= &SOCK_STREAM;
    $SOCK_DGRAM= &SOCK_DGRAM;
} else {                        # still didn't work ?!
    $SOCK_STREAM = 1;           # take a guess
    $SOCK_DGRAM= 2;
    print STDERR "Warning, SOCK_STREAM= $SOCK_STREAM and SOCK_DGRAM= $SOCK_DGRAM assumed!\n";
}
########

$sockaddr = 'S n a4 x8';  # This is a signature for later use in pack()
(undef, undef, $udp_protocol) = getprotobyname ('udp');
(undef, undef, $tcp_protocol) = getprotobyname ('tcp');

######

sub do_the_right_thing {
  die "Sorry, not enough information provided\n";
}

# based on the routine in udpin
sub setup_udp_connection {
  my ($to_port,$to_addr)= @_;
  $that = pack ($sockaddr, $AF_INET, $to_port, $to_addr);
  socket (US, $AF_INET, $SOCK_DGRAM, $udp_protocol) || die "socket US: $!\n";
  connect (US, $that) || die "connect US: $!";
}

sub host2ip {
  my ($host)= shift;
  $host .= '.cs.ucdavis.edu' unless $host =~ /\./;
  return (gethostbyname($host))[4];
}

# call this with a server and preformated SCL message and it gets sent
sub send_server_message {
  my ($server,$scl_mess)= @_;
  #print "$server:$server_port gets $scl_mess\n";
  &setup_udp_connection($server_port,&host2ip($server));
  send (US, $scl_mess, 0)  || print STDOUT __LINE__, "$!\n";
  close US;
}

sub encode_scl_message {
  my ($msg) = '';
  $fields = join ("\000", @_);
  $fields .= "\000"; 
  $msg = sprintf ("%5d\000%5d\000", 12 + length $fields, ($#_ + 1) / 2 );
  $msg .= $fields;
  return $msg;
}

# call this with a server and SCL message components (a list or hash)
# and it gets sent
sub send_scl_message {
  my $server= shift;
  my ($msg) = '';
  $fields = join ("\000", @_);
  $fields .= "\000"; 
  $msg = sprintf ("%5d\000%5d\000", 12 + length $fields, ($#_ + 1) / 2 );
  $msg .= $fields;
  &send_server_message($server,$msg);
}

sub route_mess_to {
  my($condition,$port,@hosts)= @_;
  my $hostname= $myhostname; # from require.pl
  $rule= $condition . " ==>  \@$hostname:$port";
  foreach $host (@hosts) {
    &send_scl_message($host,$reconfig_scl_rules,$host,'/dev/null','ADD',$rule);
  }
  return $rule;
}

sub unroute_mess {
  my($rule,@hosts)= @_;
  foreach $host (@hosts) {
    &send_scl_message($host,$reconfig_scl_rules,$host,'/dev/null','DELETE',$rule);
  }
} 

sub get_responce_port {
  open(PORTFILE,"</pkg/www/arpa/secret/gui/portfile") || (warn "could not open portfile", return '8888');
  $port=<PORTFILE>;
  chop $port;
  close(PORTFILE);
  
  open(PORTFILE2,">/pkg/www/arpa/secret/gui/portfile") || warn "could not write to portfile";
  print PORTFILE2 $port+1,"\n";
  close(PORTFILE2);
  return $port;
}

sub setup_rcv_tcp_connection {
  my ($local_port)= @_;
  my $this = pack($sockaddr, $AF_INET, $local_port, "\0\0\0\0");
  select(NS); $| = 1; select(STDOUT);

  socket(S, $AF_INET, $SOCK_STREAM, $tcp_protocol) || die "socket: $!";
  bind(S,$this) || die "bind: $!";
#  print "listening on port $local_port\n";
  listen(S,25) || die "listen: $!";
#  print "did listen\n";
  select(S); $| = 1; select(STDOUT);
}

sub accept_tcp_connection {
  my $addr;
  ($addr = accept(NS,S)) || (print "accept error: $!\n" && exit);
}

sub read_tcp_connection {
  my (@lines);
  while (<NS>) {
    #print "tcp< $_\n";
    push (@lines,$_);
  }
  return @lines;
}

sub print_tcp_input {
  my (@lines);
  while (<NS>) {
    print;
  }
}

sub close_tcp_connection {
  close NS;
  close S;
}

# modified from udp.scl.1.pl
sub send_logd_query {
  my ($site,$reply_port,$mode,@rrs)= @_;
  #my ($dest) = ($rr =~ / ==> [\|>@]/);
  ## RC 1/18/96:  Apparently I've ignored this $dest redirect option for ages.
  # DEBUG- HTML dependency:  RESET, ADD, DELETE, SHOW for $mode
  # DEBUG- Assumes irrelevant whitespace already squeezed out.   RC'96: ?????
  # query may already specify destination for replies.
  my ($query_dest) = " ==> \@$myhostname:$reply_port";

  # format for message header is ($reconfigure_scl_rules,
  # destination_host, file to store in, reset|add|show|delete_rules)
  my (@msg) = ($reconfig_scl_rules, $site, "/dev/null", $mode);
  push (@msg, join("\n",@rrs)) if @rrs; # routing rules get put in one param
  #print STDERR "Sending query <@msg>\n" if $debug > 0;
  $msg= &encode_scl_message(@msg);
  #&scl_msg_format (@msg);
  my($that) = pack ($sockaddr, $AF_INET, $server_port, &host2ip($site));
  send (QS, $msg, 0, $that)  || print STDOUT __LINE__, " !  $!\n";
  return 0;       # Best to hang around to confirm receipt & no errors.
} ####################################### send_logd_query

# modified from udp.scl.1.pl
sub setup_udp_socket {
  $reply_port= shift;
  $this = pack ($sockaddr, $AF_INET, $reply_port, "\0\0\0\0");
  socket (QS, $AF_INET, $SOCK_DGRAM, $udp_protocol) || die "socket QS: $!\n";
  # bind (QS, $this) || die "bind QS: $!\n";
  # Not necessary to have separate (un-bind-ed) socket for send vs. recv.
  # Note also:  bind unnecessary if logd replies directly back
  # to whatever random $from port was assigned to our socket call.
 
  $request = "";  # avoid squawk re uninit var in recv
 
} ####################################### setup_udp_socket

# modified from db_query.pl
# QS is the socket to send the message to
sub send_db_query {
  my ($db_addr,$reply_port,@body)= @_;
  #print join(",",@_),"\n";
  my(@msg);
  my($that) = pack ($sockaddr, $AF_INET, $server_port, $db_addr);
  # DEBUG- DB dependency:  Prepend scl routing info:
  @msg = ('dqy',$myhostname,'rport',$reply_port,'qnum',$reply_port);
  # DEBUG- DB dependency:  Needs min and max time vals for search:
  push(@msg,'lo_t','000000000') unless ($cond{'lo_t'});
  push(@msg,'hi_t','900000000') unless ($cond{'hi_t'});
  push(@msg,@body);
  #print STDERR "Sending query <",join(',',@msg),">\n" if $debug > 0;
  send (QS,&encode_scl_message(@msg), 0, $that)  || print STDOUT __LINE__, " !  $!\n";
} ####################################### send_db_query
 

# modified from  db_query.pl
# sets up QS as a UDP socket on $my_rcv_port
sub setup_bind_udp_socket {
  $reply_port= shift;
  $this = pack ($sockaddr, $AF_INET, $reply_port, "\0\0\0\0");
  socket (QS, $AF_INET, $SOCK_DGRAM, $udp_protocol) || die "socket QS: $!\n";
  bind (QS, $this) || die "bind QS: $!\n";
  # Not necessary to have separate (un-bind-ed) socket for send vs. recv.
  # DEBUG- it *is* necessary to *bind* above, because Stuart's db responds
  # to the *enclosed* addr:port, rather than replying back to sender.
  # Unfortunately, DEBUG- PERL 5 BUG won't tell me port assigned to
  # my socket call, so I can't enclose that data.  bind is only option!
  # 
  # $ret = getsockname (QS);
  # ($junk, $my_recv_port, $my_addr) = unpack ($sockaddr, $ret);
  #   ==>   $my_recv_port == 0;  $my_addr == undef !
 
  $request = "";  # avoid squawk re uninit var in recv
 
} ####################################### setup_bind_udp_socket


sub setup_logd_pkt_socket {
  my($reply_port)= &get_responce_port;
  $this = pack ($sockaddr, $AF_INET, $reply_port, "\0\0\0\0");
  socket (PS, $AF_INET, $SOCK_DGRAM, $udp_protocol) || die "socket PS: $!\n";
  bind (PS, $this) || die "bind PS: $!\n";
  return $reply_port;
}