chiark / gitweb /
Summaries
[vinegar-ip.git] / make-probes.tcl
index f5816980a140df7e7bf7209e6501f51dcf90dc69..b8b520f6475ba48b1616983aa35929944bfecc66 100755 (executable)
@@ -166,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
@@ -245,7 +248,8 @@ proc get/rand {s v minlen maxlen blockbytes} {
 }
 
 proc get/ip-timestamp {s v} {
-    set rv [expr {[clock seconds] | 0x80000000}]
+    set rv 0xbc000000
+    incr rv [choice-int 100 10000]
     getlog "$v=[format %x $rv]"
     return $rv
 }
@@ -1176,7 +1180,7 @@ namespace import PCap::*
 
 proc emit {seed} {
     global getlog_log errorInfo mtu fake_time_t
-    global minframelen linktypename
+    global minframelen linktypename errors_continue
 
     get-for ip
     get-config source 127.0.0.1 v4addr
@@ -1189,6 +1193,9 @@ proc emit {seed} {
     } emsg]} {
        puts stderr "\nERROR\n$seed\n\n$emsg\n\n$errorInfo\n\n"
        puts stdout "[format %6s $seed] error"
+       if {!$errors_continue} {
+           error "internal error generating packet - consult author"
+       }
     } else {
        set ts_sec [incr fake_time_t]
        set ts_usec 0
@@ -1217,10 +1224,12 @@ 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]{2}\:){5}[0-9a-f]{2}$} $v]} {
-       set v [string map {: {}} $v]
+    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-9]{12}$} $v]} {
+    if {![regexp -nocase {^[0-9a-f]{12}$} $v]} {
        error "invalid $sd ethernet addr $input ($v)"
     }
     return $v
@@ -1228,7 +1237,7 @@ proc link/ether/procaddr {input sd} {
 proc link/ether/linkencap {packet} {
     global link_source link_dest
     set llpkt {}
-    append llpkt $link_source $link_dest 0800
+    append llpkt $link_dest $link_source 0800
     append llpkt $packet
     return $llpkt
 }
@@ -1245,14 +1254,15 @@ proc nextarg {} {
 proc nextarg_num {} { return [expr {[nextarg] + 0}] }
 proc nextarg_il {} {
     set a [nextarg]
-    if {![regexp -nocase {^([0-9.]+)/([0-9a-f:]+)$} $a dummy i l]} {
+    if {![regexp -nocase {^([0-9.]+)/(.+)$} $a dummy i l]} {
        error "--source/--dest needs <ip-addr>/<link-addr>"
     }
-    return [list $i [string map {: {}} $l]]
+    return [list $i $l]
 }
 
 set debug_level 0
-set mtu 576
+set errors_continue 0
+set mtu 100
 set upto {}
 set xseed {}
 set linktypename ether
@@ -1265,9 +1275,10 @@ while {[regexp {^\-\-} [lindex $argv 0]]} {
        --write { pcap_open [nextarg] }
        --mtu { set mtu [nextarg_num] }
        --xseed { set xseed [nextarg] }
+       --errors-continue { set errors_continue 1 }
        --linktype { set linktypename [nextarg] }
-       --source { manyset [nextarg_ih] config/ip-source config/link-source }
-       --dest { manyset [nextarg_ih] config/ip-dest config/link-dest }
+       --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" }
     }
 }
@@ -1275,7 +1286,6 @@ while {[regexp {^\-\-} [lindex $argv 0]]} {
 proc process_linkaddr {sd} {
     global linktypename
     upvar #0 link_$sd l
-    link/$linktypename/linktype
     get-for link
     get-config $sd [link/$linktypename/defaddr] linkaddr
     set l [link/$linktypename/procaddr [set $sd] $sd]
@@ -1302,7 +1312,10 @@ pcap_write {
     s32 linktype
 }
 
-set fake_time_t [clock seconds]
+set fake_time_t 1000000000
+
+start_gen TEST
+random-bytes 100
 
 if {[llength $argv]} {
     foreach count $argv { emit "$xseed$count" }