head	1.2;
access;
symbols;
locks; strict;
comment	@# @;


1.2
date	2003.04.25.22.04.04;	author wessels;	state Exp;
branches;
next	1.1;

1.1
date	2003.04.25.21.51.35;	author wessels;	state Exp;
branches;
next	;


desc
@@


1.2
log
@*** empty log message ***
@
text
@#!/usr/bin/perl

# $Id$
#
# 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;
}   

@


1.1
log
@Initial revision
@
text
@d3 10
d24 5
a28 1
@@sources = ( 'sj:8989', 'pb:8989', 'uc:8989', 'bo1:8989', 'bo2:8989', 'sv:8989', 'sd:8989', 'pa:8989', 'rtp:8989', 'ny:8989');
a29 4
# seed some special cases
$FQDN{'204.29.239.66'}='sj.us.ircache.net';
$FQDN{'204.123.7.2'}='pa.us.ircache.net';
$FQDN{'128.109.131.47'}='rtp.us.ircache.net';
@