1#!/usr/bin/perl
2# vim:set ts=4 sw=4 ai:
3#
4# (c) Copyright 2003, Michel C. Toren <mct@toren.net>
5# mct, Sun Jun  1 23:54:39 EDT 2003
6
7use strict;
8
9my $tcptra = shift || "tcptraceroute";
10my $host = shift || "michael.toren.net";
11my $loopback = shift || "127.0.0.1";
12
13print <<"EOT";
14
15                    ---------------------------
16                tcptraceroute test suite version 1.03
17                Please send results to mct\@toren.net
18                    ---------------------------
19
20The current time is ${\(scalar localtime)} (${\(scalar gmtime)} GMT)
21
22EOT
23
24sub findsource($)
25{
26	use Socket;
27	my $host = shift;
28	my $udp = getprotobyname("udp") or die "getprotobyname: $!\n";
29	socket(S, PF_INET, SOCK_DGRAM, $udp) or die "scoket: $!\n";
30	my $s = sockaddr_in 1, (inet_aton $host or die "Unknown host: $host\n");
31	connect S, $s or die "connect: $!\n";
32	return inet_ntoa((sockaddr_in getsockname S)[1]);
33}
34
35sub run($)
36{
37	my $command = shift;
38	my $output = qx($command);
39	my $exit = $? >> 8;
40	my $signal = $? & 127;
41	$output =~ s/^/> /mg;
42	$output =~ s/>\s*$//s;
43	return wantarray ? ($output, $exit, $signal) : $output;
44}
45
46sub uname
47{
48	print "Executing 'uname -a' to determine system type:\n";
49	my ($output, $exit, $signal) = run "uname -a 2>&1";
50	print $output;
51	print "Failed!  Exit code $exit",
52		($signal ?  ", signal $signal" : ""), "\n"
53			if ($exit != 0);
54	print "\n";
55}
56
57sub ver
58{
59	print "Executing '$tcptra -d -v' to determine version:\n";
60	my ($output, $exit, $signal) = run "$tcptra -d -v 2>&1";
61	print $output;
62	print "Failed!  Exit code $exit",
63		($signal ?  ", signal $signal" : ""), "\n"
64			if ($exit != 0);
65	print "\n";
66}
67
68sub trace($)
69{
70	my $host = shift;
71	print "Executing '$tcptra $host':\n";
72	my ($output, $exit, $signal) = run "$tcptra $host 2>&1";
73	print $output;
74
75	print "Failed!  Exit code $exit",
76		($signal ?  ", signal $signal" : ""), "\n"
77			if ($exit != 0);
78
79	print "\n";
80}
81
82sub linklayer($)
83{
84	my $host = shift;
85	print "Attempting to determine linklayer type used to reach $host...\n";
86	my ($output, $exit, $signal) = run "$tcptra -d -f 255 -m 255 -q 1 $host 2>&1";
87
88	if ($exit != 0)
89	{
90		print "Failed!  Exit code $exit",
91			($signal ?  ", signal $signal" : ""), "\n\n";
92		return;
93	}
94
95	my ($snaplen)		= ($output =~ /^> debug:\s+.*\s+SNAPLEN: (\d+)/m);
96	my ($datalink)		= ($output =~ /^> debug:\s+.*\s+datalink: (\d+)/m);
97	my ($datalinkoffset)= ($output =~ /^> debug:\s+.*\s+datalinkoffset: (\d+)/m);
98	my ($datalinkname)	= ($output =~ /^> debug:\s+.*\s+datalinkname: ([^\s]+)/m);
99	my ($device)		= ($output =~ /^> debug:\s+.*\s+device: ([^\s]+)/m);
100	my ($trackport)		= ($output =~ /^> debug:\s+.*\s+o_trackport: ([^\s]+)/m);
101	my ($noselect)		= ($output =~ /^> debug:\s+.*\s+o_noselect: ([^\s]+)/m);
102
103	print "Device $device, type $datalinkname, offset $datalinkoffset, snaplen $snaplen, o_noselect $noselect, o_trackport $trackport\n";
104	print "\n";
105}
106
107uname;
108ver;
109
110print "Warning: findsource($loopback) != $loopback, but instead ",
111	findsource $loopback, "?\n\n"
112		unless (findsource $loopback eq $loopback);
113
114trace "-f 1 -m 1 $loopback";
115trace $host;
116trace "-f 1 -m 1 " . findsource $host;
117linklayer $host;
118