-# 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
+ }