-#!/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} {
}
-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 {}
}
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} {
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
}
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
}
}
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]
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
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]
}
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" }
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} {
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
} {
}
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 |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| 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
}
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
}
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]
}
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]
}
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 {} {}
# 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 \
}
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
}
switch -glob $what {
req-* {
- assemble packet {
+ assemble payload {
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Auth |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | User ... |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
- append packet $user
}
resp-* {
- assemble packet {
+ assemble payload {
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Auth |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
default { error "what?? $what" }
}
- return $packet
+ return $payload
}
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
~ianmdlvl / vinegar-ip.git / blobdiff