#!/usr/bin/tclsh8.2
-set debug_level 0
-
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} {
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]
}
# 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. Tabs are forbidden.
+ # item.
#
# Field names are converted to lowercase; internal spaces
# are replaced with _. They are then assumed to be
# 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.
+ # Field names starting with digits are literal values instead.
variable cache
upvar 1 $outvarname out
manyset $parsed outbytes lout
set out [string repeat 00 $outbytes]
- foreach {location varname locvarname} $lout {
- if {"$varname" == "0"} {
- set value 0
+ foreach {?_location varname locvarname} $lout {
+ if {[regexp {^[0-9]} $varname]} {
+ set value $varname
} else {
set value [uplevel 1 [list set $varname]]
}
if {[string length $locvarname]} {
upvar 1 $locvarname lv
- set lv $location
+ set lv ${?_location}
+ }
+ if {[catch {
+ assembly-overwrite out location $value
+ } emsg]} {
+ global errorInfo errorCode
+ error $emsg \
+ "$errorInfo\n setting\n$varname at ${?_location}" \
+ $errorCode
}
- assembly-overwrite out $location $value
}
}
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]} {
return [list $outbytes $lout]
}
- proc assembly-overwrite {outvarname location value} {
+ 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"
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
}
| Body ... |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
- assembly-overwrite icmp ${?_checksum} [packet-csum-ip $icmp]
+ assembly-overwrite icmp checksum [packet-csum-ip $icmp]
return $icmp
}
get-for udp
get checksum choice-mult \
- checksum_bad 0.20 \
+ checksum_bad 0.10 \
checksum_none 0.20 \
checksum_good
manyset [port-pair udp] source_port dest_port def_port style
get data rand 0 [expr {$mtu-8}]
}
- set length [packet-len $data]
+ set length 0
set checksum 0
assemble udp {
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Source Port | Dest Port |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Length | ? Checksum |
+ | ? Length | ? Checksum |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| 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 |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
}
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
-#
-# manyset [port-pair tcp] source_port dest_port style
-# get event choice-many \
-# 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 hex 0 0xffffffff
-# get ack hex 0 0xffffffff
-# if {[choice-prob tcp-smallwindow 0.7]} {
-# get window number 0 1
-# } else {
-# get window hex 0 0xffff
-# }
-# set urg hex 0 0xffff
-# get u flag 0.3
-# get p flag 0.5
-#
-# set options {}
-# switch -exact [choice-mult tcp-opts junk 0.3 some 0.6 none] {
-# none { }
-# junk {
-# get options rand 1 60
-# }
-# some {
-# while {[choice-prob tcp-opts-more 0.5]} {
-# get opt enum 0 255 0.5
-# if {$opt == 0} {
-# assemble option {
-# +-+-+-+-+-+-+-+-+
-# | Opt |
-# +-+-+-+-+-+-+-+-+
-# } else {
-# set data [depending-on tcp opt 10 0]
-# set option_len 0
-# assemble option {
-# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-# | Opt | ? Option Len |
-# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-# | Data ... |
-# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-# }
-# aseembly-overwrite option ${?_option_len} \
-# [packet-len $option]
-# }
-# append options $option
-# }
-# }
-# }
-#
-#
-#
-# [expr {[packet-len $od] + 2}]
-#
-# append options [format %02x%02s $opt \
-# [expr {[packet-len $od]+2}]]
-# append options $optdata
-# }
-#
-# while {
-#
-#
-# \
-#
-#
-# set event \
-#
-#
-# get s flag
-# }
-#
+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 / commitdiff