#!/usr/bin/tclsh8.2
-set debug_level 1
-
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 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} {
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
}
}
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
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" }
proc get/rand {s v minlen maxlen} {
get-for $s-$v
+ if {$maxlen<0} { getlog (full!); return {} }
get l number $minlen $maxlen
return [random-bytes $l]
}
}
-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?"
+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
+ }
+
+ 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?"
+ }
+ incr words
+ } elseif {[regexp -nocase {^ *[|? a-z0-9.]+$} $l]} {
+ if {[info exists words]} {
+ error "data without delimline @$lno\n?$l?"
}
- if {![info exists words] || $words<0} {
- error "consecutive delimlines @$lno\n?$l?"
+ 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 "
}
- 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)]} {
+ 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} {
# RFC791
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 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
}
get-for icmp-redirect
get code enum 0 255 0.4
get gateway v4addr
+ get data rand 0 [expr {$mbl-4}]
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}]
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} {
+proc port-pair {scope} {
get-for $scope
get style choice-mult \
if {"$style" != "random"} {
get port enum-def
set def_port $port
+ } else {
+ set def_port x
}
if {"$style" != "servers"} {
get port enum-rand 0 0xffff
reply { set source_port $def_port; set dest_port $rand_port }
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]
- } else {
- get data rand 0 [expr {$mtu + $mtuadjust}]
- }
- return [list $source_port $dest_port $data]
+ return [list $source_port $dest_port $def_port $style]
}
define ip-proto 17 udp {mtu} {
get-for udp
+
get checksum choice-mult \
- checksum_bad 0.20 \
+ checksum_bad 0.10 \
checksum_none 0.20 \
checksum_good
- manyset [port_pair_data udp $mtu 8] source_port dest_port data
- set length [packet-len $data]
+ manyset [port-pair udp] source_port dest_port def_port style
+
+ if {"$style" != "random"} {
+ set port $def_port
+ set data [depending-on udp port $mtu -8 $style]
+ } else {
+ get data rand 0 [expr {$mtu-8}]
+ }
+
+ set length 0
set checksum 0
assemble udp {
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Source Port | Dest Port |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Length | ? Checksum |
+ | ? Length | ? Checksum |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Data ... |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
- append udp $data
+ set udp_length [packet-len $udp]
+ assembly-overwrite udp length $udp_length
+
if {"$checksum" != "none"} {
- set csum [packet-csum-ip $udp]
+ global ip_source ip_dest ip_proto
+ assemble pseudo {
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | IP Source |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | IP Dest |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | 0 | IP Proto | UDP length |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ }
+ set csum [packet-csum-ip "$pseudo$udp"]
if {!$csum} { set csum 0xffff }
if {"$checksum" == "bad"} {
- get error hex 1 0xffff
- set csum [expr {$csum ^ $error}]
+ get csumerror hex 1 0xffff
+ set csum [expr {$csum ^ $csumerror}]
}
} else {
set csum 0
}
- assembly-overwrite udp ${?_checksum} $csum
+ assembly-overwrite udp checksum $csum
+ return $udp
}
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 |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
default { error "what?? $what" }
}
- return $packet
+ return $payload
}
define remailck-auth 31 passwd {mtu} {
return $passwd
}
+define ip-proto 6 tcp {mtu} {
+ 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.6 noopt
+ switch -exact $optmode {
+ noopt { }
+ badopt {
+ get options rand 1 60
+ }
+ opt {
+ while {[choice-prob tcp-opts-more 0.4]} {
+ 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]}]
+ 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 {count} {
- global getlog_log errorInfo
+ global getlog_log errorInfo mtu
if {[catch {
start_gen $count
- set packet [gen_1_ip 576]
- puts stdout "[format %06d $count] $getlog_log\n $packet"
+ set packet [gen_1_ip $mtu]
+ puts stdout "[format %6d $count] $getlog_log\n $packet"
} emsg]} {
puts stderr "\nERROR\n$count\n\n$emsg\n\n$errorInfo\n\n"
puts stdout "[format %06d $count] error"
+ } else {
+ set ts_sec [clock seconds]
+ set ts_usec 0
+
+ set llpkt [random-bytes 12] ;# ether addrs
+ append llpkt 0800 ;# eth ip type
+ 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] }
+ 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
+set linktype 1
+
+pcap_write {
+ x32 magic
+ u16 version_major
+ u16 version_minor
+ s32 thiszone
+ s32 sigfigs
+ s32 snaplen
+ s32 linktype
+}
+
+if {[llength $argv] && ![string length $upto]} {
+ foreach count $argv { emit "$xseed$count" }
+} elseif {![llength $argv]} {
+ if {![string length $upto]} { set upto 100 }
+ for {set count 1} {$upto<0 || $count<=$upto} {incr count} {
+ emit "$xseed$count"
+ }
} else {
- foreach count $argv { emit $count }
+ error "bad mode"
}
+
+pcap_close
~ianmdlvl / vinegar-ip.git / blobdiff