X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=make-probes.tcl;h=ce215a8dbf6addb0346003588c515c9718b29600;hb=50d8d2725efd26a30bbc253c3e180c8da2831761;hp=6a033ff5aff84ff77a36367bb8f3593520a62c66;hpb=ad2750189b9e1151e46a33c2ba9e7506088a32da;p=vinegar-ip.git

diff --git a/make-probes.tcl b/make-probes.tcl
index 6a033ff..ce215a8 100755
--- a/make-probes.tcl
+++ b/make-probes.tcl
@@ -1,11 +1,29 @@
-#!/usr/bin/tclsh8.2
-
-
-set debug_level 1
+#!/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
-    if {$level < $debug_level} { puts stderr "debug\[$level] $str" }
+    if {$level <= $debug_level} { puts stderr "debug\[$level] $str" }
 }
 
 proc manyset {list args} {
@@ -16,9 +34,9 @@ proc manyset {list args} {
 }
 
 
-proc start_gen {use_gen_counter} {
-    global gen_counter rand_counter getlog_log rand_buf
-    random-bytes-init $use_gen_counter
+proc start_gen {seed} {
+    global getlog_log
+    random-bytes-init $seed
     set getlog_log {}
 }
 
@@ -27,10 +45,11 @@ proc packet-len {p} { expr {[string length $p]/2} }
 proc packet-csum-ip {packet} {
     set cs 0
     append packet 00
-    while {[regexp {^([0-9a-f][0-9a-f])(.*)$} $packet dummy this packet]} {
-	incr cs 0x$this
+    while {[regexp {^([0-9a-f]{4})(.*)$} $packet dummy this packet]} {
+	set cs [expr "\$cs + 0x$this"]
+	debug 7 [format "0x%s 0x%08x" $this $cs]
     }
-    return [expr {$cs & 0xffff}]
+    return [expr {(($cs & 0xffff) + (($cs >> 16) & 0xffff)) ^ 0xffff}]
 }
 
 proc packet-fromstring {s} {
@@ -42,10 +61,8 @@ namespace eval Random-Bytes {
     namespace export random-bytes random-bytes-init
 
     proc random-bytes-init {seed} {
-	variable counter
 	variable fh
 	catch { set h $fh; unset fh; close $h }
-	set counter 0
 	set fh [open |[list openssl bf-ofb < /dev/zero -e -k " $seed"] r]
 	fconfigure $fh -translation binary
     }
@@ -57,7 +74,6 @@ namespace eval Random-Bytes {
 	    error "openssl bf-ofb exited unexpectedly"
 	}
 	set y [packet-fromstring $x]
-	if {[string length $y] != $n*2} { error "binary format failed $n $y" }
 	return $y
     }
 }
@@ -80,8 +96,8 @@ proc choice-prob {cv def} {
 
 proc choice-mult {args} {
     if {!([llength $args] % 2)} { error "choice-mult must have default" }
-    set x 0x[random-bytes 3]
-    set x [expr { double($x) / double(0x1000000) }]
+    set h 0x[random-bytes 3]
+    set x [expr { double($h) / double(0x1000000) }]
     set cump 0.0
     set def [lindex $args end]
     set args [lreplace $args end end]
@@ -119,10 +135,9 @@ proc depending-on {scope enum_and_var mtu mtuadjust args} {
     set procname enum/val/$scope-$enum_and_var/[format %d $val]
     if {[choice-prob $enum_and_var-unstruct 0.1] ||
             [catch { info body $procname }]} {
-	# half the time random
 	getlog (junk)
 	get-for $scope-fill
-	get data rand 0 $mtu
+	get data rand 0 $mtu 1
 	return $data
     } else {
 	uplevel 1 [list $procname] $mtu $args
@@ -175,7 +190,7 @@ proc get/enum-rand {s v min max} {
 proc get/enum-def {s v} {
     upvar #0 enum/val2name/$s-$v v2n
     set rv [choice-int 1 [array size v2n]]
-    set rv [lindex [array names v2n] [expr {$rv-1}]]
+    set rv [lindex [lsort [array names v2n]] [expr {$rv-1}]]
     return [get-enum-got $s $v $rv]
 }
 
@@ -201,6 +216,12 @@ proc get/hex {s v min max} {
     return $rv
 }
 
+proc get/hex32 {s v} {
+    set rv [random-bytes 4]
+    getlog "$v=0x$rv"
+    return 0x$rv
+}
+
 proc get/flag {s v defprob} {
     set rv [choice-prob $s-$v $defprob]
     if {$rv} { getlog "$v" } else { getlog "!$v" }
@@ -213,10 +234,11 @@ proc get/choice {s v defprob} {
     return $rv
 }
 
-proc get/rand {s v minlen maxlen} {
+proc get/rand {s v minlen maxlen blockbytes} {
     get-for $s-$v
-    get l number $minlen $maxlen
-    return [random-bytes $l]
+    if {$maxlen<0} { getlog (full!); return {} }
+    get l number [expr {$minlen/$blockbytes}] [expr {$maxlen/$blockbytes}]
+    return [random-bytes [expr {$l*$blockbytes}]]
 }
 
 proc get/ip-timestamp {s v} {
@@ -257,164 +279,235 @@ proc get/string {s v minlen maxlen first rest} {
     return [packet-fromstring $o]
 }
 
+proc get/ntstring {s v minlen maxlen first rest} {
+    set s [get/string $s $v $minlen $maxlen $first $rest]
+    append s 00
+    append s [random-bytes $maxlen]
+    return [string range $s 0 [expr {$maxlen*2-1}]]
+}
+
+namespace eval Assembler {
+    namespace export assemble assembly-overwrite
+
+    proc assemble {outvarname format} {
+	# format should look like those RFC diagrams.  +-+-+ stuff and
+	# good formatting is mandatory.  You can have a single data
+	# item at the end ending in ..., which means append that data
+	# item.
+	#
+	# Field names are converted to lowercase; internal spaces
+	# are replaced with _.  They are then assumed to be
+	# variable names in the caller's scope.  The packet is
+	# assembled from those values (which must all be set)
+	# and stored in $varname in the caller's scope.
+	#
+	# Variables ?_whatever will be *set* with the location of the
+	# field in the string (in internal format); the corresponding
+	# `whatever' (with the ?_ stripped) will be read when assembling.
+	#
+	# Field names starting with digits are literal values instead.
+
+	variable cache
+	upvar 1 $outvarname out
+	if {[catch { set parsed $cache($format) }]} {
+	    set parsed [parse $format]
+	    set cache($format) $parsed
+	}
 
-proc assemble {outvarname format} {
-    # format should look like those RFC diagrams.
-    # +-+-+ stuff and good formatting is mandatory.
-    # Tabs are forbidden.
-    #
-    # Field names are converted to lowercase; internal spaces
-    # are replaced with _.  They are then assumed to be
-    # variable names in the caller's scope.  The packet is
-    # assembled from those values (which must all be set)
-    # and stored in $varname in the caller's scope.
-    #
-    # Variables ?_whatever will be *set* with the location of the
-    # field in the string (in internal format); the corresponding
-    # `whatever' (with the ?_ stripped) will be read when assembling.
-    #
-    # Field name `0' means set the field to zero.
-
-    upvar 1 $outvarname out
-    set out {}
-    set lno 0
-    debug 7 "ASSEMBLY $outvarname\n$format"
-    foreach l [split $format "\n"] {
-	incr lno
-	if {[regexp -nocase {^ *\| +\| *$} $l]} {
-	    if {![info exists wordbits]} {
-		error "vspace not in data @$lno\n?$l?"
+	manyset $parsed outbytes lout
+	set out [string repeat 00 $outbytes]
+	foreach {?_location varname locvarname} $lout {
+	    if {[regexp {^[0-9]} $varname]} {
+		set value $varname
+	    } else {
+		set value [uplevel 1 [list set $varname]]
 	    }
-	    incr words
-	} elseif {[regexp -nocase {^ *[|? a-z0-9]+$} $l]} {
-	    if {[info exists words]} {
-		error "data without delimline @$lno\n?$l?"
+	    if {[string length $locvarname]} {
+		upvar 1 $locvarname lv
+		set lv ${?_location}
 	    }
-	    set words 1
-	    set cue $l
-	} elseif {[regexp {^ *[-+]+ *$} $l]} {
-	    set wordbits 0
-	    set newlineform {}
-	    while {[regexp {^([-= ]+)\+(.*)$} $l dummy before after]} {
-		set atpos([string length $before]) $wordbits
-		incr wordbits
-		set l "$before=$after"
-		append newlineform "@[string length $before]:$wordbits "
+	    if {[catch {
+		assembly-overwrite out location $value
+	    } emsg]} {
+		global errorInfo errorCode
+		error $emsg \
+			"$errorInfo\n    setting\n$varname at ${?_location}" \
+			$errorCode
 	    }
-	    incr wordbits -1
-	    append newlineform $wordbits
-	    if {[info exists lineform]} {
-		if {"$newlineform" != "$lineform"} {
- error "format change @$lno\n?$l?\n$wordformat != $oldwordformat"
+	}
+    }
+
+    proc parse {format} {
+	set lno 0
+	set outbytes 0
+	set atend 0
+	debug 7 "ASSEMBLY $format"
+	set format [exec expand << $format]
+	foreach l [split $format "\n"] {
+	    incr lno
+	    if {[regexp -nocase {^ *\| +\| *$} $l]} {
+		if {![info exists wordbits]} {
+		    error "vspace not in data @$lno\n?$l?"
 		}
-		if {![info exists words] || $words<0} {
-		    error "consecutive delimlines @$lno\n?$l?"
+		incr words
+	    } elseif {[regexp -nocase {^ *[|? a-z0-9.]+$} $l]} {
+		if {[info exists words]} {
+		    error "data without delimline @$lno\n?$l?"
 		}
-		append out [string repeat 00 [expr {$words*$wordbits/8}]]
-		set l $cue
-		while {[regexp -nocase \
-			{^([ =]*)\|( *[? a-z0-9]*[a-z0-9] *)\|(.*)$} \
-			$l dummy before midpart after]} {
-		    debug 7 "RWORKG ?$l?"
-		    set varname [string tolower [string trim $midpart]]
-		    set varname [string map {{ } _} $varname]
-		    set p1 [string length $before]
-		    set p2 [expr {
-			[string length $before] +
-			[string length $midpart] + 1
-		    }]
-		    if {![info exists atpos($p1)] ||
-			![info exists atpos($p2)]} {
+		set words 1
+		set cue $l
+	    } elseif {[regexp {^ *[-+]+ *$} $l]} {
+		set wordbits 0
+		set newlineform {}
+		while {[regexp {^([-= ]+)\+(.*)$} $l dummy before after]} {
+		    set atpos([string length $before]) $wordbits
+		    incr wordbits
+		    set l "$before=$after"
+		    append newlineform "@[string length $before]:$wordbits "
+		}
+		incr wordbits -1
+		append newlineform $wordbits
+		if {[info exists lineform]} {
+		    if {"$newlineform" != "$lineform"} {
+ error "format change @$lno\n?$l?\n$wordformat != $oldwordformat"
+		    }
+		    if {![info exists words] || $words<0} {
+			error "consecutive delimlines @$lno\n?$l?"
+		    }
+		    incr outbytes [expr {$words*$wordbits/8}]
+		    set l $cue
+		    while {[regexp -nocase \
+			    {^([ =]*)\|( *[? a-z0-9]*[a-z0-9] *\.* *)\|(.*)$} \
+			    $l dummy before midpart after]} {
+			debug 7 "RWORKG ?$l?"
+			if {$atend} {
+			    error "two things at end @$lno\n?$l?"
+			}
+			set varname [string tolower [string trim $midpart]]
+			if {[regexp {(.*[a-z0-9])\s*\.\.\.$} $varname \
+				dummy realvarname]} {
+			    set varname $realvarname
+			    set atend 1
+			}
+			set varname [string map {{ } _} $varname]
+			set p1 [string length $before]
+			set p2 [expr {
+			    [string length $before] +
+			    [string length $midpart] + 1
+			}]
+			if {![info exists atpos($p1)] ||
+			    ![info exists atpos($p2)]} {
  error "vdelims not found @$lno $varname $p1 $p2 -- $lineform ?$cue?"
+			}
+			set bit1 [expr {
+			    $outbytes*8
+			    - $words*$wordbits
+			    + $atpos($p1)
+			}]
+			set bitlen [expr {
+			    $atpos($p2) - $atpos($p1) + ($words-1)*$wordbits
+			}]
+			if {$atend} {
+			    if {$bit1 % 8} {
+				error "atend not at byte @$lno\n?$l?"
+			    }
+			    set outbytes [expr {$bit1/8}]
+			    set location [list $bit1 0 $varname]
+			} else {
+			    set location [list $bit1 $bitlen $varname]
+			}
+			if {[regexp {^\?_(.*)} $varname dummy realvarname]} {
+			    debug 7 "LOCATING $varname $location"
+			    set locvarname $varname
+			    set varname $realvarname
+			} else {
+			    set locvarname {}
+			}
+			lappend lout $location $varname $locvarname
+			set l "$before="
+			append l [string repeat = [string length $midpart]]
+			append l |$after
 		    }
-		    set bit1 [expr {
-			[string length $out]*4
-			- $words*$wordbits
-			+ $atpos($p1)
-		    }]
-		    set bitlen [expr {
-			$atpos($p2) - $atpos($p1) + ($words-1)*$wordbits
-		    }]
-		    set location [list $bit1 $bitlen $outvarname-$varname]
-		    if {[regexp {^\?_(.*)} $varname dummy realvarname]} {
-			debug 7 "LOCATING $varname $location"
-			upvar 1 $varname locvarname
-			set locvarname $location
-                        set varname $realvarname
+		    debug 7 "REMAIN ?$l?"
+		    if {![regexp {^[ =]*\|? *$} $l]} {
+			error "unclear @$lno\n?$l?"
 		    }
-		    if {"$varname" == "0"} {
-			set value 0
-		    } else {
-			set value [uplevel 1 [list set $varname]]
+		} else {
+		    if {$wordbits % 8 || $wordbits >32} {
+			error "bad wordbits $wordbits @$lno ?$l? $newlineform"
 		    }
-		    assembly-overwrite out $location $value
-		    set l "$before="
-		    append l [string repeat = [string length $midpart]]
-		    append l |$after
+		    set lineform $newlineform
 		}
-		debug 7 "REMAIN ?$l?"
+		catch { unset words }
+	    } elseif {[regexp {^ *$} $l]} {
 	    } else {
-		if {$wordbits % 8 || $wordbits >32} {
-		    error "bad wordbits $wordbits @$lno ?$l? $newlineform"
-		}
-		set lineform $newlineform
+		error "huh? @$lno ?$l?"
 	    }
-	    catch { unset words }
-	} elseif {[regexp {^ *$} $l]} {
-	} else {
-	    error "huh? @$lno ?$l?"
 	}
+	debug 7 "ASSEMBLY\n$outbytes\n$lout\n"
+	return [list $outbytes $lout]
     }
-    debug 7 "ASSEMBLY\n$out\n"
-    return $out
-}
 
-proc assembly-overwrite {outvarname location value} {
-    upvar 1 $outvarname out
-    manyset $location bit1 bitlen diag
-    debug 8 "ASSEMBLY $diag == $value == 0x[format %x $value] (@$bit1+$bitlen)"
-    if {$bitlen < 32 && $value >= (1<<$bitlen)} {
-	error "$diag $value >= 2**$bitlen"
-    }
-    if {!($bit1 % 8) && !($bitlen % 8)} {
-	set char0no [expr {$bit1/4}]
-	set charlen [expr {$bitlen/4}]
-	set chareno [expr {$char0no + $charlen -1}]
-	set repl [format %0${charlen}x $value]
-	set out [string replace $out $char0no $chareno $repl]
-    } else {
-	while {$bitlen > 0} {
-	    set byteno [expr {$bit1 / 8}]
-	    set char0no [expr {$byteno*2}]
-	    set char1no [expr {$char0no+1}]
-	    set bytebit [expr {128>>($bit1 % 8)}]
-	    set byte 0x[string range $out $char0no $char1no]
-	    debug 7 "< $bit1+$bitlen $byteno $char0no $bytebit $byte $out"
-	    set byte [expr {
-		($value & (1<<($bitlen-1)))
-		? ($byte | $bytebit)
-		: ($byte & ~$bytebit)
-	    }]
-	    set out [string replace $out $char0no $char1no [format %02x $byte]]
+    proc assembly-overwrite {outvarname locvarnameex value} {
+	upvar 1 $outvarname out
+	upvar 1 ?_$locvarnameex location
+	manyset $location bit1 bitlen diag
+	if {$bitlen > 0 && $bitlen != 32 && $value >= (1<<$bitlen)} {
+	    error "$diag $value >= 2**$bitlen"
+	}
+	if {!($bit1 % 8) && !($bitlen % 8)} {
+	    set char0no [expr {$bit1/4}]
+	    set charlen [expr {$bitlen/4}]
+	    set chareno [expr {$char0no + $charlen -1}]
+	    if {$bitlen > 0} {
+ debug 8 "ASSEMBLY $diag == $value == 0x[format %x $value] (@$bit1+$bitlen)"
+		set repl [format %0${charlen}x $value]
+		set out [string replace $out $char0no $chareno $repl]
+	    } else {
+ debug 8 "ASSEMBLY-ADD $diag (@$bit1)"
+		# bitlen==0 => append
+		set out [string range $out 0 $chareno]
+		append out $value
+	    }
+	} else {
+	    while {$bitlen > 0} {
+		set byteno [expr {$bit1 / 8}]
+		set char0no [expr {$byteno*2}]
+		set char1no [expr {$char0no+1}]
+		set bytebit [expr {128>>($bit1 % 8)}]
+		set byte 0x[string range $out $char0no $char1no]
+		debug 7 "< $bit1+$bitlen $byteno $char0no $bytebit $byte $out"
+		set byte [expr {
+		    ($value & (1<<($bitlen-1)))
+		    ? ($byte | $bytebit)
+		    : ($byte & ~$bytebit)
+		}]
+		set out [string replace $out $char0no $char1no \
+			[format %02x $byte]]
  debug 8 "> $bit1+$bitlen $byteno $char0no $bytebit 0x[format %02x $byte] $out"
-	    incr bitlen -1
-	    incr bit1
+		incr bitlen -1
+		incr bit1
+	    }
 	}
     }
 }
+namespace import Assembler::*
 
-
-proc gen_1_ip {mtu} {
+proc gen_1_ip {mtu source_spec dest_spec} {
     # RFC791
     upvar #0 ip_proto proto
     upvar #0 ip_source source
     upvar #0 ip_dest dest
+
+    set source $source_spec
+    set dest $dest_spec
+    
     get-for ip
     set version 4
     get tos hex 0x00 0xff
-    get id hex 0x0000 0xffff
+    get id number 0x0000 0xffff
     get df flag 0.5
-    if {$df} {
+    if {$df || ![choice-prob ip-midfrag 0.05]} {
 	set mf 0
 	set frag 0
     } {
@@ -423,17 +516,14 @@ proc gen_1_ip {mtu} {
     }
     get-config ttl 255 number 0 255
     get proto enum 1 255 0.05
-    get-config source 127.0.0.1 v4addr
-    get-config dest 127.0.0.1 v4addr
-    # we don't do any IP options
-    set ihl 5
-    set body [depending-on ip proto $mtu [expr {-4*$ihl}]]
-    set total_length [expr {$ihl + [packet-len $body]}]
-    set header_checksum 0
     set flags [expr {$df*2 + $mf}]
+
+    set header_checksum 0
+    set ihl 0
+    set total_length 0
     assemble ip {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-   |Version|  IHL  |TOS            |         Total Length          |
+   |Version| ? IHL |TOS            |       ? Total Length          |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |         Id                    |Flags|      Frag               |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
@@ -444,7 +534,18 @@ proc gen_1_ip {mtu} {
    |                    Dest                                       |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    assembly-overwrite ip ${?_header_checksum} [packet-csum-ip $ip]
+    # we don't do any IP options
+
+    set ihl [packet-len $ip]
+    if {$ihl % 4} { error "ihl not mult of 4 bytes" }
+    assembly-overwrite ip ihl [expr {$ihl / 4}]
+
+    set body [depending-on ip proto $mtu -$ihl]
+    set total_length [expr {[packet-len $ip] + [packet-len $body]}]
+
+    assembly-overwrite ip total_length $total_length
+    assembly-overwrite ip header_checksum [packet-csum-ip $ip]
+
     append ip $body
     return $ip
 }
@@ -459,10 +560,11 @@ define ip-proto 1 icmp {mtu} {
     assemble icmp {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |     Type      |     Code      |        ? Checksum             |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Body ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    append icmp $body
-    assembly-overwrite icmp ${?_checksum} [packet-csum-ip $icmp]
+    assembly-overwrite icmp checksum [packet-csum-ip $icmp]
     return $icmp
 }
 
@@ -472,7 +574,7 @@ proc define-icmp-type-vanilla {num name} {
 proc icmp-vanilla {mbl typename} {
     get-for icmp-$typename
     get code enum 0 255 0.4
-    get body rand 0 $mbl
+    get body rand 0 $mbl 1
     return [list $body $code]
 }
 
@@ -498,13 +600,14 @@ define icmp-type 5 redirect {mbl} {
     get-for icmp-redirect
     get code enum 0 255 0.4
     get gateway v4addr
+    get data rand 0 [expr {$mbl-4}] 1
     assemble body {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |                 Gateway                                       |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Data ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    get data rand 0 [expr {$mbl-4}]
-    append body $data
     return [list $body $code]
 }
 
@@ -520,13 +623,14 @@ proc icmp-echo {mbl} {
     get code enum 0 255 0.4
     get id hex 0 0xffff
     get seq hex 0 0xffff
+    get data rand 0 [expr {$mbl-8}] 1
     assemble body {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |       Id                      |        Seq                    |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Data ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    get data rand 0 [expr {$mbl-8}]
-    append body $data
     return [list $body $code]
 }
 define icmp-echo-code 0 echo {} {}
@@ -575,69 +679,152 @@ define icmp-inforeq-code 0 timestamp {} {}
 # MAYADD ICMP traceroute RFC1393
 # MAYADD ICMP router discovery RFC1256
 
-proc port_pair_data {scope mtu mtuadjust} {
-    get-for $scope
+
+define ip-proto 4 ip {mtu} {
+    # RFC2003
+    get-for ip-ip
+    get source v4addr
+    get dest v4addr
+    gen_1_ip $mtu $source $dest
+}
+
+
+define ip-proto 2 igmp {mtu} {
+    get-for igmp
+    get type enum 0 255 0.5
+    get timeout number 0 255
+    get group v4addr
+    set checksum 0
+    set extra {}
+    assemble igmp {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |      Type     |   Timeout     |         ? Checksum            |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                         Group                                 |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                       ? Extra ...                             |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+
+    if {[choice-prob igmp-extra 0.3]} {
+	get extra rand 1 [expr {$mtu - [packet-len $igmp]}] 1
+	assembly-overwrite igmp extra $extra
+    }
+    
+    assembly-overwrite igmp checksum [packet-csum-ip $igmp]
+    return $igmp
+}
+
+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} {
+    # RFC1826
+    get-for ah
+    get next number 0 255
+    get reserved hex 0 0xffff
+    get spi hex32
+    get auth_data rand 0 [expr {$mtu-8}] 4
+    set length [packet-len $auth_data]
+    assemble ah {
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+     | Next          |   Length      |           RESERVED            |
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+     |                    SPI                                        |
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+     |                 Auth Data ...                                 |
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    get payload rand 0 [expr {$mtu - [packet-len $ah]}] 1
+    append ah $payload
+    return $ah
+}
+
+proc udp-rport {} {
+    get-for udp
+    get port enum-rand 0 0xffff
+    return $port
+}
+
+define ip-proto 17 udp {mtu} {
+    # RFC768
+    get-for udp
+
+    set csum_mode [choice-mult \
+	    checksum_bad 0.10 \
+	    checksum_none 0.20 \
+	    checksum_good]
 
     get style choice-mult \
-	    request 0.24 \
-	    reply 0.24 \
-	    random 0.16 \
-	    servers
+	    request 0.15 \
+	    reply 0.15 \
+	    servers 0.20 \
+	    random
 
     if {"$style" != "random"} {
 	get port enum-def
 	set def_port $port
-    }
-    if {"$style" != "servers"} {
-	get port enum-rand 0 0xffff
-	set rand_port $port
+    } else {
+	set def_port x
     }
     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"} {
 	set port $def_port
-	set data [depending-on $scope port $mtu $mtuadjust $style]
+	set data [depending-on udp port $mtu -8 $style]
     } else {
-	get data rand 0 [expr {$mtu + $mtuadjust}]
+	get data rand 0 [expr {$mtu-8}] 1
     }
-    return [list $source_port $dest_port $data]
-}
 
-define ip-proto 17 udp {mtu} {
-    get-for udp
-    get checksum choice-mult \
-	    checksum_bad 0.20 \
-	    checksum_none 0.20 \
-	    checksum_good
-    manyset [port_pair_data udp $mtu 8] source_port dest_port data
-    set length [packet-len $data]
+    set length 0
     set checksum 0
     assemble udp {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |       Source Port             |        Dest Port              |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-   |         Length                |      ? Checksum               |
+   |       ? Length                |      ? Checksum               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Data ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    append udp $data
-    if {"$checksum" != "none"} {
-	set csum [packet-csum-ip $udp]
-	if {!$csum} { set csum 0xffff }
-	if {"$checksum" == "bad"} {
-	    get error hex 1 0xffff
-	    set csum [expr {$csum ^ $error}]
-	}
+    set udp_length [packet-len $udp]
+    assembly-overwrite udp length $udp_length
+
+    if {"$csum_mode" == "checksum_none"} {
+	set checksum 0
+	getlog (nocsum)
     } else {
-	set csum 0
+	global ip_source ip_dest ip_proto
+	assemble pseudo {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       IP Source                                               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       IP Dest                                                 |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       0       | IP Proto      |        UDP length             |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+	}
+	set checksum [packet-csum-ip "$pseudo$udp"]
+	if {!$checksum} { set checksum 0xffff }
+	if {"$csum_mode" == "checksum_bad"} {
+	    get csumerror hex 1 0xffff
+	    set checksum [expr {$checksum ^ $csumerror}]
+	}
     }
-    assembly-overwrite udp ${?_checksum} $csum
+    assembly-overwrite udp checksum $checksum
+    return $udp
 }
 
 define udp-port 50 remailck {mtu style} {
+    # RFC1339
     get-for remailck
     if {"$style" == "request"} {
 	get what choice-mult \
@@ -663,7 +850,7 @@ define udp-port 50 remailck {mtu style} {
 	}
 	req-baduser {
 	    set auth 0
-	    get user rand 0 [expr {$mtu - 4}]
+	    get user rand 0 [expr {$mtu - 4}] 1
 	}
 	req-auth {
 	    get auth enum 0 31 0.5
@@ -705,15 +892,16 @@ define udp-port 50 remailck {mtu style} {
     }
     switch -glob $what {
 	req-* {
-            assemble packet {
+            assemble payload {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |         Auth                                                  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     User ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
             }
-	    append packet $user
 	}
 	resp-* {
-	    assemble packet {
+	    assemble payload {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |         Auth                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
@@ -725,7 +913,7 @@ define udp-port 50 remailck {mtu style} {
 	}
 	default { error "what?? $what" }
     }
-    return $packet
+    return $payload
 }
 
 define remailck-auth 31 passwd {mtu} {
@@ -736,24 +924,353 @@ define remailck-auth 31 passwd {mtu} {
     return $passwd
 }
 
+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
+    get htype enum 0 255 0.2
+    set hlen 6
+    get hops number 0 255
+    get xid hex32
+    get secs number 0 300
+    get flags hex 0 255
+    get ciaddr v4addr
+    get yiaddr v4addr
+    get siaddr v4addr
+    get giaddr v4addr
+    set chaddr [random-bytes 16]
+    get sname ntstring 0 64 \
+	    0123456789abcdefghijklmnopqrstuvwxyz \
+	    0123456789abcdefghijklmnopqrstuvwxyz.-+
+    get file ntstring 0 128 / \
+	    0123456789abcdefghijklmnopqrstuvwxyz.-+/_
+
+    assemble dhcp {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     op        |   htype       |   hlen        |   hops        |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                            xid                                |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |           secs                |           flags               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                          ciaddr                               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                          yiaddr                               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                          siaddr                               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                          giaddr                               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    append dhcp $chaddr $sname $file
+
+    return $dhcp
+}
+define dhcp-op 1 request {} {}
+define dhcp-op 2 reply {} {}
+define dhcp-htype 1 ethernet {} {}
+
+
+define ip-proto 6 tcp {mtu} {
+    # RFC793
+    get-for tcp
+
+    get source_port number 0 65535
+    get dest_port number 0 65535
+    get event choice-mult \
+	    connect 0.15 \
+	    accept 0.15 \
+	    close 0.15 \
+	    reset 0.15 \
+	    weird 0.15 \
+	    data
+    set s 0
+    set a 1
+    set f 0
+    set r 0
+    switch -exact $event {
+	connect { set s 1; set a 0 }
+	accept { set s 1 }
+	close { set f 1 }
+	reset { set a 0; set r 1 }
+	data { }
+	weird {
+	    get s flag 0.5
+	    get a flag 0.5
+	    get f flag 0.5
+	    get r flag 0.5
+	}
+	default { error "event? $event" }
+    }
+    get seq hex32
+    get ack hex32
+    if {[choice-prob tcp-smallwindow 0.7]} {
+	get window number 0 1
+    } else {
+	get window hex 0 0xffff
+    }
+    get p flag 0.5
+    get u flag 0.3
+    get urg hex 0 0xffff
+
+    set options {}
+    get optmode choice-mult badopt 0.3 opt 0.3 noopt
+    switch -exact $optmode {
+	noopt { }
+	badopt {
+	    get options rand 1 60 1
+	}
+	opt {
+	    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 {
+   +-+-+-+-+-+-+-+-+
+   |  Opt          |
+   +-+-+-+-+-+-+-+-+
+		    }
+		} else {
+		    set data [depending-on tcp opt 6 0]
+		    set option_len 0
+		    assemble option {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |  Opt          | ? Option Len  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |      Data ...                 |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+		    }
+		    assembly-overwrite option option_len [packet-len $option]
+		}
+		append options $option
+	    }
+	}
+    }
+
+    if {[choice-prob reserved-nonzero 0.25]} {
+	get reserved hex 0 0x3f
+    } else {
+	set reserved 0
+    }
+
+    if {[packet-len $options] % 4 || [get optxpad choice 0.15]} {
+	if {"$optmode" != "badopt"} { append options 00 }
+	set padlen [expr {3 - ([packet-len $options] + 3) % 4}]
+	append options [random-bytes $padlen]
+    }
+
+    set d_off 0
+    set checksum 0
+    assemble packet {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |          Source Port          |       Dest Port               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                        Seq                                    |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                    Ack                                        |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |? D Off| Reserved  |U|A|P|R|S|F|            Window             |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |         ? Checksum            |         Urg                   |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                    Options     ...                            |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+
+    set d_off [expr {([packet-len $packet]/4) & 0x0f}]
+    assembly-overwrite packet d_off $d_off
+
+    if {!($s || $r) || [get unexpdata flag 0.2]} {
+	get data rand 0 [expr {$mtu - [packet-len $packet]}] 1
+	append packet $data
+    }
+    set tcp_length [packet-len $packet]
+
+    global ip_source ip_dest ip_proto
+    assemble pseudo {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       IP Source                                               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       IP Dest                                                 |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       0       | IP Proto      |        TCP length             |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+
+    set csum [packet-csum-ip "$pseudo$packet"]
+    if {[choice-prob tcp-badcsum 0.1]} {
+	get csumerror hex 1 0xffff
+	set csum [expr {$csum ^ $csumerror}]
+    }
+    assembly-overwrite packet checksum $csum
+    return $packet
+}
+
+define tcp-opt 2 mss {mdl} {
+    get-for tcp-opt
+    get mss hex 0 0xffff
+    assemble od {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |        MSS                    |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    return $od
+}
+
+
+namespace eval PCap {
+    namespace export pcap_open pcap_write pcap_write_raw pcap_close
+
+    proc pcap_open {fn} {
+	variable fh
+	catch { close $fh }
+	set fh [open $fn w]
+	fconfigure $fh -translation binary
+    }
+
+    proc pcap_close {} {
+	variable fh
+	if {![info exists fh]} return
+	close $fh
+	unset fh
+    }
+
+    proc pcap_write_raw {packet} {
+	variable fh
+	if {![info exists fh]} return
+	puts -nonewline $fh [binary format H* $packet]
+    }
+
+    proc pcap_write {valdeflist} {
+	foreach {kind valvar} $valdeflist {
+	    if {![regexp {^([usx])([0-9]+)} $kind dummy mode bits]} {
+		error "unknown kind $kind for $valvar"
+	    }
+	    set value [uplevel 1 [list set $valvar]]
+	    if {$bits % 8} { error "bits must be mult 8 in $kind for $valvar" }
+	    if {"$mode" != "x"} {
+		set v {}
+		set ov $value
+		for {set i 0} {$i<$bits/8} {incr i} {
+		    append v [format %02x [expr {$value & 0xff}]]
+		    set value [expr {$value >> 8}]
+		}
+		if {$value != 0 && $value != -1} {
+		    error "value $ov more than $bits bits (residue=$value)"
+		}
+		set value $v
+	    }
+	    if {[string length $value] != $bits/4} {
+		error "$valvar value $value wrong length, not $bits bits"
+	    }
+	    pcap_write_raw $value
+	}
+    }
+}
+namespace import PCap::*
+
+proc emit {seed} {
+    global getlog_log errorInfo mtu fake_time_t
+    global minframelen
+
+    get-for ip
+    get-config source 127.0.0.1 v4addr
+    get-config dest 127.0.0.1 v4addr
 
-proc emit {count} {
-    global getlog_log errorInfo
     if {[catch {
-	start_gen $count
-	set packet [gen_1_ip 576]
-	puts stdout "[format %06d $count] $getlog_log\n       $packet"
+	start_gen $seed
+	set packet [gen_1_ip $mtu $source $dest]
+	puts stdout "[format %6s $seed] $getlog_log\n       $packet"
     } emsg]} {
-	puts stderr "\nERROR\n$count\n\n$emsg\n\n$errorInfo\n\n"
-	puts stdout "[format %06d $count] error"
+	puts stderr "\nERROR\n$seed\n\n$emsg\n\n$errorInfo\n\n"
+	puts stdout "[format %6s $seed] error"
+    } else {
+	set ts_sec [incr fake_time_t]
+	set ts_usec 0
+
+	set l [packet-len $packet]
+	if {$l < $minframelen} {
+	    append packet [string repeat 00 [expr {$minframelen - $l}]]
+	}
+
+	# RFC894
+	set llpkt [random-bytes 12]
+	append llpkt 0800
+	append llpkt $packet
+	
+	set len [packet-len "$llpkt"]
+	pcap_write {
+	    u32 ts_sec
+	    u32 ts_usec
+	    u32 len
+	    u32 len
+	}
+	pcap_write_raw $llpkt
     }
 }
 
-if {![llength $argv]} {
-    for {set count 1} {$count < 100} {incr count} { emit $count }
-} elseif {"$argv" == "--infinite"} {
-    set count 1
-    while 1 { emit $count; incr count }
+
+proc nextarg {} {
+    global argv
+    if {![llength $argv]} { error "need another arg" }
+    set a [lindex $argv 0]
+    set argv [lrange $argv 1 end]
+    return $a
+}
+
+proc nextarg_num {} { return [expr {[nextarg] + 0}] }
+
+set debug_level 0
+set mtu 576
+set upto {}
+set xseed {}
+while {[regexp {^\-\-} [lindex $argv 0]]} {
+    set o [nextarg]
+    switch -exact -- $o {
+	--infinite { set upto -1 }
+	--debug { set debug_level [nextarg_num] }
+	--upto { set upto [nextarg_num] }
+	--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] }
+	default { error "bad option $o" }
+    }
+}
+
+set magic d4c3b2a1
+set version_major 2
+set version_minor 4
+set thiszone 0
+set sigfigs 0
+set snaplen 131073
+
+# RFC894
+set linktype 1
+set minframelen 46
+
+pcap_write {
+    x32 magic
+    u16 version_major
+    u16 version_minor
+    s32 thiszone
+    s32 sigfigs
+    s32 snaplen
+    s32 linktype
+}
+
+set fake_time_t [clock seconds]
+
+if {[llength $argv]} {
+    foreach count $argv { emit "$xseed$count" }
 } else {
-    foreach count $argv { emit $count }
+    if {![string length $upto]} { set upto 100 }
+    for {set count 1} {$upto<0 || $count<=$upto} {incr count} {
+	emit "$xseed$count"
+    }
 }
+
+pcap_close