chiark / gitweb /
Probability adjustment.
[vinegar-ip.git] / make-probes.tcl
index 034e690b30fdfbd791a1944dbdd56667df4e388a..9026c99a20848e7fdfcc30e8a2c32b86eac097d1 100755 (executable)
@@ -1,5 +1,25 @@
-#!/usr/bin/tclsh8.2
-
+#!/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
@@ -14,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 {}
 }
 
@@ -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} {
@@ -41,10 +64,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
     }
@@ -73,20 +94,26 @@ proc choice-int {min max} {
 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} {
     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]
     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
 }
 
@@ -103,11 +130,30 @@ proc config {cv 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
 }
 
@@ -119,7 +165,7 @@ proc depending-on {scope enum_and_var mtu mtuadjust args} {
             [catch { info body $procname }]} {
        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
@@ -145,6 +191,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
@@ -169,20 +218,50 @@ proc get/enum-rand {s v min max} {
     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 [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]
     }
 }
 
@@ -216,15 +295,16 @@ 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
     if {$maxlen<0} { getlog (full!); return {} }
-    get l number $minlen $maxlen
-    return [random-bytes $l]
+    get l number [expr {$minlen/$blockbytes}] [expr {$maxlen/$blockbytes}]
+    return [random-bytes [expr {$l*$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
 }
@@ -261,6 +341,12 @@ 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
@@ -469,11 +555,15 @@ namespace eval Assembler {
 }
 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
@@ -487,9 +577,7 @@ proc gen_1_ip {mtu} {
        get frag number 0 0x1fff
     }
     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
+    get proto enum 0 255 0.2
     set flags [expr {$df*2 + $mf}]
 
     set header_checksum 0
@@ -524,7 +612,7 @@ proc gen_1_ip {mtu} {
     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
@@ -543,38 +631,38 @@ define ip-proto 1 icmp {mtu} {
 }
 
 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
     get code enum 0 255 0.4
-    get body rand 0 $mbl
+    get body rand 0 $mbl 1
     return [list $body $code]
 }
 
 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
-    get data rand 0 [expr {$mbl-4}]
+    get data rand 0 [expr {$mbl-4}] 1
     assemble body {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |                 Gateway                                       |
@@ -585,19 +673,19 @@ define icmp-type 5 redirect {mbl} {
     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
     get id hex 0 0xffff
     get seq hex 0 0xffff
-    get data rand 0 [expr {$mbl-8}]
+    get data rand 0 [expr {$mbl-8}] 1
     assemble body {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |       Id                      |        Seq                    |
@@ -607,10 +695,10 @@ proc icmp-echo {mbl} {
     }
     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
@@ -632,10 +720,10 @@ proc icmp-timestamp {} {
     }
     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
@@ -648,53 +736,115 @@ proc icmp-inforeq {} {
     }
     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
 
-proc port-pair {scope} {
-    get-for $scope
 
-    get style choice-mult \
-           request 0.24 \
-           reply 0.24 \
-           random 0.16 \
-           servers
+define ip-proto 4 * ip {mtu} {
+    # RFC2003
+    get-for ip-ip
+    get source v4addr
+    get dest v4addr
+    gen_1_ip $mtu $source $dest
+}
 
-    if {"$style" != "random"} {
-       get port enum-def
-       set def_port $port
-    } else {
-       set def_port x
+
+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 {"$style" != "servers"} {
-       get port enum-rand 0 0xffff
-       set rand_port $port
+
+    if {[choice-prob igmp-extra 0.3]} {
+       get extra rand 1 [expr {$mtu - [packet-len $igmp]}] 1
+       assembly-overwrite igmp extra $extra
     }
-    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 }
+    
+    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 > 50 ? 50 : $mtu-8}] 4
+    set length [packet-len $auth_data]
+    assemble ah {
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+     | Next          |   Length      |           RESERVED            |
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+     |                    SPI                                        |
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+     |                 Auth Data ...                                 |
+     +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    return [list $source_port $dest_port $def_port $style]
+    get payload rand 0 [expr {$mtu - [packet-len $ah]}] 1
+    append ah $payload
+    return $ah
 }
 
-define ip-proto 17 udp {mtu} {
+proc udp-rport {} {
     get-for udp
+    get port enum-rand 0 0xffff
+    return $port
+}
 
-    get checksum choice-mult \
+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
-    manyset [port-pair udp] source_port dest_port def_port style
+           checksum_good]
+
+    set prand 0.50
+    get style choice-mult \
+           random $prand \
+           request 0.15 \
+           reply 0.15 \
+           servers
+
+    if {"$style" != "random"} {
+       get port enum-def 0 255 $prand
+       set def_port $port
+    } else {
+       set def_port x
+    }
+    switch -exact $style {
+       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 udp port $mtu -8 $style]
     } else {
-       get data rand 0 [expr {$mtu-8}]
+       get data rand 0 [expr {$mtu-8}] 1
     }
 
     set length 0
@@ -711,7 +861,10 @@ define ip-proto 17 udp {mtu} {
     set udp_length [packet-len $udp]
     assembly-overwrite udp length $udp_length
 
-    if {"$checksum" != "none"} {
+    if {"$csum_mode" == "checksum_none"} {
+       set checksum 0
+       getlog (nocsum)
+    } else {
        global ip_source ip_dest ip_proto
        assemble pseudo {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
@@ -722,20 +875,19 @@ define ip-proto 17 udp {mtu} {
    |       0       | IP Proto      |        UDP length             |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
        }
-       set csum [packet-csum-ip "$pseudo$udp"]
-       if {!$csum} { set csum 0xffff }
-       if {"$checksum" == "bad"} {
+       set checksum [packet-csum-ip "$pseudo$udp"]
+       if {!$checksum} { set checksum 0xffff }
+       if {"$csum_mode" == "checksum_bad"} {
            get csumerror hex 1 0xffff
-           set csum [expr {$csum ^ $csumerror}]
+           set checksum [expr {$checksum ^ $csumerror}]
        }
-    } else {
-       set csum 0
     }
-    assembly-overwrite udp checksum $csum
+    assembly-overwrite udp checksum $checksum
     return $udp
 }
 
-define udp-port 50 remailck {mtu style} {
+define udp-port 50 ?200 remailck {mtu style} {
+    # RFC1339
     get-for remailck
     if {"$style" == "request"} {
        get what choice-mult \
@@ -761,7 +913,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
@@ -827,7 +979,7 @@ define udp-port 50 remailck {mtu style} {
     return $payload
 }
 
-define remailck-auth 31 passwd {mtu} {
+define remailck-auth 31 passwd {mtu} {
     get-for remailck-passwd
     get passwd string 6 8 \
            0123456789abcdefghijklmnopqrstuvxwyz \
@@ -835,7 +987,56 @@ define remailck-auth 31 passwd {mtu} {
     return $passwd
 }
 
-define ip-proto 6 tcp {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
+    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
@@ -877,14 +1078,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
+           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 {
@@ -943,7 +1146,7 @@ define ip-proto 6 tcp {mtu} {
     assembly-overwrite packet d_off $d_off
 
     if {!($s || $r) || [get unexpdata flag 0.2]} {
-       get data rand 0 [expr {$mtu - [packet-len $packet]}]
+       get data rand 0 [expr {$mtu - [packet-len $packet]}] 1
        append packet $data
     }
     set tcp_length [packet-len $packet]
@@ -968,7 +1171,7 @@ define ip-proto 6 tcp {mtu} {
     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 {
@@ -1031,22 +1234,34 @@ namespace eval PCap {
 }
 namespace import PCap::*
 
-proc emit {count} {
-    global getlog_log errorInfo mtu
+proc emit {seed} {
+    global getlog_log errorInfo mtu fake_time_t
+    global minframelen linktypename errors_continue
+
+    get-for ip
+    get-config source 127.0.0.1 v4addr
+    get-config dest 127.0.0.1 v4addr
+
     if {[catch {
-       start_gen $count
-       set packet [gen_1_ip $mtu]
-       puts stdout "[format %6d $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"
+       if {!$errors_continue} {
+           error "internal error generating packet - consult author"
+       }
     } else {
-       set ts_sec [clock seconds]
+       set ts_sec [incr fake_time_t]
        set ts_usec 0
 
-       set llpkt [random-bytes 12] ;# ether addrs
-       append llpkt 0800 ;# eth ip type
-       append llpkt $packet
+       set l [packet-len $packet]
+       if {$l < $minframelen} {
+           append packet [string repeat 00 [expr {$minframelen - $l}]]
+       }
+
+       set llpkt [link/$linktypename/linkencap $packet]
        
        set len [packet-len "$llpkt"]
        pcap_write {
@@ -1060,6 +1275,30 @@ proc emit {count} {
 }
 
 
+# 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" }
@@ -1069,11 +1308,20 @@ 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 errors_continue 0
+set mtu 100
 set upto {}
 set xseed {}
+set linktypename ether
 while {[regexp {^\-\-} [lindex $argv 0]]} {
     set o [nextarg]
     switch -exact -- $o {
@@ -1083,17 +1331,32 @@ 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_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
 set thiszone 0
 set sigfigs 0
 set snaplen 131073
-set linktype 1
 
 pcap_write {
     x32 magic
@@ -1105,15 +1368,18 @@ pcap_write {
     s32 linktype
 }
 
-if {[llength $argv] && ![string length $upto]} {
+set fake_time_t 1000000000
+
+start_gen TEST
+random-bytes 100
+
+if {[llength $argv]} {
     foreach count $argv { emit "$xseed$count" }
-} elseif {![llength $argv]} {
+} else {
     if {![string length $upto]} { set upto 100 }
     for {set count 1} {$upto<0 || $count<=$upto} {incr count} {
        emit "$xseed$count"
     }
-} else {
-    error "bad mode"
 }
 
 pcap_close