proc choice-prob {cv def} {
set prob [config $cv $def]
set rv 0x[random-bytes 3]
- return [expr {$rv < double($prob)*0x1000000}]
+ set rv [expr {$rv < double($prob)*0x1000000}]
+ debug 2 "choice-prob $rv <- $prob ($cv)"
+ return $rv
}
proc choice-mult {args} {
set args [lreplace $args end end]
foreach {val p} $args {
set cump [expr {$cump + double($p)}]
- if {$x < $cump} { return $val }
+ if {$x < $cump} {
+ debug 2 "choice-mult $val <= [concat $args [list $def]]"
+ return $val
+ }
}
+ debug 2 "choice-mult $def <- [concat $args [list $def]]"
return $def
}
}
-proc define {enum val name argnames body} {
+proc define {enum val mult name argnames body} {
+ # mult may be:
+ # * full share of `known' enum values
+ # ? only as often as `random' enum values
+ # Or *<pct> or ?<pct> meaning <pct>/100 times as often as * or ?.
+
upvar #0 enum/val2name/$enum v2n
+ upvar #0 enum/val2mult/$enum v2m
upvar #0 enum/name2val/$enum n2v
+ foreach kind {? *} {
+ upvar #0 enum/total$kind/$enum total$kind
+ if {![info exists total$kind]} { set total$kind 0 }
+ }
+
+ regsub {^[?*]$} $mult {&100} mult
+ if {![regexp {^([?*])([0-9]+)$} $mult dummy kind times]} {
+ error "invalid mult $mult"
+ }
+
set v2n($val) $name
+ set v2m($val) [list $kind $times]
set n2v($name) $val
+ incr total$kind $times
+
proc enum/val/$enum/$val $argnames $body
}
}
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
return [get-enum-got $s $v $rv]
}
-proc get/enum-def {s v} {
- upvar #0 enum/val2name/$s-$v v2n
- set rv [choice-int 1 [array size v2n]]
- set rv [lindex [lsort [array names v2n]] [expr {$rv-1}]]
+proc enum-prepare-choice-list {s v nvalues prand} {
+ upvar #0 "enum/choice-list/$s-${v}($nvalues $prand)" cl
+ upvar #0 enum/val2mult/$s-$v v2m
+ upvar #0 enum/total*/$s-$v total*org
+ upvar #0 enum/total?/$s-$v total?
+
+ set total* ${total*org}
+ if {!${total*}} { set total* [expr {double(${total*org}) + 0.001}] }
+
+ set pr $prand
+ if {!${total?}} { set pr 0.0 }
+ set pm? [expr {$pr / (100.0*double($nvalues))}]
+ set pm* [expr {(1.0 - $pr) / double(${total*})}]
+ debug 1 "epcl $s-$v $nvalues $prand: pr $pr ? pm ${pm?} total ${total?} * pm ${pm*} total ${total*}"
+
+ set cl {}
+ foreach rv [lsort [array names v2m]] {
+ manyset $v2m($rv) kind times
+ set p [expr { double($times) * [set pm$kind] }]
+ debug 1 "epcl $s-$v $nvalues $prand: $rv $kind$times := $p"
+ lappend cl $rv $p
+ }
+ if {${total*org}} {
+ set cl [lreplace $cl end end]
+ } else {
+ lappend cl *
+ }
+}
+
+proc get/enum-def {s v min max prand} {
+ set nvalues [expr {$max-$min+1}]
+ upvar #0 "enum/choice-list/$s-${v}($nvalues $prand)" cl
+ if {![info exists cl]} { enum-prepare-choice-list $s $v $nvalues $prand }
+ set rv [eval choice-mult $cl]
+ if {"$rv" == "*"} { set rv [choice-int $min $max] }
return [get-enum-got $s $v $rv]
}
proc get/enum {s v min max prand} {
- get-for $s-$v
- get any choice $prand
+ set any [choice-prob $s-$v-any $prand]
if {$any} {
return [get/enum-rand $s $v $min $max]
} else {
- return [get/enum-def $s $v]
+ return [get/enum-def $s $v $min $max $prand]
}
}
}
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
}
get frag number 0 0x1fff
}
get-config ttl 255 number 0 255
- get proto enum 1 255 0.05
+ get proto enum 0 255 0.2
set flags [expr {$df*2 + $mf}]
set header_checksum 0
return $ip
}
-define ip-proto 1 icmp {mtu} {
+define ip-proto 1 *50 icmp {mtu} {
# RFC792
get-for icmp
get type enum 0 255 0.2
}
proc define-icmp-type-vanilla {num name} {
- define icmp-type $num $name {mbl} "icmp-vanilla \$mbl [list $name]"
+ define icmp-type $num * $name {mbl} "icmp-vanilla \$mbl [list $name]"
}
proc icmp-vanilla {mbl typename} {
get-for icmp-$typename
}
define-icmp-type-vanilla 3 unreach
-define icmp-unreach-code 0 net {} {}
-define icmp-unreach-code 1 host {} {}
-define icmp-unreach-code 2 proto {} {}
-define icmp-unreach-code 3 port {} {}
-define icmp-unreach-code 4 fragneeded {} {}
-define icmp-unreach-code 5 sourceroutefail {} {}
+define icmp-unreach-code 0 * net {} {}
+define icmp-unreach-code 1 * host {} {}
+define icmp-unreach-code 2 * proto {} {}
+define icmp-unreach-code 3 * port {} {}
+define icmp-unreach-code 4 * fragneeded {} {}
+define icmp-unreach-code 5 * sourceroutefail {} {}
define-icmp-type-vanilla 11 timeout
-define icmp-timeout-code 0 intransit {} {}
-define icmp-timeout-code 1 fragment {} {}
+define icmp-timeout-code 0 * intransit {} {}
+define icmp-timeout-code 1 * fragment {} {}
define-icmp-type-vanilla 12 parameters
-define icmp-parameters-code 0 seepointer {} {}
+define icmp-parameters-code 0 * seepointer {} {}
define-icmp-type-vanilla 4 sourcequench
-define icmp-sourcequench-code 0 quench {} {}
+define icmp-sourcequench-code 0 * quench {} {}
-define icmp-type 5 redirect {mbl} {
+define icmp-type 5 * redirect {mbl} {
get-for icmp-redirect
get code enum 0 255 0.4
get gateway v4addr
return [list $body $code]
}
-define icmp-redirect-code 0 net {} {}
-define icmp-redirect-code 1 host {} {}
-define icmp-redirect-code 2 net+tos {} {}
-define icmp-redirect-code 3 host+tos {} {}
+define icmp-redirect-code 0 * net {} {}
+define icmp-redirect-code 1 * host {} {}
+define icmp-redirect-code 2 * net+tos {} {}
+define icmp-redirect-code 3 * host+tos {} {}
-define icmp-type 8 ping {mbl} { icmp-echo $mbl }
-define icmp-type 0 pong {mbl} { icmp-echo $mbl }
+define icmp-type 8 * ping {mbl} { icmp-echo $mbl }
+define icmp-type 0 * pong {mbl} { icmp-echo $mbl }
proc icmp-echo {mbl} {
get-for icmp-echo
get code enum 0 255 0.4
}
return [list $body $code]
}
-define icmp-echo-code 0 echo {} {}
+define icmp-echo-code 0 * echo {} {}
-define icmp-type 13 timestamp {mbl} { icmp-timestamp }
-define icmp-type 14 timestampreply {mbl} { icmp-timestamp }
+define icmp-type 13 * timestamp {mbl} { icmp-timestamp }
+define icmp-type 14 * timestampreply {mbl} { icmp-timestamp }
proc icmp-timestamp {} {
get-for icmp-timestamp
get code enum 0 255 0.4
}
return [list $body $code]
}
-define icmp-timestamp-code 0 timestamp {} {}
+define icmp-timestamp-code 0 * timestamp {} {}
-define icmp-type 15 inforequest {mbl} { icmp-inforeq }
-define icmp-type 16 inforeply {mbl} { icmp-inforeq }
+define icmp-type 15 * inforequest {mbl} { icmp-inforeq }
+define icmp-type 16 * inforeply {mbl} { icmp-inforeq }
proc icmp-inforeq {} {
get-for icmp-inforeq
get code enum 0 255 0.4
}
return [list $body $code]
}
-define icmp-inforeq-code 0 timestamp {} {}
+define icmp-inforeq-code 0 * timestamp {} {}
# MAYADD ICMP traceroute RFC1393
# MAYADD ICMP router discovery RFC1256
-define ip-proto 4 ip {mtu} {
+define ip-proto 4 * ip {mtu} {
# RFC2003
get-for ip-ip
get source v4addr
}
-define ip-proto 2 igmp {mtu} {
+define ip-proto 2 ? igmp {mtu} {
get-for igmp
get type enum 0 255 0.5
get timeout number 0 255
return $igmp
}
-define igmp-type 17 membquery {} {}
-define igmp-type 16 membreport {} {}
-define igmp-type 23 leavegroup {} {}
-define igmp-type 18 membreport {} {}
+define igmp-type 17 * membquery {} {}
+define igmp-type 16 * membreport {} {}
+define igmp-type 23 * leavegroup {} {}
+define igmp-type 18 * membreport {} {}
-define ip-proto 51 ah {mtu} {
+define ip-proto 51 ? ah {mtu} {
# RFC1826
get-for ah
get next number 0 255
return $port
}
-define ip-proto 17 udp {mtu} {
+define ip-proto 17 * udp {mtu} {
# RFC768
get-for udp
checksum_none 0.20 \
checksum_good]
+ set prand 0.50
get style choice-mult \
+ random $prand \
request 0.15 \
reply 0.15 \
- servers 0.20 \
- random
+ servers
if {"$style" != "random"} {
- get port enum-def
+ get port enum-def 0 255 $prand
set def_port $port
} else {
set def_port x
return $udp
}
-define udp-port 50 remailck {mtu style} {
+define udp-port 50 ?200 remailck {mtu style} {
# RFC1339
get-for remailck
if {"$style" == "request"} {
return $payload
}
-define remailck-auth 31 passwd {mtu} {
+define remailck-auth 31 * passwd {mtu} {
get-for remailck-passwd
get passwd string 6 8 \
0123456789abcdefghijklmnopqrstuvxwyz \
return $passwd
}
-define udp-port 67 dhcpserv {mtu style} { return [dhcp $mtu] }
-define udp-port 68 dhcpclient {mtu style} { return [dhcp $mtu] }
+define udp-port 67 ? dhcpserv {mtu style} { return [dhcp $mtu] }
+define udp-port 68 ? dhcpclient {mtu style} { return [dhcp $mtu] }
proc dhcp {mtu} {
get-for dhcp
get op enum 0 255 0.2
return $dhcp
}
-define dhcp-op 1 request {} {}
-define dhcp-op 2 reply {} {}
-define dhcp-htype 1 ethernet {} {}
+define dhcp-op 1 * request {} {}
+define dhcp-op 2 * reply {} {}
+define dhcp-htype 1 * ethernet {} {}
-define ip-proto 6 tcp {mtu} {
+define ip-proto 6 * tcp {mtu} {
# RFC793
get-for tcp
return $packet
}
-define tcp-opt 2 mss {mdl} {
+define tcp-opt 2 * mss {mdl} {
get-for tcp-opt
get mss hex 0 0xffff
assemble od {
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
} 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
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
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
}
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
--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" }
}
}
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]
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" }