chiark / gitweb /
Bugfixes. Change script default mtu. Better eth addr parsing.
[vinegar-ip.git] / make-probes.tcl
index 478fc3fc9b57bf59b6c92b8e252246d98eef500b..527687340a10fd2db8f97f2cc274726653d53d03 100755 (executable)
@@ -1,5 +1,25 @@
 #!/usr/bin/tclsh
 
+# core packet generator for vinegar-ip
+#
+# This file is part of vinegar-ip, tools for IP transparency testing.
+# vinegar-ip is Copyright (C) 2002 Ian Jackson
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 
+#
+# $Id$
 
 proc debug {level str} {
     global debug_level
@@ -29,7 +49,10 @@ proc packet-csum-ip {packet} {
        set cs [expr "\$cs + 0x$this"]
        debug 7 [format "0x%s 0x%08x" $this $cs]
     }
-    return [expr {(($cs & 0xffff) + (($cs >> 16) & 0xffff)) ^ 0xffff}]
+    while {$cs > 0xffff} {
+       set cs [expr {($cs & 0xffff) + (($cs >> 16) & 0xffff)}]
+    }
+    return [expr {$cs ^ 0xffff}]
 }
 
 proc packet-fromstring {s} {
@@ -143,6 +166,9 @@ proc get-config/v4addr {val} {
     }
     return [format 0x%02x%02x%02x%02x $a $b $c $d]
 }
+proc get-config/linkaddr {val} {
+    return $val
+}
 
 proc get-config {variable def kind args} {
     # args currently ignored
@@ -707,7 +733,7 @@ define ip-proto 51 ah {mtu} {
     get next number 0 255
     get reserved hex 0 0xffff
     get spi hex32
-    get auth_data rand 0 [expr {$mtu-8}] 4
+    get auth_data rand 0 [expr {$mtu-8 > 50 ? 50 : $mtu-8}] 4
     set length [packet-len $auth_data]
     assemble ah {
      +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
@@ -723,6 +749,11 @@ define ip-proto 51 ah {mtu} {
     return $ah
 }
 
+proc udp-rport {} {
+    get-for udp
+    get port enum-rand 0 0xffff
+    return $port
+}
 
 define ip-proto 17 udp {mtu} {
     # RFC768
@@ -745,15 +776,11 @@ define ip-proto 17 udp {mtu} {
     } else {
        set def_port x
     }
-    if {"$style" != "servers"} {
-       get port enum-rand 0 0xffff
-       set rand_port $port
-    }
     switch -exact $style {
-       random  { set source_port $rand_port; set dest_port $rand_port }
-       request { set source_port $rand_port; set dest_port $def_port }
-       reply   { set source_port $def_port;  set dest_port $rand_port }
-       servers { set source_port $def_port;  set dest_port $def_port }
+       random  { set source_port [udp-rport]; set dest_port [udp-rport] }
+       request { set source_port [udp-rport]; set dest_port $def_port   }
+       reply   { set source_port $def_port;   set dest_port [udp-rport] }
+       servers { set source_port $def_port;   set dest_port $def_port   }
     }
 
     if {"$style" != "random"} {
@@ -994,14 +1021,16 @@ define ip-proto 6 tcp {mtu} {
     get urg hex 0 0xffff
 
     set options {}
-    get optmode choice-mult badopt 0.3 opt 0.6 noopt
+    get optmode choice-mult badopt 0.3 opt 0.3 noopt
     switch -exact $optmode {
        noopt { }
        badopt {
            get options rand 1 60 1
        }
        opt {
-           while {[choice-prob tcp-opts-more 0.4]} {
+           set nooi 1
+           while {$nooi || [choice-prob tcp-opts-more 0.4]} {
+               set nooi 0
                get opt enum 1 255 0.5
                if {$opt == 1} {
                    assemble option {
@@ -1150,7 +1179,7 @@ namespace import PCap::*
 
 proc emit {seed} {
     global getlog_log errorInfo mtu fake_time_t
-    global minframelen
+    global minframelen linktypename
 
     get-for ip
     get-config source 127.0.0.1 v4addr
@@ -1172,10 +1201,7 @@ proc emit {seed} {
            append packet [string repeat 00 [expr {$minframelen - $l}]]
        }
 
-       # RFC894
-       set llpkt [random-bytes 12]
-       append llpkt 0800
-       append llpkt $packet
+       set llpkt [link/$linktypename/linkencap $packet]
        
        set len [packet-len "$llpkt"]
        pcap_write {
@@ -1189,6 +1215,30 @@ proc emit {seed} {
 }
 
 
+# link/ether - RFC894
+proc link/ether/linkparams {} { return {1 46} }
+proc link/ether/defaddr {} { return 00:00:00:00:00:00 }
+proc link/ether/procaddr {input sd} {
+    set v [string tolower $input]
+    if {[regexp {^([0-9a-f]{1,2}\:){6}$} $v:]} {
+       set o {}
+       foreach b [split $v :] { append o [format %02x 0x$b] }
+       set v $o
+    }
+    if {![regexp -nocase {^[0-9a-f]{12}$} $v]} {
+       error "invalid $sd ethernet addr $input ($v)"
+    }
+    return $v
+}
+proc link/ether/linkencap {packet} {
+    global link_source link_dest
+    set llpkt {}
+    append llpkt $link_dest $link_source 0800
+    append llpkt $packet
+    return $llpkt
+}
+
+
 proc nextarg {} {
     global argv
     if {![llength $argv]} { error "need another arg" }
@@ -1198,11 +1248,19 @@ proc nextarg {} {
 }
 
 proc nextarg_num {} { return [expr {[nextarg] + 0}] }
+proc nextarg_il {} {
+    set a [nextarg]
+    if {![regexp -nocase {^([0-9.]+)/(.+)$} $a dummy i l]} {
+       error "--source/--dest needs <ip-addr>/<link-addr>"
+    }
+    return [list $i $l]
+}
 
 set debug_level 0
-set mtu 576
+set mtu 100
 set upto {}
 set xseed {}
+set linktypename ether
 while {[regexp {^\-\-} [lindex $argv 0]]} {
     set o [nextarg]
     switch -exact -- $o {
@@ -1212,12 +1270,25 @@ while {[regexp {^\-\-} [lindex $argv 0]]} {
        --write { pcap_open [nextarg] }
        --mtu { set mtu [nextarg_num] }
        --xseed { set xseed [nextarg] }
-       --source { set config/ip-source [nextarg] }
-       --dest { set config/ip-dest [nextarg] }
+       --linktype { set linktypename [nextarg] }
+       --source { manyset [nextarg_il] config/ip-source config/link-source }
+       --dest { manyset [nextarg_il] config/ip-dest config/link-dest }
        default { error "bad option $o" }
     }
 }
 
+proc process_linkaddr {sd} {
+    global linktypename
+    upvar #0 link_$sd l
+    get-for link
+    get-config $sd [link/$linktypename/defaddr] linkaddr
+    set l [link/$linktypename/procaddr [set $sd] $sd]
+}
+
+manyset [link/$linktypename/linkparams] linktype minframelen
+process_linkaddr source
+process_linkaddr dest
+
 set magic d4c3b2a1
 set version_major 2
 set version_minor 4
@@ -1225,10 +1296,6 @@ set thiszone 0
 set sigfigs 0
 set snaplen 131073
 
-# RFC894
-set linktype 1
-set minframelen 46
-
 pcap_write {
     x32 magic
     u16 version_major