#!/usr/bin/perl

# Copyright (c) 2001 The Regents of the University of California.  
# All rights reserved.
# This software product is developed by Tony McGregor.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that: (1) source code distributions
# retain the above copyright notice and this paragraph in its entirety,
# (2) distributions including binary code include the above copyright
# notice and this paragraph in its entirety in the documentation or other
# materials provided with the distribution, and (3) derivative work or other
# resulting materials based on this software product display the following
# acknowledgement: ``This work utilizes software developed in whole or in
# part by the National Laboratory for Applied Network Research (NLANR) at
# the University of California San Diego's San Diego Supercomputer Center,
# under a National Science Foundation Cooperative Agreement No. ANI-9807479,
# and its contributors.''
# 
# Neither the NLANR name, the name of the University, funding organizations,
# nor the names of its contributors may be used to endorse or promote
# products derived from this software without specific prior written
# permission.
# 
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.


use strict;
use Socket;

my ($DEFAULT_SERVER, $DEFAULT_PORT, $MAX_REPLY_SIZE, $TIMEOUT, $MAX_RETRIES,
    $cnt, $as1, $ambiguous1, $prefixlen1, $as2, $ambiguous2, $prefixlen2, 
    $val1, $val2, $len, $reply, $as, $ambiguous, $prefixlen, $result,
    $rin, $server_addr, $request, $retries );

$DEFAULT_SERVER = 'ipas.nlanr.net';
$DEFAULT_PORT   = 10123;
$MAX_REPLY_SIZE = 256 * 4 + 4;
$TIMEOUT        = 3;
$MAX_RETRIES    = 10;


socket(SOCKET, PF_INET, SOCK_DGRAM, getprotobyname("udp"))
    or die "socket: $!";

$server_addr = sockaddr_in(scalar($DEFAULT_PORT), 
                   inet_aton(shift || $DEFAULT_SERVER));


#Now send a message with 3 requests. We make the requests different
#ways just to make the example cover differnet approaches
$val1 = &inet_addr("210.55.255.1");
$val2 = pack("C4", 130,217,248,88);

#The final message is concaternation of two seperate packs, again as
#an example The first neumber (1) is the protocol version number, the
#second (3) is the number of requests.  The
#130,217,248,77 matches the C4 and is a single long, $val1 is the
#second long

$request = pack("nnC4N", 1, 3, 130,217,248,77, $val1) . $val2;


#UDP is not repliable so we bust be prepared to resend if there is no
#reply.  We use select to wait for a reply for $TIMEOUT seconds.  If none 
#comes we transmit again.

$rin = '';
vec($rin, fileno(SOCKET), 1) = 1;
$retries = 0;
while ( 1 ) {   #repeat until we get a reply
   #sent the message
   defined(send(SOCKET, $request, 0, $server_addr))    || die "send: $!";

   if ( select($rin, undef, undef, $TIMEOUT) ) { last; }

   if ( ++$retries > $MAX_RETRIES ) {
       print "Maximum number of transmission attempts exceeded\n";
       exit -1;
   }
   print "Resend $retries\n";
}

#Get the result.
defined(recv(SOCKET, $reply, $MAX_REPLY_SIZE, 0))   || die "recv: $!";

#unpack the results
($cnt, $as1, $ambiguous1, $prefixlen1, $as2, $ambiguous2, $prefixlen2) =
    unpack("nnnnnnn", $reply);
print "$cnt\n$as1, $ambiguous1, $prefixlen1\n$as2, $ambiguous2, $prefixlen2\n";


#or unpack them this way
$cnt = unpack("n", $reply);
for ($result = 0; $result < $cnt; ++$result) {
    $as        = vec($reply, 1 + 3 * $result, 16);
    $ambiguous = vec($reply, 2 + 3 * $result, 16);
    $prefixlen = vec($reply, 3 + 3 * $result, 16);

    print "$result $as $ambiguous $prefixlen\n";
}


exit;
#######################################################################
sub inet_addr(){
    my ($b1, $b2, $b3, $b4) = split(/\./, $_[0]);
    return ($b1 << 24) | ($b2 << 16) | ($b3 << 8) | $b4;
}