Net-Traceroute-1.15/000755 074445 000000 00000000000 12314116247 014205 5ustar00hagwheel000000 000000 Net-Traceroute-1.15/META.json000644 074445 000000 00000001504 12314116247 015626 0ustar00hagwheel000000 000000 { "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Traceroute", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Time::HiRes" : "0" } } }, "release_status" : "stable", "version" : "1.15" } Net-Traceroute-1.15/MANIFEST.SKIP000644 074445 000000 00000000113 11600523143 016070 0ustar00hagwheel000000 000000 ^MANIFEST\.bak$ ^Makefile(\.old)?$ ~$ ^\.git ^archive/ ^blib/ ^pm_to_blib$ Net-Traceroute-1.15/TODO000644 074445 000000 00000000251 11600523144 014666 0ustar00hagwheel000000 000000 -*-Outline-*- * Retain ASN, MPLS data. * Retain DNS names. * See if more modern perl idioms do what we want in the case of pipe/fork/exec producing ENOENT from exec. Net-Traceroute-1.15/MANIFEST000644 074445 000000 00000001413 12314116247 015335 0ustar00hagwheel000000 000000 ChangeLog Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/00-basics.t t/05-backend.t t/07-subclassing.t t/20-parse-4basic.t t/21-parse-4timeouts.t t/22-parse-4ecmp.t t/23-parse-4flags.t t/30-parse-6basic.t t/33-parse-6flags.t t/34-parse-6wierd.t t/40-parse-cisco-4basic.t t/41-parse-cisco-4timeouts.t t/42-parse-cisco-4ecmp.t t/43-parse-cisco-4flags.t t/44-parse-cisco-4unknown.t t/45-parse-cisco-6basic.t t/46-parse-cisco-6timeouts.t t/47-parse-cisco-6ecmp.t t/48-parse-cisco-6flags.t t/80-tracelie.t t/81-timeout.t t/95-sys-traceroute.t t/testlib.pl t/tracelie t/waitroute TODO Traceroute.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-Traceroute-1.15/Traceroute.pm000644 074445 000000 00000077115 12314114530 016664 0ustar00hagwheel000000 000000 ### # Copyright 1998, 1999 Massachusetts Institute of Technology # Copyright 2000-2005 Daniel Hagerty # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. ### # File: traceroute.pm # Author: Daniel Hagerty, hag@ai.mit.edu # Date: Tue Mar 17 13:44:00 1998 # Description: Perl traceroute module for performing traceroute(1) # functionality. # Currently attempts to parse the output of the system traceroute command, # which it expects will behave like the standard LBL traceroute program. # If it doesn't, (Windows, HPUX come to mind) you lose. # # Could eventually be broken into several classes that know how to # deal with various traceroutes; could attempt to auto-recognize the # particular traceroute and parse it. # # Has a couple of random useful hooks for child classes to override. package Net::Traceroute; use strict; no strict qw(subs); #require 5.xxx; # We'll probably need this use vars qw(@EXPORT $VERSION @ISA); use Exporter; use IO::Pipe; use IO::Select; use Socket; use Symbol qw(qualify_to_ref); use Time::HiRes qw(time); use Errno qw(EAGAIN EINTR); use Data::Dumper; # Debugging $VERSION = "1.15"; # Version number is only incremented by # hand. @ISA = qw(Exporter); @EXPORT = qw( TRACEROUTE_OK TRACEROUTE_TIMEOUT TRACEROUTE_UNKNOWN TRACEROUTE_BSDBUG TRACEROUTE_UNREACH_NET TRACEROUTE_UNREACH_HOST TRACEROUTE_UNREACH_PROTO TRACEROUTE_UNREACH_NEEDFRAG TRACEROUTE_UNREACH_SRCFAIL TRACEROUTE_UNREACH_FILTER_PROHIB TRACEROUTE_UNREACH_ADDR TRACEROUTE_UNREACH_PORT TRACEROUTE_SOURCE_QUENCH TRACEROUTE_INTERRUPTED ); ### ## Exported functions. # Perl's facist mode gets very grumbly if a few things aren't declared # first. sub TRACEROUTE_OK { 0 } sub TRACEROUTE_TIMEOUT { 1 } sub TRACEROUTE_UNKNOWN { 2 } sub TRACEROUTE_BSDBUG { 3 } sub TRACEROUTE_UNREACH_NET { 4 } sub TRACEROUTE_UNREACH_HOST { 5 } sub TRACEROUTE_UNREACH_PROTO { 6 } sub TRACEROUTE_UNREACH_NEEDFRAG { 7 } sub TRACEROUTE_UNREACH_SRCFAIL { 8 } sub TRACEROUTE_UNREACH_FILTER_PROHIB { 9 } sub TRACEROUTE_UNREACH_ADDR { 10 } sub TRACEROUTE_UNREACH_PORT { 11 } sub TRACEROUTE_SOURCE_QUENCH { 12 } sub TRACEROUTE_INTERRUPTED { 13 } ## Internal data used throughout the module # Instance variables that are nothing special, and have an obvious # corresponding accessor/mutator method. my @public_instance_vars = qw( base_port debug host max_ttl packetlen queries query_timeout source_address text trace_program timeout no_fragment use_icmp use_tcp tos ); my @simple_instance_vars = ( qw( pathmtu stat ), @public_instance_vars, ); # Field offsets for query info array use constant query_stat_offset => 0; use constant query_host_offset => 1; use constant query_time_offset => 2; # We keep track of the most recently seen chunk of the traceroute for # parsing purposes. use constant token_addr => 0; use constant token_time => 1; use constant token_flag => 2; # Map ! notation traceroute uses for various icmp packet types # it may receive. my %icmp_map_v4 = ( N => TRACEROUTE_UNREACH_NET, H => TRACEROUTE_UNREACH_HOST, P => TRACEROUTE_UNREACH_PROTO, F => TRACEROUTE_UNREACH_NEEDFRAG, S => TRACEROUTE_UNREACH_SRCFAIL, X => TRACEROUTE_UNREACH_FILTER_PROHIB, '!' => TRACEROUTE_BSDBUG, ); my %icmp_map_v6 = ( N => TRACEROUTE_UNREACH_NET, P => TRACEROUTE_UNREACH_FILTER_PROHIB, # Unlikely to be seen in the wild: # S => unreach notneighbor, A => TRACEROUTE_UNREACH_ADDR, '!' => TRACEROUTE_UNREACH_PORT, ); # Entries Q, I, T, and U have never been tested. For the most part, I # don't know how to produce them or they're so rare I couldn't be # bothered. my %icmp_map_cisco = ( A => TRACEROUTE_UNREACH_FILTER_PROHIB, Q => TRACEROUTE_SOURCE_QUENCH, I => TRACEROUTE_INTERRUPTED, U => TRACEROUTE_UNREACH_PORT, H => TRACEROUTE_UNREACH_HOST, N => TRACEROUTE_UNREACH_NET, P => TRACEROUTE_UNREACH_PROTO, T => TRACEROUTE_TIMEOUT, # Handled elsehow: # ? => unknown packet type, ); ### # Public methods # Constructor sub new ($;%) { my $self = shift; my $type = ref($self) || $self; my %arg = @_; # We implement a goofy UI so that all programmers can use # Net::Traceroute as a constructor for all types of object. if(exists($arg{backend})) { my $backend = $arg{backend}; if($backend ne "Parser") { my $module = "Net::Traceroute::$backend"; eval "require $module"; # Ignore error on the possibility that they just defined # the module at runtime, rather than an actual module in # the filesystem. my $newref = qualify_to_ref("new", $module); my $newcode = *{$newref}{CODE}; if(!defined($newcode)) { die "Backend implementation $backend has no new"; } return(&{$newcode}($module, @_)); } } if(!ref($self)) { $self = bless {}, $type; } $self->init(%arg); $self; } sub init { my $self = shift; my %arg = @_; # Take our constructer arguments and initialize the attributes with # them. my $var; foreach $var (@public_instance_vars) { if(defined($arg{$var})) { $self->$var($arg{$var}); } } # Initialize debug if it isn't already. $self->debug(0) if(!defined($self->debug)); $self->trace_program("traceroute") if(!defined($self->trace_program)); $self->debug_print(1, "Running in debug mode\n"); # Initialize status $self->stat(TRACEROUTE_UNKNOWN); if(defined($self->host)) { $self->traceroute; } elsif(defined($self->text)) { $self->_parse($self->text) } $self->debug_print(9, Dumper($self)); } sub clone ($;%) { my $self = shift; my $type = ref($self); my %arg = @_; die "Can't clone a non-object!" unless($type); my $clone = bless {}, $type; # Does a shallow copy of the hash key/values to the new hash. if(ref($self)) { my($key, $val); while(($key, $val) = each %{$self}) { $clone->{$key} = $val; } } # Take our constructer arguments and initialize the attributes with # them. my $var; foreach $var (@public_instance_vars) { if(defined($arg{$var})) { $clone->$var($arg{$var}); } } # Initialize status $clone->stat(TRACEROUTE_UNKNOWN); if(defined($clone->host)) { $clone->traceroute; } elsif(defined($clone->text)) { $clone->_parse($clone->text) } $clone->debug_print(9, Dumper($clone)); return($clone); } ## # Methods # Do the actual work. Not really a published interface; completely # useable from the constructor. sub traceroute ($) { my $self = shift; my $host = $self->host(); $self->debug_print(1, "Performing traceroute\n"); die "No host provided!" unless $host; # Sit in a select loop on the incoming text from traceroute, # waiting for a timeout if we need to. Accumulate the text for # parsing later in one fell swoop. # Note time. Time::HiRes will give us floating point. my $start_time; my $end_time; my $total_wait = $self->timeout(); my @this_wait; if(defined($total_wait)) { $start_time = time(); push(@this_wait, $total_wait); $end_time = $start_time + $total_wait; } my $tr_pipe = $self->_make_pipe(); my $select = new IO::Select($tr_pipe); $self->_zero_text_accumulator(); $self->_zero_hops(); my @ready; out: while( @ready = $select->can_read(@this_wait)) { my $fh; foreach $fh (@ready) { my $buf; my $len = $fh->sysread($buf, 2048); # XXX Linux is fond of returning EAGAIN, which we'll need # to check for here. Still true for sysread? if(!defined($len)) { my $errno = int($!); next out if(($errno == EAGAIN) || ($errno == EINTR)); die "read error: $!"; } last out if(!$len); # EOF $self->text($self->text() . $buf); } # Adjust select timer if we need to. if(defined($total_wait)) { my $now = time(); last out if($now >= $end_time); $this_wait[0] = $end_time - $now; } } if(defined($total_wait)) { my $now = time(); $self->stat(TRACEROUTE_TIMEOUT) if($now >= $end_time); # This is exceedingly dubious. Crawl into IO::Pipe::End's # innards, and nuke the pid connected to our pipe. Otherwise, # close will call waitpid, which we certainly don't wait for a # timeout. delete ${*$tr_pipe}{io_pipe_pid}; } $tr_pipe->close(); my $accum = $self->text(); die "No output from traceroute. Exec failure?" if($accum eq ""); # Do the grunt parsing work $self->_parse($accum); # XXX are you really sure you want to do it like this?? if($self->stat() != TRACEROUTE_TIMEOUT) { $self->stat(TRACEROUTE_OK); } $self; } sub parse { my $self = shift; $self->_parse($self->text()); } sub argv { my $self = shift; my @tr_args; push(@tr_args, $self->trace_program()); push(@tr_args, $self->_tr_cmd_args()); push(@tr_args, $self->host()); my @plen = ($self->packetlen) || (); # Sigh. push(@tr_args, @plen); return(@tr_args); } ## # Hop and query functions sub hops ($) { my $self = shift; my $hop_ary = $self->{"hops"}; return() unless $hop_ary; return(int(@{$hop_ary})); } sub hop_queries ($$) { my $self = shift; my $hop = (shift) - 1; $self->{"hops"} && $self->{"hops"}->[$hop] && int(@{$self->{"hops"}->[$hop]}); } sub found ($) { my $self = shift; my $hops = $self->hops(); if($hops) { my $last_hop = $self->hop_query_host($hops, 0); my $stat = $self->hop_query_stat($hops, 0); # Is this the correct thing to be doing? This gap in # semantics missed me, and wasn't caught until post 1.5 It # would be a good to audit the semantics here. It's possible # that a prior version change broke this. # Getting good regression tests would be nice, but traceroute # is an annoying thing to do regression on -- you usually # don't have enough control over the network. If I was good, # I would be collecting my bug reports, and saving the # traceroute output produced there. return(undef) if(!defined($last_hop)); # Ugh, what to do here? # In IPv4, a host may send the port-unreachable ICMP from an # address other than the one we sent to. (and in fact, I use # this feature quite a bit to map out networks) # IIRC, IPv6 mandates that the unreachable comes from the address we # sent to, so we don't have this problem. # This assumption will that any last hop answer that wasn't an # error may bite us. if( (($stat == TRACEROUTE_OK) || ($stat == TRACEROUTE_BSDBUG) || ($stat == TRACEROUTE_UNREACH_PROTO))) { return(1); } } return(undef); } sub hop_query_stat ($$) { _query_accessor_common(@_,query_stat_offset); } sub hop_query_host ($$) { _query_accessor_common(@_,query_host_offset); } sub hop_query_time ($$) { _query_accessor_common(@_,query_time_offset); } ## # Accesssor/mutators for ordinary instance variables. (Read/Write) # We generate these. foreach my $name (@simple_instance_vars) { my $sym = qualify_to_ref($name); my $code = sub { my $self = shift; my $old = $self->{$name}; $self->{$name} = $_[0] if @_; return $old; }; *{$sym} = $code; } ### # Various internal methods # Many of these would be useful to override in a derived class. # Build and return the pipe that talks to our child traceroute. sub _make_pipe ($) { my $self = shift; $self->debug_print(9, Dumper($self)); # XXX we probably shouldn't throw stderr away. open(my $savestderr, ">&", STDERR); open(STDERR, ">", "/dev/null"); my $pipe = new IO::Pipe; # IO::Pipe is very unhelpful about error catching. It calls die # in the child program, but returns a reasonable looking object in # the parent. This is really a standard unix fork/exec issue, but # the library doesn't help us. my $result = $pipe->reader($self->argv()); open(STDERR, ">&", $savestderr); close($savestderr); # Long standing bug; the pipe needs to be marked non blocking. $result->blocking(0); $result; } # Map some instance variables to command line arguments that take # arguments. my %cmdline_valuemap = ( "base_port" => "-p", "max_ttl" => "-m", "queries" => "-q", "query_timeout" => "-w", "source_address" => "-s", "tos" => "-t", ); # Map more instance variables to command line arguments that are # flags. my %cmdline_flagmap = ( "no_fragment" => "-F", "use_icmp" => "-I", "use_tcp" => "-T" ); # Build a list of command line arguments sub _tr_cmd_args ($) { my $self = shift; my @result; push(@result, "-n"); my($key, $flag); while(($key, $flag) = each %cmdline_flagmap) { push(@result, $flag) if($self->$key());; } while(($key, $flag) = each %cmdline_valuemap) { my $val = $self->$key(); if(defined $val) { push(@result, $flag, $val); } } @result; } # Do the grunt work of parsing the output. sub _parse ($$) { my $self = shift; my $tr_output = shift; my $hopno; my $query; my $icmp_map; my $icmp_map_re; my $set_icmp_map = sub { $icmp_map = shift if(!defined($icmp_map));; $icmp_map_re = join("", keys(%{$icmp_map})); }; # This is a crufty hand coded parser that does its job well # enough. The approach of regular expressions without state is # far from perfect, but it gets the job done. line: foreach $_ (split(/\n/, $tr_output)) { # Some traceroutes appear to print informational line to stdout, # and we don't care. /^traceroute to / && next; # AIX 5L has to be different. /^trying to get / && next; /^source should be / && next; # NetBSD's traceroute emits info about path MTU discovery if # you want, don't know who else does this. /^message too big, trying new MTU = (\d+)/ && do { $self->pathmtu($1); next; }; # For now, discard MPLS label stack information emitted by # some vendor's traceroutes. Once I'm sure I'm sure I # understand the semantics offered by both the underlying MPLS # and whatever crazy limits the MPLS patch has, I can think # about an interface. My reading of the code is that you will # get the label stack of the last query. If this isn't # representative of all of the queries, it sucks to be you. # You can still get what you need, but it would be nice if the # tool didn't throw information away... # possibilities. /^\s+MPLS Label=(\d+) CoS=(\d) TTL=(\d+) S=(\d+)/ && next; # Cisco chatter. We use the "Type escape sequence..." line to # set the icmp_map to cisco. /^Type escape sequence to abort/ && do { &{$set_icmp_map}(\%icmp_map_cisco); next; }; /^Tracing the route to/ && next; # XXX there's one like this in the query loop, too. # Can we eliminate one? /^$/ && next; # Cisco marks ECMP paths very differently from LBL. LBL # outputs the changing addresses in one line, whereas cisco # will output a line with no hop count. # XXX we probably need to possibly match DNS in here. s/^\s{4}(\d+\.\d+\.\d+\.\d+ )/$1/ && goto query; s/^\s{4}([0-9a-fA-F:]*:[0-9a-fA-F]*(?:\.\d+\.\d+\.\d+)?)/$1/ && goto query; # Each line starts with the hopno (space padded to two characters) # and a space. s/^ ?([0-9 ][0-9]) // || die "Can't find hop number in output: $_"; $hopno = $1 + 0; $query = 1; my $addr; my $time; my $last_token; query: while($_) { # dns name and address; rewrite as just an address # XXX should keep dns name s/^ ?[-A-Za-z0-9.]+ \((\d+\.\d+\.\d+\.\d+)\)/$1/; s/^ ?[-A-Za-z0-9.]+ \(([0-9a-fA-F:]*:[0-9a-fA-F]*(?:\.\d+\.\d+\.\d+)?)\)/$1/; # ip address of a response s/^ ?(\d+\.\d+\.\d+\.\d+)// && do { $last_token = token_addr; $addr = $1; &{$set_icmp_map}(\%icmp_map_v4); next query; }; # ipv6 address of a response. This regexp is sleazy. s/^ ?([0-9a-fA-F:]*:[0-9a-fA-F]*(?:\.\d+\.\d+\.\d+)?)// && do { $last_token = token_addr; $addr = $1; &{$set_icmp_map}(\%icmp_map_v6); next query; }; # Redhat FC5 traceroute does this; it's redundant. s/^ \((\d+\.\d+\.\d+\.\d+)\)// && next query; # round trip time of query s/^ ? ?([0-9.]+) ms(?:ec)?// && do { $last_token = token_time; $time = $1 + 0; $self->_add_hop_query($hopno, $query, TRACEROUTE_OK, $addr, $time); $query++; next query; }; # query timed out s/^ +\*// && do { $last_token = token_time; $self->_add_hop_query($hopno, $query, TRACEROUTE_TIMEOUT, inet_ntoa(INADDR_NONE), 0); $query++; next query; }; # extra information from the probe (random ICMP info # and such). # There was a bug in this regexp prior to 1.09; reorder # the clauses and everything gets better. # Note that this is actually a very subtle DWIM on perl's # part: in "pure" regular expression theory, order of # expression doesn't matter; the resultant DFA has no # order concept. Without perl DWIMing on our regexp, we'd # write the regexp and code to perform a token lookahead: # the transitions after ! would be < for digits, the keys # of icmp map, and finally whitespace or end of string # indicate a lone "!". s/^ (!<\d+>|\?|![$icmp_map_re]?) ?// && do { my $flag = $1; # If the prior token was a time sample, it incremented # query. Undo that locally. my $lquery = $query; $lquery-- if(defined($last_token) && $last_token == token_time); my $stat; if($flag =~ /^!<\d>$/) { $stat = TRACEROUTE_UNKNOWN; } elsif($flag =~ /^!$/) { $stat = $icmp_map->{"!"}; } elsif($flag =~ /^!([$icmp_map_re])$/) { my $icmp = $1; # Shouldn't happen die "Unable to parse traceroute output (flag $icmp)!" unless(defined($icmp_map->{$icmp})); $stat = $icmp_map->{$icmp}; } elsif($flag eq "?") { # Cisco does this. $stat = TRACEROUTE_UNKNOWN; } else { die "unrecognized flag: $flag"; } if(defined($last_token) && ($last_token == token_time)) { $self->_change_hop_query_stat($hopno, $lquery, $stat); } else { $self->_add_hop_query($hopno, $lquery, $stat, $addr, 0); $query++; } $last_token = token_flag; next query; }; # Nothing left, next line. /^$/ && next line; # Cisco ASN data. # XXX we should keep this. s/^ \[AS \d+\]// && next query; s/ \[MPLS: Label \d+ Exp \d+\]// && next query; s, \[MPLS: Labels \d+(?:/\d+)* Exp \d+\],, && next query; # Some LBL derived traceroutes print ttl stuff s/^ \(ttl ?= ?\d+!\)// && next query; die "Unable to parse traceroute output: $_"; } } } sub _zero_text_accumulator ($) { my $self = shift; my $elem = "text"; $self->{$elem} = ""; } # Hop stuff sub _zero_hops ($) { my $self = shift; delete $self->{"hops"}; } sub _add_hop_query ($$$$$$) { my $self = shift; my $hop = (shift) - 1; my $query = (shift) - 1; my $stat = shift; my $host = shift; my $time = shift; $self->{"hops"}->[$hop]->[$query] = [ $stat, $host, $time ]; } sub _change_hop_query_stat ($$$$) { my $self = shift; # Zero base these my $hop = (shift) - 1; my $query = (shift) - 1; my $stat = shift; $self->{"hops"}->[$hop]->[$query]->[ query_stat_offset ] = $stat; } sub _query_accessor_common ($$$) { my $self = shift; # Zero base these my $hop = (shift) - 1; my $query = (shift) - 1; my $which_one = shift; # Deal with wildcard if($query == -1) { my $query_stat; my $aref; query: foreach $aref (@{$self->{"hops"}->[$hop]}) { $query_stat = $aref->[query_stat_offset]; $query_stat == TRACEROUTE_TIMEOUT && do { next query }; $query_stat == TRACEROUTE_UNKNOWN && do { next query }; do { return $aref->[$which_one] }; } return undef; } else { $self->{"hops"}->[$hop]->[$query]->[$which_one]; } } sub debug_print ($$$;@) { my $self = shift; my $level = shift; my $fmtstring = shift; return unless $self->debug() >= $level; my($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require) = caller(0); my $caller_line = $line; my $caller_name = $subroutine; my $caller_file = $filename; my $string = sprintf($fmtstring, @_); my $caller = "${caller_file}:${caller_name}:${caller_line}"; print STDERR "$caller: $string"; } 1; __END__ =head1 NAME Net::Traceroute - traceroute(1) functionality in perl =head1 SYNOPSIS use Net::Traceroute; $tr = Net::Traceroute->new(host => "life.ai.mit.edu"); if($tr->found) { my $hops = $tr->hops; if($hops > 1) { print "Router was " . $tr->hop_query_host($tr->hops - 1, 0) . "\n"; } } =head1 DESCRIPTION This module implements a parser for various traceroute implementations. At present, it can parse most LBL traceroute derivatives used on typical unixes, and the traceroute of cisco IOS. Traceroutes known not to be supported include that of Microsoft Windows and HP-UX. This module has two basic modes of operation, one, where it will run traceroute for you, and the other where you provide text from previously runing traceroute to parse. =head1 OVERVIEW A new Net::Traceroute object must be created with the I method. Depending on exactly how the constructor is invoked, it may perform some tracing and/or parsing actions immediately, or it may return a "template" object that can be used to set parameters for several subsequent traceroutes. Methods are available for accessing information about a given traceroute attempt. There are also methods that view/modify the options that are passed to the object's constructor. To trace a route, UDP packets are sent with a small TTL (time-to-live) field in an attempt to get intervening routers to generate ICMP TIME_EXCEEDED messages. =head1 CONSTRUCTOR AND CLONING $obj = Net::Traceroute->new([base_port => $base_port,] [debug => $debuglvl,] [max_ttl => $max_ttl,] [host => $host,] [text => $text,] [queries => $queries,] [query_timeout => $query_timeout,] [timeout => $timeout,] [source_address => $srcaddr,] [tos => $tos,] [packetlen => $packetlen,] [trace_program => $program,] [no_fragment => $nofrag,] [use_icmp => $useicmp,] [use_tcp => $usetcp,] ); $frob = $obj->clone([options]); This is the constructor for a new Net::Traceroute object. If given C, it will immediately perform the traceroute. If given C, it will parse that text as traceroute output. Given an existing Net::Traceroute object $obj as a template, you can call $obj->clone() with the usual constructor parameters. The same rules apply about defining host; that is, traceroute will be run if it is defined, or text will be parsed. You can always pass C undef, text => undef> to clone. Possible options are: B - A host to traceroute to. If you don't set this, you get a Traceroute object with no traceroute data in it. The module always uses IP addresses internally and will attempt to lookup host names via inet_aton. B - Output from a previously run traceroute. If set, and host isn't, the given text will be parsed. B - Base port number to use for the UDP queries. Traceroute assumes that nothing is listening to port C to C where nhops is the number of hops required to reach the destination address. Default is what the system traceroute uses (normally 33434). C's C<-p> option. B - A number indicating how verbose debug information should be. Please include debug=>9 output in bug reports. B - Maximum number of hops to try before giving up. Default is what the system traceroute uses (normally 30). C's C<-m> option. B - Number of times to send a query for a given hop. Defaults to whatever the system traceroute uses (3 for most traceroutes). C's C<-q> option. B - How many seconds to wait for a response to each query sent. Uses the system traceroute's default value of 5 if unspecified. C's C<-w> option. B - Maximum time, in seconds, to wait for the traceroute to complete. If not specified, the traceroute will not return until the host has been reached, or traceroute counts to infinity (C * C * C). Note that this option is implemented by Net::Traceroute, not the underlying traceroute command. B - Select the source address that traceroute wil use. B - Specify a ToS value for traceroute to use. B - Length of packets to use. Traceroute tries to make the IP packet exactly this long. B - Name of the traceroute program. Defaults to traceroute. You can pass traceroute6 to do IPv6 traceroutes. B - Set the IP don't fragment bit. Some traceroute programs will perform path mtu discovery with this option. B - Request that traceroute perform probes with ICMP echo packets, rather than UDP. B - Request that traceoute perform probes with TCP SYNs. =head1 METHODS =over 4 =item traceroute Run system traceroute, and parse the results. Will fill in the rest of the object for informational queries. =item parse Parse the previously provided C, filling in the rest of the object for queries. =item argv Returns a list of arguments that traceroute will be invoked with. For debugging and/or overriding by subclasses. =back =head2 Controlling traceroute invocation Each of these methods return the current value of the option specified by the corresponding constructor option. They will set the object's instance variable to the given value if one is provided. Changing an instance variable will only affect newly performed traceroutes. Setting a different value on a traceroute object that has already performed a trace has no effect. See the constructor documentation for information about methods that aren't documented here. =over 4 =item base_port([PORT]) =item max_ttl([PORT]) =item queries([QUERIES]) =item query_timeout([TIMEOUT]) =item host([HOST]) =item text([TEXT]) =item timeout([TIMEOUT]) =item source_address([SRC]) =item packetlen([LEN]) =item trace_program([PROGRAM]) =item no_fragment([PROGRAM]) =back =head2 Obtaining information about a Trace These methods return information about a traceroute that has already been performed. Any of the methods in this section that return a count of something or want an Ith type count to identify something employ one based counting. =over 4 =item stat Returns the status of a given traceroute object. One of TRACEROUTE_OK, TRACEROUTE_TIMEOUT, or TRACEROUTE_UNKNOWN (each defined as an integer). TRACEROUTE_OK will only be returned if the host was actually reachable. =item found Attempt to return 1 if the host was found, undef otherwise. This test is a poor heuristic, and will frequently give wrong answers. =item pathmtu If your traceroute supports MTU discovery, this method will return the MTU in some circumstances. You must set no_fragment, and must use a packetlen larger than the path mtu for this to be set. =item hops Returns the number of hops that it took to reach the host. =item hop_queries(HOP) Returns the number of queries that were sent for a given hop. This should normally be the same for every query. =item hop_query_stat(HOP, QUERY) Return the status of the given HOP's QUERY. The return status can be one of the following (each of these is actually an integer constant function defined in Net::Traceroute's export list): QUERY can be zero, in which case the first succesful query will be returned. =over 4 =item TRACEROUTE_OK Reached the host, no problems. =item TRACEROUTE_TIMEOUT This query timed out. =item TRACEROUTE_UNKNOWN Your guess is as good as mine. Shouldn't happen too often. =item TRACEROUTE_UNREACH_NET This hop returned an ICMP Network Unreachable. =item TRACEROUTE_UNREACH_HOST This hop returned an ICMP Host Unreachable. =item TRACEROUTE_UNREACH_PROTO This hop returned an ICMP Protocol unreachable. =item TRACEROUTE_UNREACH_PORT Use in cisco and traceroute6 parsing. In cisco, "!U", in traceroute6, a "!". =item TRACEROUTE_UNREACH_ADDR This hop returned an ICMP6 address unreachable. =item TRACEROUTE_UNREACH_NEEDFRAG Indicates that you can't reach this host without fragmenting your packet further. Shouldn't happen in regular use. =item TRACEROUTE_UNREACH_SRCFAIL A source routed packet was rejected for some reason. Shouldn't happen. =item TRACEROUTE_UNREACH_FILTER_PROHIB A firewall or similar device has decreed that your traffic is disallowed by administrative action. Suspect sheer, raving paranoia. =item TRACEROUTE_BSDBUG The destination machine appears to exhibit the 4.[23]BSD time exceeded bug. =item TRACEROUTE_SOURCE_QUENCH Some machine has generated an ICMP Source Quench message, asking you to slow down. =item TRACEROUTE_INTERRUPTED "User interrupted test". Cisco's traceroute does this. Its unclear how to produce it. =back =item hop_query_host(HOP, QUERY) Return the dotted quad IP address of the host that responded to HOP's QUERY. QUERY can be zero, in which case the first succesful query will be returned. =item hop_query_time(HOP, QUERY) Return the round trip time associated with the given HOP's query. If your system's traceroute supports fractional second timing, so will Net::Traceroute. QUERY can be zero, in which case the first succesful query will be returned. =back =head1 CLONING SUPPORT BEFORE 1.04 Net::Traceroute Versions before 1.04 used new to clone objects. This has been deprecated in favor of the clone() method. If you have code of the form: my $template = Net::Traceroute->new(); my $tr = $template->new(host => "localhost"); You need to change the $template->new to $template->clone. This behavior was changed because it interfered with subclassing. =head1 BUGS Net::Traceroute parses the output of the system traceroute command. As such, it may not work on your system. Support for more traceroute outputs (e.g. Windows, HPUX) could be done, although currently the code assumes there is "One true traceroute". The actual functionality of traceroute could also be implemented natively in perl or linked in from a C library. Versions prior to 1.04 had some interface issues for subclassing. These issues have been addressed, but required a public interface change. If you were relying on the behavior of new to clone existing objects, your code needs to be fixed. =head1 SEE ALSO traceroute(1) =head1 AUTHOR Daniel Hagerty =head1 COPYRIGHT Copyright 1998, 1999 Massachusetts Institute of Technology Copyright 2000, 2001 Daniel Hagerty Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that both that copyright notice and this permission notice appear in supporting documentation, and that the name of M.I.T. not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. M.I.T. makes no representations about the suitability of this software for any purpose. It is provided "as is" without express or implied warranty. =cut Net-Traceroute-1.15/ChangeLog000644 074445 000000 00000012371 12314114737 015765 0ustar00hagwheel000000 000000 2014-03-24 Daniel Hagerty * Traceroute.pm: ** Bump to version 1.15 for release. ** Fix parsing of names when traceroute has been used w/o -n, reported by Graham Ollis. 2012-08-08 Daniel Hagerty * Traceroute.pm: ** Bump to version 1.14 for release. 2012-08-04 Daniel Hagerty * Traceroute.pm: ** Integrate patches from Gerald HERMANT : *** Pass -t, -T to traceroute via tos, use_tcp (respectively) options. *** argv: new public routine, capturing traceroute argument calculation. 2011-02-19 Daniel Hagerty * Traceroute.pm: ** Integrate cisco IOS support: *** Add a few status codes. *** Keep track of which chunk of traceroute input was most recently seen for parsing purposes. *** Lots of regexp tweaks. *** Doc changes. ** Random documentation updates. ** Use anonymous filehanles when suitable. ** Bump to version 1.13 for release. * t/4*.t: ** New cisco tests. 2011-02-18 Daniel Hagerty * Traceroute.pm: ** Improve some error messages. ** Cleanup mess from icmp_map doing v4 and v6 together. 2011-02-16 Daniel Hagerty * Traceroute.pm: ** Convert operations involving $& to s//. $& is considered harmful. ** Select the translation between !A-type icmp flags based on what we're parsing, rather than assuming all is LBL ipv4. * t/33-parse-6flags.t ** Unmark TODO tests; they pass now thanks to above. 2011-02-06 Daniel Hagerty * t/21-parse-4timeouts.t: ** More test cases, especially targetting an issue seen on cisco development branch. * t/33-parse-6flags.t ** New test. 2011-02-05 Daniel Hagerty * t/95-sys-traceroute.t: ** Specifically search for a traceroute executable on the system. If we can't find one, skip the test in an obvious way. * Renamed: ** t/50-parse-6basic.t -> t/30-parse-6basic.t ** t/60-parse-6wierd.t -> t/34-parse-6wierd.t 2011-01-02 Daniel Hagerty * Traceroute.pm: ** Bump version number for release. 2010-12-31 Daniel Hagerty * t/95-sys-traceroute.t: ** New file: Recreate our original test.pl's most useful test. 2010-12-29 Daniel Hagerty * Traceroute.pm: ** Prevent waitpid() on pipe close. * t/waitroute: ** Unbuffer output. * t/80-tracelie.t, t/81-timeout.t: ** Explicitly use "." in paths to test helper programs. * t/81-timeout.t: ** Unmark TODO test; fixed by above. * Makefile.PL: ** Re-enable installing on windows. 2010-12-13 Daniel Hagerty * Traceroute.pm: ** Use a better (but still sleazy) IPv6 regexp. * t/60-parse-6wierd.t ** Actually parse the traceroute. ** Remove TODO markers. ** Fix bug in data from hand editing. 2010-12-12 Daniel Hagerty * t/*.t: ** New testing code. * t/testlib.pl: ** Shared code for *.t files. * t/tracelie: ** Provides a static traceroute for a fixture. * t/waitroute: ** Provides a static traceroute and causes a timeout for another fixture. * test.pl: ** Removed; superseded by new test code. 2010-10-31 Daniel Hagerty * Traceroute.pm: ** Rename some text_accumulator related names, exposing it to the user. ** Document how the text interface works. 2007-01-09 Daniel Hagerty * Traceroute.pm: ** Version number bump. ** Add fix for Redhat FC5's newest random patches from Keven Nolish. ** Fix for timeout problems: *** Use sysread, not read. *** Remove call to eof immediately after pipe creation -- plays badly with nonblocking & sysread. Check performed elsehow. 2006-11-04 Daniel Hagerty * Traceroute.pm: ** Start towards fixing timeout issues -- mark socket non-blocking (duh); actually accumulate text rather than smashing the buffer. 2005-07-09 Daniel Hagerty * Traceroute.pm: ** Fix regexp bug in how numeric icmp output codes were handled. ** Document use_icmp. * TODO: update for current issues 2005-07-07 Daniel Hagerty * Traceroute.pm: ** Add request use_icmp option (needs documentation). ** Skip MPLS label stack information (for now). ** Bump version for next release. 2004-05-24 Daniel Hagerty * Traceroute.pm: ** Update parser to deal with traceroute on current linux. Apparently some bozo thought some extra spacing here and there would be cute. ** Version bump to 1.08. * TODO: ** New file. 2000-11-17 Daniel Hagerty * Traceroute.pm: ** Added a default value to debug instance variable, to avoid perl warning ** Incremented version number to 1.03. * test.pl: ** Turned on perl warnings. 2000-08-15 Daniel Hagerty * Traceroute.pm: ** Added error checking around our use of IO::Pipe. ** Incremented version number for release 1999-11-28 Daniel Hagerty * First ChangeLog entry. * Traceroute.pm: ** Bumped version to 1.01 ** Changed Net::Inet to Socket. Only needed inet_aton and inet_ntoa. ** host(): Wrapped inet_aton in an eval. * test.pl: Rewrote test 3 to be slightly more general, as too many operating systems have restrictions on what you can trace to. Ask user if test is difficult. Net-Traceroute-1.15/Makefile.PL000644 074445 000000 00000002127 11600523143 016153 0ustar00hagwheel000000 000000 ### # Copyright 1998, 1999 Massachusetts Institute of Technology # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. ### # File: Makefile.PL # Author: Daniel Hagerty, hag@ai.mit.edu # Date: Wed Mar 25 00:22:43 1998 # Description: perl style Makefile for this frob use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Net::Traceroute', VERSION_FROM => "Traceroute.pm", PREREQ_PM => { qw(Time::HiRes) => 0, }, 'dist' => {COMPRESS => 'gzip -9f', SUFFIX => '.gz', DIST_DEFAULT => 'all tardist', }, ); Net-Traceroute-1.15/t/000755 074445 000000 00000000000 12314116247 014450 5ustar00hagwheel000000 000000 Net-Traceroute-1.15/README000644 074445 000000 00000001433 12010505711 015055 0ustar00hagwheel000000 000000 This is version 1.14 of Net::Traceroute. Users upgrading from before version 1.04, please note that there has been an interface change. Your program may not work. Please see "CLONING SUPPORT BEFORE 1.04" in the pod documentation. This release adds support for a few flags in newer traceroutes. Net::Traceroute is available from CPAN and my home page. My CPAN area is authors/id/H/HA/HAG, and my home page is currently http://www.linnaean.org/~hag/ . I hope you find the module useful. Daniel Hagerty hag@linnaean.org Example: use Net::Traceroute; $tr = Net::Traceroute->new(host => "life.ai.mit.edu"); if($tr->found) { my $hops = $tr->hops; if($hops == 1) { print "Same subnet\n"; } else { print "Last router is " . $tr->hop_query_host($hops - 1, 0) . "\n"; } } Net-Traceroute-1.15/META.yml000644 074445 000000 00000000676 12314116247 015467 0ustar00hagwheel000000 000000 --- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-Traceroute no_index: directory: - t - inc requires: Time::HiRes: 0 version: 1.15 Net-Traceroute-1.15/t/41-parse-cisco-4timeouts.t000755 074445 000000 00000003054 11600523144 021222 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Basic tests of ipv4 traceroute on a cisco. use Socket; use Test::More tests => 11; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_stat(3, 1), TRACEROUTE_TIMEOUT, "Hop 3, query 1 is a timeout"); is($tr->hop_query_stat(3, 2), TRACEROUTE_TIMEOUT, "Hop 3, query 2 is a timeout"); is($tr->hop_query_stat(3, 3), TRACEROUTE_TIMEOUT, "Hop 3, query 3 is a timeout"); ok(!defined($tr->hop_query_stat(3, 0)), "Hop 3, query 0 is undefined"); is($tr->hop_query_stat(5, 1), TRACEROUTE_TIMEOUT, "Hop 5, query 1 is a timeout"); is($tr->hop_query_host(5, 1), inet_ntoa(INADDR_NONE), "Hop 5, query 1 is INADDR_NONE"); is($tr->hop_query_stat(5, 2), TRACEROUTE_OK, "Hop 5, query 2 is OK"); is($tr->hop_query_host(5, 0), "206.223.119.120", "Hop 5, query 0 is 206.223.119.120"); is($tr->hop_query_host(5, 2), "206.223.119.120", "Hop 5, query 2 is 206.223.119.120"); is($tr->hop_query_time(5, 2), 252, "Hop 5, query 2 has correct time"); is($tr->hop_query_stat(5, 3), TRACEROUTE_TIMEOUT, "Hop 5, query 3 is a timeout"); __END__ Type escape sequence to abort. Tracing the route to 128.52.32.80 1 10.12.0.1 0 msec 0 msec 0 msec 2 66.92.73.1 24 msec 24 msec 24 msec 3 * * * 4 69.17.87.24 44 msec 48 msec 48 msec 5 * 206.223.119.120 252 msec * 6 207.210.142.17 80 msec 224 msec 172 msec 7 207.210.142.234 72 msec 72 msec 68 msec 8 18.168.0.23 72 msec 68 msec 72 msec 9 18.4.7.65 72 msec 72 msec 72 msec 10 128.30.0.254 72 msec 68 msec 72 msec 11 128.52.32.80 72 msec 72 msec 68 msec Net-Traceroute-1.15/t/00-basics.t000755 074445 000000 00000001321 11600523144 016311 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Primitive tests, where if these fail, lots of others will too. use strict; use warnings; use Test::More tests => 7; BEGIN { use_ok( "Net::Traceroute" ); } my $tr = Net::Traceroute->new(trace_program => "foo"); isa_ok($tr, "Net::Traceroute", "new isa Net::Traceroute"); is($tr->trace_program(), "foo", "attributes set by new are gettable"); $tr->trace_program("tracefoob"); is($tr->trace_program(), "tracefoob", "setter followed by getter does so"); $tr->queries(3); my $clone = $tr->clone(queries => 2); is(ref($clone), ref($tr), "clone returns same type as clonee"); is($clone->trace_program(), "tracefoob", "cloned attributes copy"); is($clone->queries(), 2, "clone can override attributes"); Net-Traceroute-1.15/t/22-parse-4ecmp.t000755 074445 000000 00000003147 11600523144 017201 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Parse a traceroute with equal-cost, multipath hops in it. # More than one address will appear in a single line. use strict; use warnings; use Test::More tests => 9; use Socket; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_host(6, 1), "192.205.37.73", "Hop 6, query 1 is 192.205.37.73"); is($tr->hop_query_host(6, 2), "192.205.37.69", "Hop 6, query 2 is 192.205.37.69"); is($tr->hop_query_host(6, 3), "192.205.37.69", "Hop 6, query 1 is 192.205.37.69"); is($tr->hop_query_time(6, 1), 19.120, "Hop 6, query 1 time is correct"); is($tr->hop_query_time(6, 2), 21.108, "Hop 6, query 2 time is correct"); is($tr->hop_query_time(6, 3), 21.833, "Hop 6, query 3 time is correct"); is($tr->hop_query_host(11, 1), "12.130.0.170", "Hop 12, query 1 is 12.130.0.170"); is($tr->hop_query_host(11, 2), "12.130.0.174", "Hop 12, query 2 is 12.130.0.174"); is($tr->hop_query_host(11, 3), "12.130.0.170", "Hop 12, query 3 is 12.130.0.170"); __END__ 1 66.92.73.1 25.518 ms 21.853 ms 23.096 ms 2 69.17.83.201 44.478 ms 21.338 ms 21.118 ms 3 166.90.136.33 19.119 ms 20.112 ms 20.383 ms 4 4.68.97.30 25.262 ms 20.623 ms 19.634 ms 5 4.68.16.17 21.048 ms 22.342 ms 21.111 ms 6 192.205.37.73 19.120 ms 192.205.37.69 21.108 ms 21.833 ms 7 12.122.130.18 28.245 ms 26.277 ms 26.318 ms 8 12.122.31.126 28.174 ms 28.983 ms 27.037 ms 9 12.122.145.29 27.717 ms 26.768 ms 27.287 ms 10 12.122.254.14 28.717 ms 27.262 ms 26.585 ms 11 12.130.0.170 28.374 ms 12.130.0.174 26.768 ms 12.130.0.170 26.506 ms 12 12.130.9.196 27.715 ms 29.823 ms 29.365 ms Net-Traceroute-1.15/t/testlib.pl000644 074445 000000 00000001565 11600523144 016455 0ustar00hagwheel000000 000000 use strict; use warnings; # Library routines used in multiple tests. use Test::More; use Net::Traceroute; # parsetext(text) - return a Net::Traceroute object with the given # text already parsed. sub parsetext { my $text = shift; my $tr = Net::Traceroute->new(); $tr->text($text); $tr->parse(); return($tr); } # parsefh(filehandle) - slurp all text in from filehandle, and offer # it to parsetext above. Returns a Net::Traceroute object with the # text parsed. sub parsefh { my $fh = shift; my $text; { local $/ = undef; $text = <$fh>; } close($fh); parsetext($text); } # os_must_unixexec() - test requires the OS has a unix style exec. # Test must use Test::More::plan(). sub os_must_unixexec { my @oses = qw(MSWin32 cygwin); my %oses = map { $_ => 1, } @oses; plan skip_all => "OS unsupported" if(exists($oses{$^O})); } 1; Net-Traceroute-1.15/t/42-parse-cisco-4ecmp.t000755 074445 000000 00000002505 11600523144 020276 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Basic tests of ipv4 traceroute on a cisco. use Test::More tests => 6; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_host(8, 1), "4.69.145.13", "hop 8, query 1 host is as expected"); is($tr->hop_query_time(8, 1), 64, "hop 8, query 1 time is as expected"); is($tr->hop_query_host(8, 2), "4.69.145.141", "hop 8, query 2 host is as expected"); is($tr->hop_query_time(8, 2), 56, "hop 8, query 2 time is as expected"); is($tr->hop_query_host(8, 3), "4.69.145.77", "hop 8, query 3 host is as expected"); is($tr->hop_query_time(8, 3), 59, "hop 8, query 3 time is as expected"); __END__ Type escape sequence to abort. Tracing the route to 69.164.206.2 1 10.12.0.1 0 msec 4 msec 0 msec 2 66.92.73.1 24 msec 28 msec 24 msec 3 69.17.83.201 20 msec 24 msec 20 msec 4 166.90.136.33 24 msec 20 msec 24 msec 5 4.68.97.62 28 msec 24 msec 36 msec 6 4.69.148.37 24 msec 20 msec 24 msec 7 4.69.137.121 56 msec 56 msec 68 msec 8 4.69.145.13 64 msec 4.69.145.141 56 msec 4.69.145.77 59 msec 9 4.59.32.30 56 msec 56 msec 60 msec 10 70.87.253.10 56 msec 70.87.255.42 56 msec 70.87.253.26 56 msec 11 70.87.253.122 60 msec 70.87.255.122 60 msec * 12 70.87.255.86 56 msec 70.87.255.82 56 msec 60 msec 13 67.18.7.90 60 msec * 60 msec Net-Traceroute-1.15/t/waitroute000755 074445 000000 00000001210 11600523144 016406 0ustar00hagwheel000000 000000 #!/bin/sh # Output something that looks like a traceroute, but then wait for awhile. # Used for testing timeout code. cat <<_EOF_ 1 66.92.73.1 22.227 ms 24.444 ms 23.090 ms 2 69.17.83.201 18.365 ms 21.828 ms 20.156 ms 3 69.17.87.24 47.690 ms 46.479 ms 46.524 ms 4 206.223.119.120 56.538 ms 76.455 ms 59.301 ms 5 207.210.142.17 70.135 ms 69.110 ms 68.556 ms 6 207.210.142.234 68.756 ms 69.293 ms 68.872 ms 7 18.168.0.23 69.316 ms 71.269 ms 70.829 ms 8 18.4.7.65 69.758 ms 69.793 ms 69.594 ms 9 128.30.0.254 69.043 ms 68.092 ms 68.846 ms 10 128.52.32.80 71.539 ms 68.564 ms 69.101 ms _EOF_ sleep 5 Net-Traceroute-1.15/t/21-parse-4timeouts.t000755 074445 000000 00000003030 11600523144 020114 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Parse a traceroute that has a "*" in it. use strict; use warnings; use Test::More tests => 11; use Socket; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_stat(4, 1), TRACEROUTE_TIMEOUT, "Hop 4, query 1 is a timeout"); is($tr->hop_query_host(4, 1), inet_ntoa(INADDR_NONE), "Hop 4, query 1 is INADDR_NONE"); is($tr->hop_query_stat(4, 2), TRACEROUTE_OK, "Hop 4, query 2 is OK"); is($tr->hop_query_host(4, 0), "206.223.119.120", "Hop 4, query 0 is 206.223.119.120"); is($tr->hop_query_host(4, 2), "206.223.119.120", "Hop 4, query 2 is 206.223.119.120"); is($tr->hop_query_host(4, 3), "206.223.119.120", "Hop 4, query 3 is 206.223.119.120"); is($tr->hop_query_time(4, 2), 262.151, "Hop 4, query 2 time is correct"); is($tr->hop_query_stat(9, 1), TRACEROUTE_TIMEOUT, "Hop 9, query 1 is a timeout"); is($tr->hop_query_stat(9, 2), TRACEROUTE_TIMEOUT, "Hop 9, query 2 is a timeout"); is($tr->hop_query_stat(9, 3), TRACEROUTE_TIMEOUT, "Hop 9, query 3 is a timeout"); ok(!defined($tr->hop_query_stat(9, 0)), , "Hop 9, query 0 is undefined"); __END__ 1 66.92.73.1 29.216 ms 34.777 ms 23.062 ms 2 69.17.83.201 19.124 ms 22.092 ms 19.860 ms 3 69.17.87.24 44.491 ms 45.501 ms 46.231 ms 4 * 206.223.119.120 262.151 ms 290.742 ms 5 207.210.142.17 69.503 ms 68.633 ms 67.422 ms 6 207.210.142.234 68.889 ms 68.660 ms 69.356 ms 7 18.168.0.23 99.719 ms 71.103 ms 71.472 ms 8 18.4.7.65 67.981 ms 67.483 ms 69.992 ms 9 * * * 10 128.52.32.80 70.139 ms 68.373 ms 68.695 ms Net-Traceroute-1.15/t/45-parse-cisco-6basic.t000755 074445 000000 00000002030 11600523144 020431 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Basic tests of ipv6 traceroute on a cisco. use Test::More tests => 24; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); my @addrs = qw( 2001:470:8917:9:2D0:B7FF:FE5E:7F36 2001:470:1F06:177::1 2001:470:0:5D::1 2001:470:0:36::1 2001:470:0:59::2 2610:178:1:1:207:E9FF:FE5D:8335 ); my $hop = 1; foreach my $addr (@addrs) { is($tr->hop_queries($hop), 3, "Hop $hop has 3 queries"); for(my $query = 1; $query <= 3; $query++) { is($tr->hop_query_host($hop, $query), $addr, "Hop $hop query $query host is $addr"); } $hop++; } __END__ Type escape sequence to abort. Tracing the route to 2610:178:1:1:207:E9FF:FE5D:8335 1 2001:470:8917:9:2D0:B7FF:FE5E:7F36 4 msec 0 msec 4 msec 2 2001:470:1F06:177::1 24 msec 24 msec 28 msec 3 2001:470:0:5D::1 20 msec 24 msec 20 msec 4 2001:470:0:36::1 28 msec 28 msec 32 msec 5 2001:470:0:59::2 28 msec 32 msec 28 msec 6 2610:178:1:1:207:E9FF:FE5D:8335 28 msec 28 msec 32 msec Net-Traceroute-1.15/t/81-timeout.t000755 074445 000000 00000001154 11600523144 016550 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Test the timeout functionality of the pipe interface. # Uses a helper that spews traceroute output, but then waits. use strict; use warnings; use Test::More; use Net::Traceroute; use Time::HiRes qw(time); require "t/testlib.pl"; os_must_unixexec(); plan tests => 2; my $start = time(); my $tr = Net::Traceroute->new( trace_program => "./t/waitroute", host => "128.52.32.80", timeout => 2, ); my $end = time(); my $delta = $end - $start; TODO: { todo_skip "Test borked", 1; is($tr->stat(), TRACEROUTE_TIMEOUT, "Stat is TIMEOUT"); } ok($delta < 3, "elapsed time $delta < 3"); Net-Traceroute-1.15/t/46-parse-cisco-6timeouts.t000755 074445 000000 00000003212 11600523144 021225 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Test timeouts for cisco ipv6 traceroute. use Test::More tests => 15; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_queries(2), 3, "Hop 2 has 3 queries"); foreach my $query (1..3) { is($tr->hop_query_stat(2, $query), TRACEROUTE_TIMEOUT, "Hop 2, query $query stat is TRACEROUTE_TIMEOUT"); is($tr->hop_query_host(2, $query), "255.255.255.255", "Hop 2, query $query host is 255.255.255.255"); } is($tr->hop_queries(3), 3, "Hop 3 has 3 queries"); is($tr->hop_query_stat(3, 1), TRACEROUTE_TIMEOUT, "Hop 3, query 1 stat is TRACEROUTE_TIMEOUT"); is($tr->hop_query_host(3, 1), "255.255.255.255", "Hop 3, query 1 host is 255.255.255.255"); is($tr->hop_query_stat(3, 2), TRACEROUTE_TIMEOUT, "Hop 3, query 2 stat is TRACEROUTE_TIMEOUT"); is($tr->hop_query_host(3, 2), "255.255.255.255", "Hop 3, query 2 host is 255.255.255.255"); is($tr->hop_query_stat(3, 3), TRACEROUTE_OK, "Hop 3, query 3 stat is TRACEROUTE_OK"); is($tr->hop_query_host(3, 3), "2001:470:0:5D::1", "Hop 3, query 3 host is 2001:470:0:5D::1"); is($tr->hop_query_time(3, 3), 28, "Hop 3, query 3 time is 28 msec"); __END__ Type escape sequence to abort. Tracing the route to 2001:4F8:0:2::D 1 2001:470:8917:9:2D0:B7FF:FE5E:7F36 4 msec 0 msec 4 msec 2 * * * 3 * * 2001:470:0:5D::1 28 msec 4 2001:470:0:36::1 28 msec 44 msec 36 msec 5 2001:470:0:1B5::2 40 msec 40 msec 44 msec 6 2001:470:0:CE::2 44 msec 44 msec 40 msec 7 2001:500:61:6::1 44 msec 40 msec 44 msec 8 2001:4F8:0:1::49:1 104 msec 124 msec 100 msec 9 2001:4F8:0:2::D 100 msec 112 msec 120 msec Net-Traceroute-1.15/t/95-sys-traceroute.t000755 074445 000000 00000003572 11600523144 020066 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Attempt some traceroutes using the system traceroute. They aren't # all guaranteed to work, since OS issues, parsability of traceroute, # and network configuration all interact with this test, and we # frequently can't predict the issues. use strict; use warnings; use Test::More; use Net::Traceroute; use Socket; use Sys::Hostname; require "t/testlib.pl"; os_must_unixexec(); #### # Probe PATH, plus some well known locations, for a traceroute # program. skip_all this test if we can't find one. my @path = split(":", $ENV{PATH}); my $has_traceroute; foreach my $component (@path) { if(-x "$component/traceroute") { $has_traceroute = 1; last; } } if(!defined($has_traceroute)) { # Check for traceroute in /usr/sbin or /sbin. The check is # redundant if PATH already contains one of them, but it won't hurt. foreach my $component ("/usr/sbin", "/sbin") { if(-x "$component/traceroute") { $ENV{PATH} .= join(":", @path, $component); goto runtest; } } plan skip_all => "Cannot find a traceroute executable"; } runtest: plan tests => 2; #### # Get this sytem's hostname, and traceroute to it. Don't bother # trying localhost; its quirky on systems like netbsd. my $name = hostname(); # Wrinkle: while our specification is that we will use whatever # traceroute is in path, it's pretty common for testing to be done # where there is no traceroute in path (especially automated testers). my $tr1 = eval { Net::Traceroute->new(host => $name, timeout => 30) }; if($@) { die unless(exists($ENV{AUTOMATED_TESTING})); # If we're in an automated tester, rerun with debug => 9 so we get # a better clue of what's going wrong. $tr1 = Net::Traceroute->new(host => $name, timeout => 30, debug => 9); } my $packed_addr = inet_aton($name); my $addr = inet_ntoa($packed_addr); is($tr1->hops, 1); is($tr1->hop_query_host(1, 0), $addr); Net-Traceroute-1.15/t/07-subclassing.t000755 074445 000000 00000001430 11600523144 017372 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Test that subclassing works package main; use strict; use warnings; use Test::More tests => 2; use Net::Traceroute; package Net::Traceroute::Subclass; use base qw(Net::Traceroute); # This subclass lets Net::Traceroute allocate the ref. sub new { my $type = shift; return $type->SUPER::new(@_); } package Net::Traceroute::SubclassAlloc; use base qw(Net::Traceroute); # This subclass allocates its own ref. sub new { my $type = shift; my $self = bless {}, $type; return $self->SUPER::new(@_); } package main; isa_ok(Net::Traceroute::SubclassAlloc->new(), "Net::Traceroute::SubclassAlloc", "SubclassAlloc returns a SubclassAlloc"); isa_ok(Net::Traceroute::Subclass->new(), "Net::Traceroute::Subclass", "Subclass returns a Subclass"); Net-Traceroute-1.15/t/tracelie000755 074445 000000 00000001271 11600523144 016162 0ustar00hagwheel000000 000000 #!/bin/sh # Helper for the pipe stuff. Not nearly as thorough as it could be, # as the real traceroute has very bursty output that has triggered # read bugs in the dark past. cat <<_EOF_ 1 66.92.73.1 22.227 ms 24.444 ms 23.090 ms 2 69.17.83.201 18.365 ms 21.828 ms 20.156 ms 3 69.17.87.24 47.690 ms 46.479 ms 46.524 ms 4 206.223.119.120 56.538 ms 76.455 ms 59.301 ms 5 207.210.142.17 70.135 ms 69.110 ms 68.556 ms 6 207.210.142.234 68.756 ms 69.293 ms 68.872 ms 7 18.168.0.23 69.316 ms 71.269 ms 70.829 ms 8 18.4.7.65 69.758 ms 69.793 ms 69.594 ms 9 128.30.0.254 69.043 ms 68.092 ms 68.846 ms 10 128.52.32.80 71.539 ms 68.564 ms 69.101 ms _EOF_ Net-Traceroute-1.15/t/05-backend.t000755 074445 000000 00000001752 11600523144 016451 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Ensure that the backend argument to new performs as expected. # This is a promised interface for other traceroute backends. use strict; use warnings; use Test::More tests => 4; use Net::Traceroute; # Will be set in our test backend to ensure that the code really # executed. our $really_used; package Net::Traceroute::TestBackend; use base qw(Net::Traceroute); sub new { $main::really_used = 1; bless {}, "Net::Traceroute::TestBackend"; } package Net::Traceroute::BrokenBackend; use base qw(Net::Traceroute); package main; my $tr = Net::Traceroute->new(backend => "TestBackend"); isa_ok($tr, "Net::Traceroute::TestBackend", "Net::Traceroute returned our test backend"); is($really_used, 1, "constructor set our 'used' variable"); eval { Net::Traceroute->new(backend => "BrokenBackend"); }; ok(defined($@), "broken backend died"); my $trp = Net::Traceroute->new(backend => "Parser"); is(ref($trp), "Net::Traceroute", "backend => Parser gets a Net::Traceroute"); Net-Traceroute-1.15/t/40-parse-cisco-4basic.t000755 074445 000000 00000002211 11600523144 020423 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Basic tests of ipv4 traceroute on a cisco. use Test::More tests => 12; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hops(), 8, "has eight hops"); is($tr->hop_queries(1), 3, "hop 1 has 3 queries"); foreach my $q (1..3) { is($tr->hop_query_host(1, $q), "10.12.0.1", "hop 1, query $q is 10.12.0.1"); is($tr->hop_query_stat(1, $q), TRACEROUTE_OK, "hop 1, query $q is TRACEROUTE_OK"); } is($tr->hop_query_time(6, 1), 36, "correct time for hop 6, query 1"); is($tr->hop_query_time(6, 2), 32, "correct time for hop 6, query 2"); is($tr->hop_query_time(6, 3), 28, "correct time for hop 6, query 3"); is($tr->hop_query_host(8, 1), "192.148.252.10", "hop 8 is 192.148.252.10"); __END__ Type escape sequence to abort. Tracing the route to 192.148.252.10 1 10.12.0.1 0 msec 0 msec 0 msec 2 66.92.73.1 24 msec 24 msec 20 msec 3 69.17.83.201 24 msec 20 msec 20 msec 4 198.32.160.61 24 msec 24 msec 24 msec 5 72.52.92.45 20 msec 24 msec 24 msec 6 72.52.92.86 36 msec 32 msec 28 msec 7 64.71.128.254 28 msec 28 msec 32 msec 8 192.148.252.10 24 msec 28 msec 24 msec Net-Traceroute-1.15/t/34-parse-6wierd.t000755 074445 000000 00000003171 11600523144 017371 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Parse a traceroute full of wierd ipv6 addresses to stress the cheezy # v6 address parser. You will not see most of these addresses in a # traceroute, but seems better safe than sorry. use strict; use warnings; use Test::More tests => 9; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_host(1, 1), "2002:c058:6301::1", "hop 1, boring address"); is($tr->hop_query_host(2, 1), "::1", "hop 2, localhost"); is($tr->hop_query_host(3, 1), "2::", "hop 3, leading bytes only"); is($tr->hop_query_host(4, 1), "::", "hop 4, in6addr_any"); is($tr->hop_query_host(5, 1), "::ffff:1.2.3.4", "hop 5, v4 mapped"); is($tr->hop_query_host(6, 1), "::1.2.3.4", "hop 6, v4 mapped"); is($tr->hop_query_host(7, 1), "dead:beef:8917:cafe:d00d:f00f:feed:f00b", "hop 7, fully expanded"); is($tr->hop_query_host(8, 1), "dead:beef:8917:cafe:d00d:f00f:10.7.91.152", "hop 8, expanded and v4 mapped"); is($tr->hop_query_host(9, 1), "2001:4860:b009::93", "hop 9, vanilla"); __END__ 1 2002:c058:6301::1 22.54 ms 22.481 ms 22.095 ms 2 ::1 20.808 ms 23.063 ms 22.834 ms 3 2:: 24.019 ms 21.704 ms 21.923 ms 4 :: 23.767 ms 2001:4860::1:0:755 23.029 ms 2001:4860::1:0:3be 23.817 ms 5 ::ffff:1.2.3.4 30.173 ms 28.244 ms 2001:4860::1:0:5dc 29.486 ms 6 ::1.2.3.4 40.747 ms 2001:4860::1:0:249f 62.25 ms 2001:4860::1:0:613 38.352 ms 7 dead:beef:8917:cafe:d00d:f00f:feed:f00b 39.562 ms 2001:4860::31 43.566 ms 2001:4860::30 65.887 ms 8 dead:beef:8917:cafe:d00d:f00f:10.7.91.152 38.801 ms 2001:4860:0:1::35 42.529 ms 2001:4860:0:1::37 47.7 ms 9 2001:4860:b009::93 38.08 ms 38.072 ms 37.636 ms Net-Traceroute-1.15/t/44-parse-cisco-4unknown.t000755 074445 000000 00000003651 11600523144 021056 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Tests against cisco's "?" flag. use Test::More tests => 18; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_queries(2), 3, "Hop 2 has 3 queries"); for my $query (1..3) { ok(!defined($tr->hop_query_host(2, $query)), "Hop 2, query $query host is not defined"); is($tr->hop_query_stat(2, $query), TRACEROUTE_UNKNOWN, "Hop 2, query $query stat is TRACEROUTE_UNKNOWN"); } is($tr->hop_query_host(4, 1), "67.100.37.9", "Hop 4, query 1 is 67.100.37.9"); TODO: { local $TODO = "Unknowns aren't quite right yet"; is($tr->hop_queries(4), 3, "Hop 4 has 3 queries"); ok(!defined($tr->hop_query_host(4, 2)), "Hop 4, query 2 host is not defined"); is($tr->hop_query_stat(4, 2), TRACEROUTE_UNKNOWN, "Hop 4, query 2 status is TRACEROUTE_UNKNOWN"); } is($tr->hop_queries(5), 3, "Hop 5 has 3 queries"); ok(!defined($tr->hop_query_host(5, 1)), "Hop 5, query 1 host is not defined"); is($tr->hop_query_stat(5, 1), TRACEROUTE_UNKNOWN, "Hop 5, query 1 status is TRACEROUTE_UNKNOWN"); is($tr->hop_query_host(5, 2), "65.47.144.33", "Hop 5, query 2 host is 65.47.144.33"); is($tr->hop_query_time(5, 2), 12, "Hop 5, query 2 time is 12 msec"); is($tr->hop_query_host(5, 3), "65.47.144.33", "Hop 5, query 3 host is 65.47.144.33"); is($tr->hop_query_time(5, 3), 20, "Hop 5, query 3 time is 20 msec"); __END__ Type escape sequence to abort. Tracing the route to 192.148.252.10 1 10.12.0.1 0 msec 4 msec 0 msec 2 ? ? ? 3 192.168.4.37 20 msec 16 msec 20 msec 4 67.100.37.9 12 msec ? 16 msec 5 ? 65.47.144.33 12 msec 20 msec 6 216.156.7.13 16 msec 16 msec 16 msec 7 216.156.0.25 20 msec 20 msec 24 msec 8 207.88.13.41 24 msec 20 msec 76 msec 9 206.111.13.94 28 msec 24 msec 24 msec 10 72.52.92.86 28 msec 36 msec 36 msec 11 64.71.128.254 28 msec 28 msec 24 msec 12 192.148.252.10 28 msec 28 msec 32 msec Net-Traceroute-1.15/t/80-tracelie.t000755 074445 000000 00000001245 11600523144 016652 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Exercise the ability to call traceroute through a pipe. We use a # mock vesion of traceroute that returns a constant result. # This doesn't do much to exercise the peculiar timing issues that # traceroute can generate with its bursty output. use strict; use warnings; use Test::More; use Net::Traceroute; require "t/testlib.pl"; os_must_unixexec(); plan tests => 3; my $tr = Net::Traceroute->new( trace_program => "./t/tracelie", host => "128.52.32.80" ); is($tr->hops(), 10, "hop count is 10"); is($tr->hop_query_host(1, 1), "66.92.73.1", "first hop is 66.2.73.1"); is($tr->hop_query_host(10, 1), "128.52.32.80", "last hop is 128.52.32.80"); Net-Traceroute-1.15/t/43-parse-cisco-4flags.t000755 074445 000000 00000001601 11600523144 020443 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Test flag parsing for cisco traceroutes. use Test::More tests => 6; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_host(2, 1), "10.12.0.1", "hop 2, query 1 host is 10.12.0.1"); is($tr->hop_query_stat(2, 1), TRACEROUTE_UNREACH_NET, "hop 2, query 1 stat is TRACEROUTE_UNREACH_NET"); is($tr->hop_query_host(2, 2), "10.12.0.1", "hop 2, query 2 host is 10.12.0.1"); is($tr->hop_query_stat(2, 2), TRACEROUTE_UNREACH_NET, "hop 2, query 2 stat is TRACEROUTE_UNREACH_NET"); is($tr->hop_query_host(2, 3), "10.12.0.1", "hop 2, query 3 host is 10.12.0.1"); is($tr->hop_query_stat(2, 3), TRACEROUTE_UNREACH_NET, "hop 2, query 3 stat is TRACEROUTE_UNREACH_NET"); __END__ Type escape sequence to abort. Tracing the route to 192.148.252.10 1 10.12.0.1 0 msec 0 msec 0 msec 2 10.12.0.1 !N !N !N Net-Traceroute-1.15/t/23-parse-4flags.t000755 074445 000000 00000001745 11600523144 017354 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Parse a traceroute that has ICMP flags in it. use strict; use warnings; use Test::More tests => 2; use Socket; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_stat(11, 1), TRACEROUTE_UNREACH_FILTER_PROHIB); is($tr->hop_query_host(11, 2), "69.81.18.12"); # Note that this traceroute is drawn from a debian linux box. __END__ traceroute to 69.81.18.12 (69.81.18.12), 30 hops max, 40 byte packets 1 128.30.16.4 0.331 ms 0.398 ms 0.434 ms 2 128.30.0.253 0.283 ms 0.361 ms 0.378 ms 3 18.4.7.1 0.412 ms 0.493 ms 0.741 ms 4 18.168.1.18 0.720 ms 0.807 ms 0.841 ms 5 18.168.1.50 0.824 ms 1.010 ms 0.992 ms 6 207.210.142.233 0.637 ms 0.638 ms 0.675 ms 7 207.210.142.18 22.941 ms 23.127 ms 23.156 ms 8 206.223.119.4 23.795 ms 23.789 ms 23.995 ms 9 69.17.87.23 49.330 ms 49.103 ms 49.098 ms 10 69.17.83.202 51.892 ms 52.239 ms 52.875 ms 11 69.81.18.12 70.229 ms !X 77.290 ms !X 75.179 ms !X Net-Traceroute-1.15/t/20-parse-4basic.t000755 074445 000000 00000003410 11600523144 017325 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Test a very basic ipv4 traceroute. If this doesn't work, later # tests probably won't either. use strict; use warnings; use Test::More tests => 18; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hops(), 10, "has ten hops"); is($tr->hop_queries(1), 3, "hop 1 has 3 queries"); foreach my $q (1..3) { is($tr->hop_query_host(1, $q), "66.92.73.1", "hop 1, query $q is 66.92.73.1"); is($tr->hop_query_stat(1, $q), TRACEROUTE_OK, "hop 1, query $q is TRACEROUTE_OK"); } is($tr->hop_query_time(1, 0), 22.227, "hop 1, query 0 has correct time"); is($tr->hop_query_time(1, 1), 22.227, "hop 1, query 1 has correct time"); is($tr->hop_query_time(1, 2), 24.444, "hop 1, query 2 has correct time"); is($tr->hop_query_time(1, 3), 23.090, "hop 1, query 3 has correct time"); is($tr->hop_query_host(3, 1), "69.17.87.24", "hop 3, query 1 is 69.17.87.24"); is($tr->hop_query_time(3, 1), 47.690, "hop 3, query time is 47.690 ms"); is($tr->hop_query_host(10, 1), "128.52.32.80", "hop 10, query 1 is 128.52.32.80"); is($tr->hop_query_time(10, 1), 71.539, "hop 10, query 1 has correct time"); is($tr->hop_query_time(10, 2), 68.564, "hop 10, query 2 has correct time"); is($tr->hop_query_time(10, 3), 69.101, "hop 10, query 3 has correct time"); __END__ 1 66.92.73.1 22.227 ms 24.444 ms 23.090 ms 2 69.17.83.201 18.365 ms 21.828 ms 20.156 ms 3 69.17.87.24 47.690 ms 46.479 ms 46.524 ms 4 206.223.119.120 56.538 ms 76.455 ms 59.301 ms 5 207.210.142.17 70.135 ms 69.110 ms 68.556 ms 6 207.210.142.234 68.756 ms 69.293 ms 68.872 ms 7 18.168.0.23 69.316 ms 71.269 ms 70.829 ms 8 18.4.7.65 69.758 ms 69.793 ms 69.594 ms 9 128.30.0.254 69.043 ms 68.092 ms 68.846 ms 10 128.52.32.80 71.539 ms 68.564 ms 69.101 ms Net-Traceroute-1.15/t/33-parse-6flags.t000644 074445 000000 00000002733 11600523144 017352 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Parse a traceroute that has ICMP flags in it. use strict; use warnings; use Test::More tests => 6; use Socket; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_stat(11, 1), TRACEROUTE_UNREACH_FILTER_PROHIB, "hop 11, query 1 stat !P => FILTER_PROHIB"); is($tr->hop_query_host(11, 1), "2001:420:80:7:219:7ff:fea8:a400", "hop 11, query 1 is 2001:420:80:7:219:7ff:fea8:a400"); is($tr->hop_query_time(11, 1), 97.401, "hop 11, query 1 has correct time"); is($tr->hop_query_stat(11, 3), TRACEROUTE_UNREACH_FILTER_PROHIB, "hop 11, query 3 stat !P => FILTER_PROHIB"); is($tr->hop_query_host(11, 3), "2001:420:80:7:219:7ff:fea8:a400", "hop 11, query 3 is 2001:420:80:7:219:7ff:fea8:a400"); is($tr->hop_query_time(11, 3), 96.725, "hop 11, query 3 has correct time"); __END__ 1 2001:470:1f06:177::1 24.647 ms 26.4 ms 24.774 ms 2 2001:470:0:5d::1 22.784 ms 21.811 ms 22.666 ms 3 2001:470:0:10e::1 81.828 ms 93.557 ms 83.82 ms 4 2001:470:0:18d::1 91.304 ms 96.888 ms 98.954 ms 5 2001:470:0:2d::1 91.06 ms 121.751 ms 103.873 ms 6 2001:470:0:43::2 92.725 ms 91.775 ms 92.697 ms 7 2001:470:1f02:ab::2 95.527 ms 94.92 ms 95.466 ms 8 2001:420:80:8::1 95.927 ms 96 ms 96.385 ms 9 2001:420:80:6:c67d:4fff:fe8b:e2c0 99.028 ms 96.576 ms 97.183 ms 10 2001:420:80:7:219:7ff:fea8:a400 99.312 ms 99.683 ms 96.638 ms 11 2001:420:80:7:219:7ff:fea8:a400 97.401 ms !P 98.931 ms !P 96.725 ms !P Net-Traceroute-1.15/t/30-parse-6basic.t000755 074445 000000 00000001702 11600523144 017332 0ustar00hagwheel000000 000000 #!/usr/bin/perl # Parse a basic traceroute6. use strict; use warnings; use Test::More tests => 4; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_query_host(1, 1), "2001:470:1f06:177::1", "can extract first v6 addr"); is($tr->hop_query_time(1, 1), 27.047, "hop 1, query 1 time is correct"); is($tr->hop_query_time(1, 2), 23.471, "hop 1, query 2 time is correct"); is($tr->hop_query_host(8, 1), "2001:4f8:3:7:2e0:81ff:fe52:9a6b", "can extract last v6 addr"); __END__ 1 2001:470:1f06:177::1 27.047 ms 23.471 ms 25.256 ms 2 2001:470:0:5d::1 25.026 ms 24.045 ms 24.046 ms 3 2001:470:0:4e::1 45.484 ms 44.195 ms 45.763 ms 4 2001:470:1:34::2 45.18 ms 47.433 ms 43.312 ms 5 2001:500:71:6::1 46.941 ms 45.953 ms 62.494 ms 6 2001:4f8:0:1::4a:1 100.9 ms 100.014 ms 103.981 ms 7 2001:4f8:1b:1::8:2 100.119 ms 99.906 ms 100.206 ms 8 2001:4f8:3:7:2e0:81ff:fe52:9a6b 98.68 ms 98.704 ms 98.183 ms Net-Traceroute-1.15/t/47-parse-cisco-6ecmp.t000755 074445 000000 00000003644 11600523144 020312 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Test parsing of cisco, ecmp over ipv6. use Test::More tests => 13; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_queries(6), 3, "Hop 6 has 3 queries"); is($tr->hop_query_host(6, 1), "2001:4860::1:0:9FF", "Hop 6, query 1 host is 2001:4860::1:0:9FF"); is($tr->hop_query_time(6, 1), 32, "Hop 6, query 1 time is 32 msec"); is($tr->hop_query_host(6, 2), "2001:4860::1:0:5DC", "Hop 6, query 2 host is 2001:4860::1:0:5DC"); is($tr->hop_query_time(6, 2), 148, "Hop 6, query 2 time is 148 msec"); is($tr->hop_query_host(6, 3), "2001:4860::1:0:9FF", "Hop 6, query 3 host is 2001:4860::1:0:9FF"); is($tr->hop_query_time(6, 3), 32, "Hop 6, query 3 time is 32 msec"); is($tr->hop_query_host(9, 1), "2001:4860:0:1::8B", "Hop 9, query 1 host is 2001:4860:0:1::8B"); is($tr->hop_query_time(9, 1), 40, "Hop 9, query 1 time is 40 msec"); is($tr->hop_query_host(9, 2), "2001:4860:0:1::8F", "Hop 9, query 2 host is 2001:4860:0:1::8F"); is($tr->hop_query_time(9, 2), 52, "Hop 9, query 2 time is 52 msec"); is($tr->hop_query_host(9, 3), "2001:4860:0:1::8F", "Hop 9, query 3 host is 2001:4860:0:1::8F"); is($tr->hop_query_time(9, 3), 52, "Hop 9, query 3 time is 52 msec"); __END__ Type escape sequence to abort. Tracing the route to 2001:4860:800E::6A 1 2001:470:8917:9:2D0:B7FF:FE5E:7F36 4 msec 0 msec 4 msec 2 2001:470:1F06:177::1 24 msec 24 msec 24 msec 3 2001:470:0:5D::1 20 msec 24 msec 24 msec 4 2001:504:F::27 32 msec 24 msec 24 msec 5 2001:4860::1:0:755 24 msec 20 msec 116 msec 6 2001:4860::1:0:9FF 32 msec 2001:4860::1:0:5DC 148 msec 2001:4860::1:0:9FF 32 msec 7 2001:4860::1:0:7D9 44 msec 2001:4860::1:0:82E 44 msec 2001:4860::1:0:7D9 44 msec 8 2001:4860::2:0:125 40 msec 44 msec 40 msec 9 2001:4860:0:1::8B 40 msec 2001:4860:0:1::8F 52 msec 52 msec 10 2001:4860:800E::6A 44 msec 40 msec 40 msec Net-Traceroute-1.15/t/48-parse-cisco-6flags.t000755 074445 000000 00000002664 11600523144 020464 0ustar00hagwheel000000 000000 #!/usr/bin/perl use strict; use warnings; # Cisco ipv6 traceroute with icmp flags in it. use Test::More tests => 5; use Net::Traceroute; require "t/testlib.pl"; my $tr = parsefh(*DATA); is($tr->hop_queries(12), 3, "Hop 12 has 3 queries"); is($tr->hop_query_stat(12, 1), TRACEROUTE_UNREACH_FILTER_PROHIB, "Hop 12, query 1 status is TRACEROUTE_UNREACH_FILTER_PROHIB"); is($tr->hop_query_host(12, 1), "2001:420:80:7:219:7FF:FEA8:A400", "Hop 12, query 1 host is 2001:420:80:7:219:7FF:FEA8:A400"); is($tr->hop_query_stat(12, 2), TRACEROUTE_UNREACH_FILTER_PROHIB, "Hop 12, query 2 status is TRACEROUTE_UNREACH_FILTER_PROHIB"); is($tr->hop_query_stat(12, 3), TRACEROUTE_UNREACH_FILTER_PROHIB, "Hop 12, query 3 status is TRACEROUTE_UNREACH_FILTER_PROHIB"); __END__ Type escape sequence to abort. Tracing the route to 2001:420:80:1::5 1 2001:470:8917:9:2D0:B7FF:FE5E:7F36 0 msec 0 msec 0 msec 2 2001:470:1F06:177::1 24 msec 32 msec 36 msec 3 2001:470:0:5D::1 20 msec 20 msec 32 msec 4 2001:470:0:10E::1 96 msec 108 msec 104 msec 5 2001:470:0:18D::1 92 msec 92 msec 100 msec 6 2001:470:0:2D::1 184 msec 116 msec 104 msec 7 2001:470:0:43::2 200 msec 260 msec 188 msec 8 2001:470:1F02:AB::2 92 msec 172 msec 96 msec 9 2001:420:80:8::1 104 msec 96 msec 108 msec 10 2001:420:80:6:C67D:4FFF:FE8B:E2C0 96 msec 100 msec 100 msec 11 2001:420:80:7:219:7FF:FEA8:A400 100 msec 96 msec 100 msec 12 2001:420:80:7:219:7FF:FEA8:A400 !A !A !A