#!/usr/bin/perl

# $Id: traceroute-query.pl,v 1.2 2003/04/25 22:04:04 wessels Exp $
#
# perl code to send traceroute requests to a bunch of 'traceroute servers' on remote
# hosts.  The traceroute servers are running 'udp-tracerouted' from inted.  This
# script collects the replies, formats them, and presents a table sorted by RTT.
#
# @sources array holds address and port of traceroute servers.
#
# warning, this code written by beginner perl programmer long ago!

$|=1;

require 'sys/socket.ph';

$sockaddr = 'S n a4 x8';
($name, $aliases, $proto) = getprotobyname("udp");
$thissock = pack($sockaddr, &AF_INET, 0, "\0\0\0\0");

die "socket: $!\n" unless
	socket (SOCK, &AF_INET, &SOCK_DGRAM, $proto);

@sources = ( 'host1:8989', 'host2:8989', 'host3:8989');

# may want to hard-code some FQDNs as special cases
#
$FQDN{'192.168.0.1'}='host1.example.com';


%rqpairs = &get_request;

unless (defined $rqpairs{'dest'}) {
	print "ERROR: no dest parameter\n";
	exit 0;
}
$dest = $rqpairs{'dest'};

while ((shift @sources) =~ /([^:]+):(\d+)/) {
	$host = $1;
	$port = $2;
	($fqdn, $aliases, $type, $len, $themaddr) = gethostbyname($host);
	$ADDR{$host} = pack('Sna4x8', &AF_INET, $port, $themaddr);
	$ip = join('.', unpack('C4', $themaddr));
	$FQDN{$ip} = $fqdn unless defined ($FQDN{$ip});
}

$len = length($dest);
$n = 0;
foreach $host (keys %ADDR) {
	$port = $PORT{$host};
	@ip = split('\.', $IP{$host});
	$them = pack('SnC4x8', &AF_INET, $port, @ip);
	($sport,@IP) = unpack('x2nC4x8', $ADDR{$host});
	die "send: $!\n" unless send(SOCK, $dest, 0, $ADDR{$host});
	$n++;
}

print "Content-Type: text/html\r\n";
print "\r\n";
print "<H2>Traceroutes to $dest</H2>\n";
print "<P>Summary table is printed at the end.</P>\n";

$timeleft = 60.0;
while ($n > 0 && $timeleft >= 0.0) {
       	$rin = '';
       	vec($rin,fileno(SOCK),1) = 1;
       	($nfound,$timeleft) = select($rout=$rin, undef, undef, $timeleft);
	last if ($nfound == 0);
	die "recv: $!\n" unless
               	$theiraddr = recv(SOCK, $reply, 8192, 0);
  	($junk, $junk, $sourceaddr, $junk) = unpack($sockaddr, $theiraddr);
  	$ip = join('.', unpack('C4', $sourceaddr));
	$reply =~ s/\d+\s+\*\s+\*\s+\*// while ($reply =~ /\d+\s+\*\s+\*\s+\*/);
	$reply =~ s/\d+\s+\*\s+\*// while ($reply =~ /\d+\s+\*\s+\*/);
	$reply =~ s/\d+\s+\*// while ($reply =~ /\d+\s+\*/);
	$REPLY{$ip} = $reply;
	printReply($ip,$reply);
	$n--;
}

foreach $ip (keys %REPLY) {
	$HOPS{$ip} = &hops($REPLY{$ip});
	$RTT{$ip} = &rtt($REPLY{$ip});
}

print "<P>Summary of results, sorted by RTT:\n";
print "<P>\n";
print "<CENTER>\n";
print "<TABLE BORDER>\n";
print "<TR>\n";
print "<TH>Cache</TH>\n";
print "<TH>RTT</TH>\n";
print "<TH>HOPS</TH>\n";
print "</TR>\n";
foreach $ip (sort byrtt keys %REPLY) {
	print "<TR>\n";
	print "<TD>$FQDN{$ip}</TD>\n";
	printf "<TD>%.3f</TD>\n", $RTT{$ip};
	printf "<TD>%d</TD>\n", $HOPS{$ip};
	print "</TR>\n";
}
print "</TABLE>\n";
print "</CENTER>\n";
print "<HR>\n";

sub printReply {
	local($ip,$reply) = @_;
	print "<H3>$FQDN{$ip}</H3>\n";
	print "\n";
	print "<P><SMALL>\n";
	print "<PRE>$reply</PRE>\n";
	print "</SMALL></P>\n";
	print "\n";
}

exit 0;

sub byrtt {
	local($ra) = $RTT{$a};
	local($rb) = $RTT{$b};
	$ra = 1000000 if ($ra < 0);
	$rb = 1000000 if ($rb < 0);
	$ra <=> $rb;
}


sub hops {
	local($buf) = @_;
	local(@lines) = split(/[\r\n]/, $buf);
	local($l) = pop @lines;
	local($hops) = -1;
	$hops = $1 if ($l =~ /^\s*(\d+)/);
	$hops;
}

sub rtt {
	local($buf) = @_;
	local(@lines) = split(/[\r\n]/, $buf);
	local($l) = pop @lines;
	local($rtt) = 0;
	local($n) = 0;
	local(@x) = split(/\s+/, $l);
	while (@x) {
		local($t) = shift @x;
		if ($t =~ /!X/ || $t =~ /!H/) {
			$n = $rtt = 0;
			last;
		}
		next unless ($x[0] eq 'ms');
		$rtt += $t;
		$n++;
	}
	if ($n == 0) {
		$rtt = -1;
	} elsif ($rtt == 0) {
		$rtt = -1;
	} else {
		$rtt /= $n;
	}
	$rtt;
}

sub get_request {       
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
    } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
        $request = $ENV{'QUERY_STRING'};
    }   
    local(@F) = split(/&/, $request);
    foreach $x (@F) {
        ($k,$v) = split(/=/, $x);
        push (@G, &url_decode($k,$v));
    }           
    @G;
}   

sub url_decode {
    foreach (@_) {
        tr/+/ /;
        s/%(..)/pack("c",hex($1))/ge;
    }
    local ($k, $v);
    local (%Y);
    while (($k=shift @_) && ($v=shift @_)) {
        $Y{$k} = defined $Y{$k} ? join (' ', $Y{$k}, $v) : $v;
    }
    #@_;
    %Y;
}