#!/usr/bin/perl

$TITLE = 'ctrace';
$VERSION = '0.8';

use Net::RawIP qw(:pcap);
use Socket;
use Getopt::Std;

getopts('c:d:f:i:j:m:p:q:s:t:w:T:AahFMnoPRSUvXY');

$|=1;

if (!$opt_t || $opt_h) { &help; }

$dst_port = ($opt_d eq '0' || ($opt_d && $opt_d >= 0) ? $opt_d : 53);   # 0 means random
$max_fail = ($opt_f && $opt_f >  0 ? $opt_f : 2);
$jump     = ($opt_j && $opt_j >  1 ? $opt_j : 0);
$max_ttl  = ($opt_m && $opt_m >  0 ? $opt_m : 35);
$n_pakets = ($opt_q && $opt_q >  0 ? $opt_q : 1);
$src_port = ($opt_s eq '0' || ($opt_s && $opt_s >= 0) ? $opt_s : 0);    # 0 means random
$timeout  = ($opt_m && $opt_m >  0 ? $opt_w : 3);
# FIXTHIS  .. TOS input checking needs a-writin'
$tos	  = ($opt_T 		   ? $opt_T : 0x10);

# 'mix mode'
if($opt_M) {
 *STDERR=*STDOUT;
}

# overrule verbose
if($opt_o && $opt_v) {
 undef $opt_v;
}
# overrule averaging
if($opt_o) {
 $opt_a=1;
}

# ICMP type
if(defined($opt_i)) {
 #FIXTHIS: verify arg integrity
 if($opt_i >= 0 && $opt_i <= 255) {
  $icmptype = $opt_i;
 }
 else {
  $icmptype = 8;
 }
}
 
# ICMP code
if(defined($opt_c)) {
 # FIXTHIS: verify arg integrity
 if($opt_c >= 0 && $opt_c <= 255) {
  $icmpcode = $opt_c;
 }
 else {
  $icmpcode = 0;
 }
}

if($opt_v) {
 print "dst_port:$dst_port,src_port:$src_port,jump:$jump,max_ttl:$max_ttl,n_pakets:$n_pakets,timeout:$timeout,tos:$tos,icmpcode:$icmpcode,icmptype:$icmptype.\n";
}

$ack  = ($opt_A ? 1 : 0);
$fin  = ($opt_F ? 1 : 0);
$syn  = ($opt_S ? 0 : 1);
$psh  = ($opt_P ? 1 : 0);
$rst  = ($opt_R ? 1 : 0);
$urg  = ($opt_U ? 1 : 0);
$res1 = ($opt_X ? 1 : 0);
$res2 = ($opt_Y ? 1 : 0);
if($opt_v) {
 print "fin:$fin,syn:$syn,psh:$psh,rst:$rst,urg:$urg,res1:$res1,res2:$res2\n";
}

# test protocol option out
$opt_p =~ tr/A-Z/a-z/;
if($opt_p) {
 if($opt_p =~ /^\d+$/) {
  $protoname = getprotobynumber($opt_p);
  $protonumber = $opt_p;
 }
 else {
  $protoname = $opt_p;
  $protonumber = getprotobyname($opt_p);
 }
 if($protonumber<=0) {
  die("protocol '$opt_p' unsupported.  try something from /etc/protocols.");
 }
}
else {
 $protoname = 'udp';
 $protonumber = '17';
}

$dest = $opt_t;
($name,$ip) = (gethostbyname($dest))[0,4];
die "$dest: host not found" if $?; 

$dev = rdev($dest);
$ip_addr = ${ifaddrlist()}{$dev};
$remote_ip = sprintf("%u.%u.%u.%u",unpack("C4",$ip));

print STDERR "traceroute to $name (";
printf STDERR ("%u.%u.%u.%u",unpack("C4",$ip));
print STDERR "), $max_ttl hops max, ";
# FIXTHIS .. need to precalculate REAL packet size
print STDERR "0 byte packets";
print STDERR "\n";
if(!$opt_o) {
 print STDERR "proto=$protonumber($protoname) ";
 print STDERR "srcip=$ip_addr";
 if($protonumber == 17 || $protonumber == 6) {
  print STDERR " srcport=$src_port";
  print STDERR " dstport=$dst_port";
  if($protonumber == 6) {
   print STDERR " tcpflags=";
   $res1 ? print STDERR "X":0;
   $res2 ? print STDERR "Y":0;
   $urg ? print STDERR "U":0;
   $ack ? print STDERR "A":0;
   $psh ? print STDERR "P":0;
   $rst ? print STDERR "R":0;
   $syn ? print STDERR "S":0;
   $fin ? print STDERR "F":0;
  }
  print STDERR "\n";
 }
}

srand();

# ICMP
if($protonumber == 1) { 
 $packet = new Net::RawIP({icmp=>{}});
 $icmp = new Net::RawIP({icmp=>{}});
}
# TCP
elsif($protonumber == 6) {
 $packet = new Net::RawIP({tcp=>{}});
 $tcp = new Net::RawIP({tcp=>{}});
}
# UDP
elsif($protonumber == 17) {
 $packet = new Net::RawIP({udp=>{}});
 $udp = new Net::RawIP({udp=>{}});
}
# All other protocols
else {
 $packet = new Net::RawIP({generic=>{}});
 $igmp = new Net::RawIP({generic=>{}});
}

$temporarypacket = new Net::RawIP({icmp=>{}});

$filt = "dst host $ip_addr and ((";
# TCP
if($protonumber == 6) {
 $filt .= "src host $remote_ip and ip proto 6";
 # if we are not randomly generating destination ports, include port in filter.
 if($dst_port != 0) {
  $filt .= " and src port $dst_port";
 }
 # if we are not randomly generating source ports, include port in filter.
 if($src_port != 0) {
  $filt .= " and dst port $src_port";
 }
}
# UDP
elsif($protonumber == 17) {
 $filt .= "src host $remote_ip and ip proto 17";
 # if we are not randomly generating destination ports, include port in filter.
 if($dst_port != 0) {
  $filt .= " and src port $dst_port";
 }
 # if we are not randomly generating source port, include port in filter.
 if($src_port != 0) {
  $filt .= " and dst port $src_port";
 }
}
# ICMP
# FIXTHIS .. add additional ICMP fields later, verify no RFC mods since bible
elsif($protonumber == 1) {
 $filt .= "ip proto 1";
 # echo request yields echo response
 if($icmptype == 8) {
  $filt .= " and icmp[0]==0";
 }
 # router solicitation yields router advertisement
 elsif($icmptype == 10) {
  $filt .= " and icmp[0]==9";
 }
 # timestamp req yields timestamp resp.
 elsif($icmptype == 13) {
  $filt .= " and icmp[0]==14";
 }
 # info. req yields info resp.
 elsif($icmptype == 15) {
  $filt .= " and icmp[0]==16";
 }
 # addr. mask req yields addr. mask resp.
 elsif($icmptype == 17) {
  $filt .= " and icmp[0]==18";
 }
 else {
  print STDERR "warning: capture filter is probably broken for last hop!\n";
  $filt .= " and icmp[0]==" . $icmptype+1;
 }
}
# FIXTHIS .. add additional fields for more protocols later, if pcap supports?
else {
 $filt .= "ip proto $protonumber";
}
$filt .= ") or (ip proto \\icmp and (icmp[0]==11 or icmp[0]==3)))";
if($opt_v) {
 print "filter: $filt\n";
}

$pcap = $packet->pcapinit($dev,$filt,1500,60);
$offset = linkoffset($pcap);

# General packet initialisation.
# IP initialisation.
$packet->set({
 ip=>{
  saddr		=> $ip_addr, 
  daddr		=> $remote_ip, 
  frag_off	=> 0,
  protocol	=> $protonumber,
  tos		=> $tos,
 }
});

# Protocol specific initialisation.
# ICMP
if($protonumber == 1) {
 $packet->set({
  icmp=>{
   type		=> $icmptype,
   code		=> $icmpcode,
  }
 });
}
# TCP
elsif($protonumber == 6) {
# FIXTHIS .. change seq/window to emulation or random vals
# FIXTHIS ... shift seq/window generation (if rand) in to main loop.
# FIXTHIS .. maybe flag-gen in mainloop too?
 $packet->set({
  tcp=>{
   seq		=> 12030,
   ack		=> $ack,
   fin          => $fin,
   syn		=> $syn,
   psh          => $psh,
   rst          => $rst,
   urg          => $urg,
   res1		=> $res1,
   res2		=> $res2,
   window	=> 1239194,
  }
 });
}
# Other protocols
# FIXTHIS shouldn't be garbage
else {
 $packet->set({
  generic=>{
   data         => 'moo',
  }
 });
}

$failedhops = 0;

# Main loop (increments TTL).
$initval = ($jump ? $jump : 1);
for($i=$initval;($i<=$max_ttl);$i++){
 printf "%2s  ", $i;
 srand();
 $printed=0;
 $received=0;
 undef @rtts;
 for($np=0;$np<$n_pakets;$np++){

  # IP packet settings
  $randid=300+int(rand(2000));
  $packet->set({
   ip=>{
    ttl		=> $i,
    id		=> $randid
   }
  });

  # Subprotocol packet settings
  # ICMP
  if($protonumber == 1) {
   # Message-type specific initialisation
   # Echo request or echo response
   if(($icmptype==8 && $icmpcode==0) or ($icmptype==0 && $icmpcode==0)) {
    $icmpid=int(rand(65535));
    $icmpsequence=0;
    $packet->set({
     icmp=>{
      id          => $icmpid,
      sequence    => $icmpsequence
      # FIXTHIS ICMP echo req/resp could have optional (emulated?) datafield.
     }
    });
   }
   # Address mask request
   elsif($icmptype==17 && $icmpcode==0) {
    $icmpid=int(rand(65535));
    $icmpsequence=0;
    $data = "\0" x 4;
    $packet->set({
     icmp=>{
      id          => $icmpid,
      sequence    => $icmpsequence,
      data	  => $data
     }
    });
   }
  }
  # TCP or UDP
  elsif($protonumber == 6 || $protonumber == 17) {
   # FIXTHIS .. srcport randomiser range/algo needs review
   # if a random source port is desired
   if($src_port == 0) {
    $this_src_port = 1500+int(rand(3600));
   } else {$this_src_port = $src_port;}
   # FIXTHIS .. dstport randomiser range/algo needs review
   # if a random destination port is desired
   if($dst_port == 0) {
    $this_dst_port = 1500+int(rand(3600));
   } else {$this_dst_port = $dst_port;}
   # TCP
   if($protonumber == 6) {
    # FIXTHIS .. tcpdata, tcppktflags, need args.  tcpdata depend on pktflags.
    # FIXTHIS .. also (intelligent based on port?) random data, checksum...
    $packet->set({tcp=>{source=>$this_src_port}}); 
    $packet->set({tcp=>{dest=>$this_dst_port}});
    # FIXTHIS .. add ability to add tcp=>{data=>...} when syn isnt set.
    # FIXTHIS    (if syn is set, linux NAT wont let the packet out! :/ )
   }
   # UDP
   elsif($protonumber == 17) {
    # FIXTHIS .. random data /checksum stuff should go here.
    $packet->set({udp=>{source=>$this_src_port}});
    $packet->set({udp=>{dest=>$this_dst_port}});
   }
  }
  undef($ipacket);
  $packet->send();
  $stime = timem();
  $drop = 1;

  # loop until matching packet found, or we time out
  do { 
   $ipacket = &next($pcap,$temp);
   $etime=timem();
   # if we have a packet
   if($ipacket) {
    $temporarypacket->bset(substr($ipacket,$offset));
    ($proto,$srchost) = $temporarypacket->get({ip=>['protocol','saddr']});
    # which protocol came in?
    if($proto == 1) {
     if($opt_v) {
      print "(received ICMP packet)";
     }
     # received ICMP .. probably a time expired message to log.
     ($data) = $temporarypacket->get({icmp=>['data']});
     $valid = 0;
 
     # Send-protocol specific routines.
     if($opt_v) {
      print "(parsing packet payload as ";
     }
     # ICMP
     if($protonumber == 1) {
      if($opt_v) {
       print "ICMP)";
      }
      #$icmp->bset($data); # write icmp pkt with incoming icmp error payload
      # FIXTHIS write validity check w/above?
      ($itype,$icode) = $temporarypacket->get({icmp=>['type','code']});

      # ICMP TTL expired
      if($itype==11) {
       if($opt_v) { print "(ICMP TTL expired)"; }
       $valid = 1;
      }
      # ICMP destination unreachable
      elsif($itype==3) {
       if($opt_v) { print "(ICMP destunreach code $icode)"; }
       print STDERR "Destination unreachable (code $icode).\n";
       $valid = 1;
       $end = 1;
      }
      # Other ICMP (for -i, -c options)
      else {
       if($opt_v) { print "(ICMP $itype, $icode)"; }
       $valid = 1;
       $end = 1;
      }
     }
     # TCP
     elsif($protonumber == 6) {
      if($opt_v) {
       print "TCP)";
      }
      $tcp->bset($data); # write tcp pkt with incoming icmp error payload
      if($opt_v) {
       print "(BSET)";
      }
      # check that the tcp was ours by matching the srcport
      ($sign) = $tcp->get({tcp=>['source']});
      $opt_v ? print "(sign=$sign)":0;
      if($sign == $this_src_port) {
       $opt_v ? print "(valid)":0;
       $valid = 1;
      }
      elsif($opt_v) {
       print "(MISMATCH .. srcport=$sign, not $this_src_port)";
      }
     }
     # UDP
     elsif($protonumber == 17) {
      if($opt_v) {
       print "UDP)";
      }
      ($itype,$icode) = $temporarypacket->get({icmp=>['type','code']});
      #$udp->bset($data); # write udp pkt with incoming icmp error payload
      # FIXTHIS write validity check w/above?
      if($itype==3 && $icode==3) {
       $valid = 1;
       $end = 1;
      }
      elsif($itype==11) {
       $valid = 1;
      }
     }
     else {
      if($opt_v) {
       print "unimplemented protocol)";
      }
      # FIXTHIS validity checking for unimplemented protocols SUX!!
      $valid = 1;
     }
     if($valid == 1) {
      # register this packet
      if($opt_v) {print "REGISTER";}
      $drop = 0;
     }
    }
    # otherwise we recv'd another protocol (ie: a tcp or udp response, meaning
    # that we've reached our target host)
    # FIXTHIS : for random ports, capture cant have verification.  must do here.
    else {
     $drop = 0;
     $end = 1;
    }
   }
  } while((($etime-$stime)<$timeout && $drop));
  unless(($etime-$stime)<$timeout){
    print "* ";
    next;
  }
  $dtime = ($etime-$stime);
  if(!$printed) {
   if(!$opt_n) {
    print ip2name($srchost) . ' ';
    print '(' . ip2dot($srchost) . ')';
   }
   else {
    print ip2dot($srchost);
   }
   print '  ';
   rtt_process($dtime);
   $printed=1;
   $received=1;
  }
  else {
   rtt_process($dtime);
   $received=1;
  }
 }

 # we have done our queries for this ttl, now.
 # if we got a response ...
 if($received) {
  if(!$opt_a) {
   $avg = avg_rtt();
   printf("%.3f",$avg);
   print ' ms';
   if($n_pakets > 1) {
    print '/avg';
   }
  }
 }
 else {
  $failedhops++;
  if($failedhops==$max_fail) {
   $end=2;
  }
 }
 print "\n";
 leave() if $end;
}

# all ttl's done.. timed out ..
leave();

######################################################################3

sub rtt_process {
 if(!$opt_a) {
  $rtts[$np]=rtt_ms($dtime);
 }
 else {
  printf "%.3f ms ",rtt_ms($dtime);
 }
}

sub avg_rtt {
 $total=0;
 foreach $time (@rtts) {
  $total = $total + $time;
 }
 $total = $total/($#rtts+1);
 return $total;
}

sub leave {
 if(!$opt_o) {
  if($end == 1) {
   print STDERR "Success. Reached target in $i hops.\n";
  }
  elsif($end == 2) {
   print STDERR "Failed. Aborted after " . ($i-$failedhops) . " good hops, due to $failedhops consecutive failures.\n";
  }
  else {
   print STDERR "Failed. Designated maximum (" . ($i-1) . ") hops attempted.\n";
  }
 }
 exit;
}

sub ip2dot {
  sprintf("%u.%u.%u.%u",unpack "C4", pack "N1", shift);
}

sub ip2name {
 my $addr = shift;
 (gethostbyaddr(pack("N",$addr),AF_INET))[0] || ip2dot($addr);
}

sub rtt_ms {
   sprintf("%.2f ms", 1000*shift);
}

sub destun { 
$_[0]!=3 || ($_[0]==3 && $_[1] == 3)
}

sub help {
 print "$TITLE v$VERSION\n";
 print "usage: $0 [options]\n";
 print " where options are:\n";
 print "  -a             dont average the rtt's (no effect if <qs> is 1).\n";
 print "  -c <icmpcode>  icmp msgcode (icmp only). 0-255, 0 dfl.\n";
 print "  -d <dstport>   destination port; 0 means random (tcp & udp only).\n";
 print "  -f <fhops>     failing <fhops> hops consecutively causes abort.\n";
 print "  -h             this help screen.\n";
 print "  -i <icmptype>  icmp msgtype (icmp only). 0-255, 8 dfl.\n";
 print "  -j <jhops>     'jump' (skip) the first <jhops> of the trace.\n";
 print "  -m <ttl>       max ttl.\n";
 print "  -n             `numeric mode' ... don't resolve hosts.\n";
 print "  -o             `oldschool mode' ... 4.3BSD traceroute compatible output.\n";
 print "  -p <protocol>  which protocol to trace with; icmp, tcp or udp.\n";
 print "  -q <qs>        # of queries per hop.\n";
 print "  -s <srcport>   source port. 0 means random. tcp&udp only.\n";
 print "  -t <target>    target of trace.\n";
 print "  -v             verbose mode.\n";
 print "  -w <secs>      rtt timeout in seconds.\n";
 print "  -M             `merged' mode.  STDERR is merged with STDOUT for parsing.\n";
 print "  -T             set ip type-of-service (doesn't work yet).\n";
 print "  -A|F|P|R|S|U   toggle flags on tcp packets. only syn is on by dfl.\n";
 exit();
}

