3 # core packet generator for vinegar-ip
5 # This file is part of vinegar-ip, tools for IP transparency testing.
6 # vinegar-ip is Copyright (C) 2002 Ian Jackson
8 # This program is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 2, or (at your option)
13 # This program is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software Foundation,
20 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 proc debug {level str} {
26 if {$level <= $debug_level} { puts stderr "debug\[$level] $str" }
29 proc manyset {list args} {
30 foreach val $list var $args {
37 proc start_gen {seed} {
39 random-bytes-init $seed
43 proc packet-len {p} { expr {[string length $p]/2} }
45 proc packet-csum-ip {packet} {
48 while {[regexp {^([0-9a-f]{4})(.*)$} $packet dummy this packet]} {
49 set cs [expr "\$cs + 0x$this"]
50 debug 7 [format "0x%s 0x%08x" $this $cs]
52 while {$cs > 0xffff} {
53 set cs [expr {($cs & 0xffff) + (($cs >> 16) & 0xffff)}]
55 return [expr {$cs ^ 0xffff}]
58 proc packet-fromstring {s} {
63 namespace eval Random-Bytes {
64 namespace export random-bytes random-bytes-init
66 proc random-bytes-init {seed} {
68 catch { set h $fh; unset fh; close $h }
69 set fh [open |[list openssl bf-ofb < /dev/zero -e -k " $seed"] r]
70 fconfigure $fh -translation binary
72 proc random-bytes {n} {
75 if {[string length $x] != $n} {
76 set h $fh; unset fh; close $h
77 error "openssl bf-ofb exited unexpectedly"
79 set y [packet-fromstring $x]
84 namespace import Random-Bytes::*
86 proc choice-int {min max} {
87 set rv 0x[random-bytes 3]
89 int( double($rv) / double(0x1000000) * double($max+1-$min) )
94 proc choice-prob {cv def} {
95 set prob [config $cv $def]
96 set rv 0x[random-bytes 3]
97 return [expr {$rv < double($prob)*0x1000000}]
100 proc choice-mult {args} {
101 if {!([llength $args] % 2)} { error "choice-mult must have default" }
102 set h 0x[random-bytes 3]
103 set x [expr { double($h) / double(0x1000000) }]
105 set def [lindex $args end]
106 set args [lreplace $args end end]
107 foreach {val p} $args {
108 set cump [expr {$cump + double($p)}]
109 if {$x < $cump} { return $val }
115 upvar #0 getlog_log log
117 debug 2 "getlog $msg"
120 proc config {cv def} {
121 upvar #0 config/$cv v
122 if {[info exists v]} { return $v }
127 proc define {enum val name argnames body} {
128 upvar #0 enum/val2name/$enum v2n
129 upvar #0 enum/name2val/$enum n2v
132 proc enum/val/$enum/$val $argnames $body
135 proc depending-on {scope enum_and_var mtu mtuadjust args} {
136 upvar 1 $enum_and_var val
137 set mtu [expr {$mtu + $mtuadjust}]
138 set procname enum/val/$scope-$enum_and_var/[format %d $val]
139 if {[choice-prob $enum_and_var-unstruct 0.1] ||
140 [catch { info body $procname }]} {
143 get data rand 0 $mtu 1
146 uplevel 1 [list $procname] $mtu $args
151 proc get-for {scope} {
156 proc get {variable kind args} {
157 upvar 1 get/scope scope
158 upvar 1 $variable var
159 set var [eval [list get/$kind $scope $variable] $args]
162 proc get-config/number {val min max} { return $val }
163 proc get-config/v4addr {val} {
164 if {![regexp {^(\d+)\.(\d+)\.(\d+)\.(\d+)$} $val dummy a b c d]} {
165 error "bad v4addr ?$val?"
167 return [format 0x%02x%02x%02x%02x $a $b $c $d]
170 proc get-config {variable def kind args} {
171 # args currently ignored
172 upvar 1 get/scope scope
173 upvar 1 $variable var
174 set val [config $scope-$variable $def]
175 set var [eval [list get-config/$kind $val] $args]
178 proc get-enum-got {s v rv} {
179 upvar #0 enum/val2name/$s-$v v2n
180 if {[info exists v2n($rv)]} {
181 getlog "$v=$v2n($rv)\[$rv]"
188 proc get/enum-rand {s v min max} {
189 set rv [choice-int $min $max]
190 return [get-enum-got $s $v $rv]
193 proc get/enum-def {s v} {
194 upvar #0 enum/val2name/$s-$v v2n
195 set rv [choice-int 1 [array size v2n]]
196 set rv [lindex [lsort [array names v2n]] [expr {$rv-1}]]
197 return [get-enum-got $s $v $rv]
200 proc get/enum {s v min max prand} {
202 get any choice $prand
204 return [get/enum-rand $s $v $min $max]
206 return [get/enum-def $s $v]
210 proc get/number {s v min max} {
211 set rv [choice-int $min $max]
216 proc get/hex {s v min max} {
217 set rv [choice-int $min $max]
218 getlog [format %s=0x%x $v $rv]
222 proc get/hex32 {s v} {
223 set rv [random-bytes 4]
228 proc get/flag {s v defprob} {
229 set rv [choice-prob $s-$v $defprob]
230 if {$rv} { getlog "$v" } else { getlog "!$v" }
234 proc get/choice {s v defprob} {
235 set rv [choice-prob $s-$v $defprob]
236 if {$rv} { getlog "($v)" } else { getlog "(!$v)" }
240 proc get/rand {s v minlen maxlen blockbytes} {
242 if {$maxlen<0} { getlog (full!); return {} }
243 get l number [expr {$minlen/$blockbytes}] [expr {$maxlen/$blockbytes}]
244 return [random-bytes [expr {$l*$blockbytes}]]
247 proc get/ip-timestamp {s v} {
248 set rv [expr {[clock seconds] | 0x80000000}]
249 getlog "$v=[format %x $rv]"
253 proc get/v4addr {s v} {
257 for {set i 0} {$i<4} {incr i} {
258 set b [random-bytes 1]
260 append p $d [format %d 0x$b]
267 proc get/choice-mult {s v args} {
268 set rv [eval choice-mult $args]
273 proc get/string {s v minlen maxlen first rest} {
276 for {set l [choice-int $minlen $maxlen]} {$l>0} {incr l -1} {
277 set cn [choice-int 0 [expr {[string length $now]-1}]]
278 append o [string index $now $cn]
282 return [packet-fromstring $o]
285 proc get/ntstring {s v minlen maxlen first rest} {
286 set s [get/string $s $v $minlen $maxlen $first $rest]
288 append s [random-bytes $maxlen]
289 return [string range $s 0 [expr {$maxlen*2-1}]]
292 namespace eval Assembler {
293 namespace export assemble assembly-overwrite
295 proc assemble {outvarname format} {
296 # format should look like those RFC diagrams. +-+-+ stuff and
297 # good formatting is mandatory. You can have a single data
298 # item at the end ending in ..., which means append that data
301 # Field names are converted to lowercase; internal spaces
302 # are replaced with _. They are then assumed to be
303 # variable names in the caller's scope. The packet is
304 # assembled from those values (which must all be set)
305 # and stored in $varname in the caller's scope.
307 # Variables ?_whatever will be *set* with the location of the
308 # field in the string (in internal format); the corresponding
309 # `whatever' (with the ?_ stripped) will be read when assembling.
311 # Field names starting with digits are literal values instead.
314 upvar 1 $outvarname out
315 if {[catch { set parsed $cache($format) }]} {
316 set parsed [parse $format]
317 set cache($format) $parsed
320 manyset $parsed outbytes lout
321 set out [string repeat 00 $outbytes]
322 foreach {?_location varname locvarname} $lout {
323 if {[regexp {^[0-9]} $varname]} {
326 set value [uplevel 1 [list set $varname]]
328 if {[string length $locvarname]} {
329 upvar 1 $locvarname lv
333 assembly-overwrite out location $value
335 global errorInfo errorCode
337 "$errorInfo\n setting\n$varname at ${?_location}" \
343 proc parse {format} {
347 debug 7 "ASSEMBLY $format"
348 set format [exec expand << $format]
349 foreach l [split $format "\n"] {
351 if {[regexp -nocase {^ *\| +\| *$} $l]} {
352 if {![info exists wordbits]} {
353 error "vspace not in data @$lno\n?$l?"
356 } elseif {[regexp -nocase {^ *[|? a-z0-9.]+$} $l]} {
357 if {[info exists words]} {
358 error "data without delimline @$lno\n?$l?"
362 } elseif {[regexp {^ *[-+]+ *$} $l]} {
365 while {[regexp {^([-= ]+)\+(.*)$} $l dummy before after]} {
366 set atpos([string length $before]) $wordbits
368 set l "$before=$after"
369 append newlineform "@[string length $before]:$wordbits "
372 append newlineform $wordbits
373 if {[info exists lineform]} {
374 if {"$newlineform" != "$lineform"} {
375 error "format change @$lno\n?$l?\n$wordformat != $oldwordformat"
377 if {![info exists words] || $words<0} {
378 error "consecutive delimlines @$lno\n?$l?"
380 incr outbytes [expr {$words*$wordbits/8}]
382 while {[regexp -nocase \
383 {^([ =]*)\|( *[? a-z0-9]*[a-z0-9] *\.* *)\|(.*)$} \
384 $l dummy before midpart after]} {
385 debug 7 "RWORKG ?$l?"
387 error "two things at end @$lno\n?$l?"
389 set varname [string tolower [string trim $midpart]]
390 if {[regexp {(.*[a-z0-9])\s*\.\.\.$} $varname \
391 dummy realvarname]} {
392 set varname $realvarname
395 set varname [string map {{ } _} $varname]
396 set p1 [string length $before]
398 [string length $before] +
399 [string length $midpart] + 1
401 if {![info exists atpos($p1)] ||
402 ![info exists atpos($p2)]} {
403 error "vdelims not found @$lno $varname $p1 $p2 -- $lineform ?$cue?"
411 $atpos($p2) - $atpos($p1) + ($words-1)*$wordbits
415 error "atend not at byte @$lno\n?$l?"
417 set outbytes [expr {$bit1/8}]
418 set location [list $bit1 0 $varname]
420 set location [list $bit1 $bitlen $varname]
422 if {[regexp {^\?_(.*)} $varname dummy realvarname]} {
423 debug 7 "LOCATING $varname $location"
424 set locvarname $varname
425 set varname $realvarname
429 lappend lout $location $varname $locvarname
431 append l [string repeat = [string length $midpart]]
434 debug 7 "REMAIN ?$l?"
435 if {![regexp {^[ =]*\|? *$} $l]} {
436 error "unclear @$lno\n?$l?"
439 if {$wordbits % 8 || $wordbits >32} {
440 error "bad wordbits $wordbits @$lno ?$l? $newlineform"
442 set lineform $newlineform
444 catch { unset words }
445 } elseif {[regexp {^ *$} $l]} {
447 error "huh? @$lno ?$l?"
450 debug 7 "ASSEMBLY\n$outbytes\n$lout\n"
451 return [list $outbytes $lout]
454 proc assembly-overwrite {outvarname locvarnameex value} {
455 upvar 1 $outvarname out
456 upvar 1 ?_$locvarnameex location
457 manyset $location bit1 bitlen diag
458 if {$bitlen > 0 && $bitlen != 32 && $value >= (1<<$bitlen)} {
459 error "$diag $value >= 2**$bitlen"
461 if {!($bit1 % 8) && !($bitlen % 8)} {
462 set char0no [expr {$bit1/4}]
463 set charlen [expr {$bitlen/4}]
464 set chareno [expr {$char0no + $charlen -1}]
466 debug 8 "ASSEMBLY $diag == $value == 0x[format %x $value] (@$bit1+$bitlen)"
467 set repl [format %0${charlen}x $value]
468 set out [string replace $out $char0no $chareno $repl]
470 debug 8 "ASSEMBLY-ADD $diag (@$bit1)"
471 # bitlen==0 => append
472 set out [string range $out 0 $chareno]
476 while {$bitlen > 0} {
477 set byteno [expr {$bit1 / 8}]
478 set char0no [expr {$byteno*2}]
479 set char1no [expr {$char0no+1}]
480 set bytebit [expr {128>>($bit1 % 8)}]
481 set byte 0x[string range $out $char0no $char1no]
482 debug 7 "< $bit1+$bitlen $byteno $char0no $bytebit $byte $out"
484 ($value & (1<<($bitlen-1)))
486 : ($byte & ~$bytebit)
488 set out [string replace $out $char0no $char1no \
490 debug 8 "> $bit1+$bitlen $byteno $char0no $bytebit 0x[format %02x $byte] $out"
497 namespace import Assembler::*
499 proc gen_1_ip {mtu source_spec dest_spec} {
501 upvar #0 ip_proto proto
502 upvar #0 ip_source source
503 upvar #0 ip_dest dest
505 set source $source_spec
510 get tos hex 0x00 0xff
511 get id number 0x0000 0xffff
513 if {$df || ![choice-prob ip-midfrag 0.05]} {
518 get frag number 0 0x1fff
520 get-config ttl 255 number 0 255
521 get proto enum 1 255 0.05
522 set flags [expr {$df*2 + $mf}]
524 set header_checksum 0
528 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
529 |Version| ? IHL |TOS | ? Total Length |
530 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
532 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
533 | TTL | Proto | ? Header Checksum |
534 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
536 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
538 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
540 # we don't do any IP options
542 set ihl [packet-len $ip]
543 if {$ihl % 4} { error "ihl not mult of 4 bytes" }
544 assembly-overwrite ip ihl [expr {$ihl / 4}]
546 set body [depending-on ip proto $mtu -$ihl]
547 set total_length [expr {[packet-len $ip] + [packet-len $body]}]
549 assembly-overwrite ip total_length $total_length
550 assembly-overwrite ip header_checksum [packet-csum-ip $ip]
556 define ip-proto 1 icmp {mtu} {
559 get type enum 0 255 0.2
560 manyset [depending-on icmp type $mtu -4] body code
561 if {![string length $code]} { get code number 0 255 }
564 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
565 | Type | Code | ? Checksum |
566 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
568 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
570 assembly-overwrite icmp checksum [packet-csum-ip $icmp]
574 proc define-icmp-type-vanilla {num name} {
575 define icmp-type $num $name {mbl} "icmp-vanilla \$mbl [list $name]"
577 proc icmp-vanilla {mbl typename} {
578 get-for icmp-$typename
579 get code enum 0 255 0.4
580 get body rand 0 $mbl 1
581 return [list $body $code]
584 define-icmp-type-vanilla 3 unreach
585 define icmp-unreach-code 0 net {} {}
586 define icmp-unreach-code 1 host {} {}
587 define icmp-unreach-code 2 proto {} {}
588 define icmp-unreach-code 3 port {} {}
589 define icmp-unreach-code 4 fragneeded {} {}
590 define icmp-unreach-code 5 sourceroutefail {} {}
592 define-icmp-type-vanilla 11 timeout
593 define icmp-timeout-code 0 intransit {} {}
594 define icmp-timeout-code 1 fragment {} {}
596 define-icmp-type-vanilla 12 parameters
597 define icmp-parameters-code 0 seepointer {} {}
599 define-icmp-type-vanilla 4 sourcequench
600 define icmp-sourcequench-code 0 quench {} {}
602 define icmp-type 5 redirect {mbl} {
603 get-for icmp-redirect
604 get code enum 0 255 0.4
606 get data rand 0 [expr {$mbl-4}] 1
608 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
610 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
612 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
614 return [list $body $code]
617 define icmp-redirect-code 0 net {} {}
618 define icmp-redirect-code 1 host {} {}
619 define icmp-redirect-code 2 net+tos {} {}
620 define icmp-redirect-code 3 host+tos {} {}
622 define icmp-type 8 ping {mbl} { icmp-echo $mbl }
623 define icmp-type 0 pong {mbl} { icmp-echo $mbl }
624 proc icmp-echo {mbl} {
626 get code enum 0 255 0.4
629 get data rand 0 [expr {$mbl-8}] 1
631 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
633 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
635 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
637 return [list $body $code]
639 define icmp-echo-code 0 echo {} {}
641 define icmp-type 13 timestamp {mbl} { icmp-timestamp }
642 define icmp-type 14 timestampreply {mbl} { icmp-timestamp }
643 proc icmp-timestamp {} {
644 get-for icmp-timestamp
645 get code enum 0 255 0.4
648 get originate ip-timestamp
649 get receive ip-timestamp
650 get transmit ip-timestamp
652 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
654 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
656 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
658 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
660 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
662 return [list $body $code]
664 define icmp-timestamp-code 0 timestamp {} {}
666 define icmp-type 15 inforequest {mbl} { icmp-inforeq }
667 define icmp-type 16 inforeply {mbl} { icmp-inforeq }
668 proc icmp-inforeq {} {
670 get code enum 0 255 0.4
674 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
676 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
678 return [list $body $code]
680 define icmp-inforeq-code 0 timestamp {} {}
682 # MAYADD ICMP traceroute RFC1393
683 # MAYADD ICMP router discovery RFC1256
686 define ip-proto 4 ip {mtu} {
691 gen_1_ip $mtu $source $dest
695 define ip-proto 2 igmp {mtu} {
697 get type enum 0 255 0.5
698 get timeout number 0 255
703 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
704 | Type | Timeout | ? Checksum |
705 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
707 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
709 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
712 if {[choice-prob igmp-extra 0.3]} {
713 get extra rand 1 [expr {$mtu - [packet-len $igmp]}] 1
714 assembly-overwrite igmp extra $extra
717 assembly-overwrite igmp checksum [packet-csum-ip $igmp]
721 define igmp-type 17 membquery {} {}
722 define igmp-type 16 membreport {} {}
723 define igmp-type 23 leavegroup {} {}
724 define igmp-type 18 membreport {} {}
727 define ip-proto 51 ah {mtu} {
730 get next number 0 255
731 get reserved hex 0 0xffff
733 get auth_data rand 0 [expr {$mtu-8 > 50 ? 50 : $mtu-8}] 4
734 set length [packet-len $auth_data]
736 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
737 | Next | Length | RESERVED |
738 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
740 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
742 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
744 get payload rand 0 [expr {$mtu - [packet-len $ah]}] 1
751 get port enum-rand 0 0xffff
755 define ip-proto 17 udp {mtu} {
759 set csum_mode [choice-mult \
764 get style choice-mult \
770 if {"$style" != "random"} {
776 switch -exact $style {
777 random { set source_port [udp-rport]; set dest_port [udp-rport] }
778 request { set source_port [udp-rport]; set dest_port $def_port }
779 reply { set source_port $def_port; set dest_port [udp-rport] }
780 servers { set source_port $def_port; set dest_port $def_port }
783 if {"$style" != "random"} {
785 set data [depending-on udp port $mtu -8 $style]
787 get data rand 0 [expr {$mtu-8}] 1
793 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
794 | Source Port | Dest Port |
795 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
796 | ? Length | ? Checksum |
797 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
799 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
801 set udp_length [packet-len $udp]
802 assembly-overwrite udp length $udp_length
804 if {"$csum_mode" == "checksum_none"} {
808 global ip_source ip_dest ip_proto
810 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
812 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
814 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
815 | 0 | IP Proto | UDP length |
816 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
818 set checksum [packet-csum-ip "$pseudo$udp"]
819 if {!$checksum} { set checksum 0xffff }
820 if {"$csum_mode" == "checksum_bad"} {
821 get csumerror hex 1 0xffff
822 set checksum [expr {$checksum ^ $csumerror}]
825 assembly-overwrite udp checksum $checksum
829 define udp-port 50 remailck {mtu style} {
832 if {"$style" == "request"} {
833 get what choice-mult \
840 get what choice-mult \
847 switch -exact $what {
850 get user string 1 8 \
851 abcdefghijklmnopqrustuvwxyz \
852 abcdefghijklmnopqrustuvwxyz-0123456789_
856 get user rand 0 [expr {$mtu - 4}] 1
859 get auth enum 0 31 0.5
860 set user [depending-on remailck auth $mtu -4]
863 get auth hex 0 0xffff
868 get mail choice-mult \
874 switch -exact $mail {
888 get modified number 1 600
889 get read number 1 600
891 default { error "mail? $mail" }
894 default { error "what? $what" }
899 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
901 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
903 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
908 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
910 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
912 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
914 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
917 default { error "what?? $what" }
922 define remailck-auth 31 passwd {mtu} {
923 get-for remailck-passwd
924 get passwd string 6 8 \
925 0123456789abcdefghijklmnopqrstuvxwyz \
926 0123456789abcdefghijklmnopqrstuvxwyz
930 define udp-port 67 dhcpserv {mtu style} { return [dhcp $mtu] }
931 define udp-port 68 dhcpclient {mtu style} { return [dhcp $mtu] }
934 get op enum 0 255 0.2
935 get htype enum 0 255 0.2
937 get hops number 0 255
939 get secs number 0 300
945 set chaddr [random-bytes 16]
946 get sname ntstring 0 64 \
947 0123456789abcdefghijklmnopqrstuvwxyz \
948 0123456789abcdefghijklmnopqrstuvwxyz.-+
949 get file ntstring 0 128 / \
950 0123456789abcdefghijklmnopqrstuvwxyz.-+/_
953 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
954 | op | htype | hlen | hops |
955 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
957 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
959 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
961 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
963 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
965 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
967 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
969 append dhcp $chaddr $sname $file
973 define dhcp-op 1 request {} {}
974 define dhcp-op 2 reply {} {}
975 define dhcp-htype 1 ethernet {} {}
978 define ip-proto 6 tcp {mtu} {
982 get source_port number 0 65535
983 get dest_port number 0 65535
984 get event choice-mult \
995 switch -exact $event {
996 connect { set s 1; set a 0 }
999 reset { set a 0; set r 1 }
1007 default { error "event? $event" }
1011 if {[choice-prob tcp-smallwindow 0.7]} {
1012 get window number 0 1
1014 get window hex 0 0xffff
1018 get urg hex 0 0xffff
1021 get optmode choice-mult badopt 0.3 opt 0.3 noopt
1022 switch -exact $optmode {
1025 get options rand 1 60 1
1029 while {$nooi || [choice-prob tcp-opts-more 0.4]} {
1031 get opt enum 1 255 0.5
1039 set data [depending-on tcp opt 6 0]
1042 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1043 | Opt | ? Option Len |
1044 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1046 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1048 assembly-overwrite option option_len [packet-len $option]
1050 append options $option
1055 if {[choice-prob reserved-nonzero 0.25]} {
1056 get reserved hex 0 0x3f
1061 if {[packet-len $options] % 4 || [get optxpad choice 0.15]} {
1062 if {"$optmode" != "badopt"} { append options 00 }
1063 set padlen [expr {3 - ([packet-len $options] + 3) % 4}]
1064 append options [random-bytes $padlen]
1070 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1071 | Source Port | Dest Port |
1072 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1074 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1076 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1077 |? D Off| Reserved |U|A|P|R|S|F| Window |
1078 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1079 | ? Checksum | Urg |
1080 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1082 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1085 set d_off [expr {([packet-len $packet]/4) & 0x0f}]
1086 assembly-overwrite packet d_off $d_off
1088 if {!($s || $r) || [get unexpdata flag 0.2]} {
1089 get data rand 0 [expr {$mtu - [packet-len $packet]}] 1
1092 set tcp_length [packet-len $packet]
1094 global ip_source ip_dest ip_proto
1096 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1098 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1100 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1101 | 0 | IP Proto | TCP length |
1102 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1105 set csum [packet-csum-ip "$pseudo$packet"]
1106 if {[choice-prob tcp-badcsum 0.1]} {
1107 get csumerror hex 1 0xffff
1108 set csum [expr {$csum ^ $csumerror}]
1110 assembly-overwrite packet checksum $csum
1114 define tcp-opt 2 mss {mdl} {
1116 get mss hex 0 0xffff
1118 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1120 +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
1126 namespace eval PCap {
1127 namespace export pcap_open pcap_write pcap_write_raw pcap_close
1129 proc pcap_open {fn} {
1133 fconfigure $fh -translation binary
1136 proc pcap_close {} {
1138 if {![info exists fh]} return
1143 proc pcap_write_raw {packet} {
1145 if {![info exists fh]} return
1146 puts -nonewline $fh [binary format H* $packet]
1149 proc pcap_write {valdeflist} {
1150 foreach {kind valvar} $valdeflist {
1151 if {![regexp {^([usx])([0-9]+)} $kind dummy mode bits]} {
1152 error "unknown kind $kind for $valvar"
1154 set value [uplevel 1 [list set $valvar]]
1155 if {$bits % 8} { error "bits must be mult 8 in $kind for $valvar" }
1156 if {"$mode" != "x"} {
1159 for {set i 0} {$i<$bits/8} {incr i} {
1160 append v [format %02x [expr {$value & 0xff}]]
1161 set value [expr {$value >> 8}]
1163 if {$value != 0 && $value != -1} {
1164 error "value $ov more than $bits bits (residue=$value)"
1168 if {[string length $value] != $bits/4} {
1169 error "$valvar value $value wrong length, not $bits bits"
1171 pcap_write_raw $value
1175 namespace import PCap::*
1178 global getlog_log errorInfo mtu fake_time_t
1179 global minframelen linktypename
1182 get-config source 127.0.0.1 v4addr
1183 get-config dest 127.0.0.1 v4addr
1187 set packet [gen_1_ip $mtu $source $dest]
1188 puts stdout "[format %6s $seed] $getlog_log\n $packet"
1190 puts stderr "\nERROR\n$seed\n\n$emsg\n\n$errorInfo\n\n"
1191 puts stdout "[format %6s $seed] error"
1193 set ts_sec [incr fake_time_t]
1196 set l [packet-len $packet]
1197 if {$l < $minframelen} {
1198 append packet [string repeat 00 [expr {$minframelen - $l}]]
1201 set llpkt [link/$linktypename/linkencap $packet]
1203 set len [packet-len "$llpkt"]
1210 pcap_write_raw $llpkt
1215 # link/ether - RFC894
1216 proc link/ether/linkparams {} { return {1 46} }
1217 proc link/ether/defaddr {} { return 00:00:00:00:00:00 }
1218 proc link/ether/procaddr {input sd} {
1219 set v [string tolower $input]
1220 if {[regexp {^([0-9a-f]{2}\:){5}[0-9a-f]{2}$} $v]} {
1221 set v [string map {: {}} $v]
1223 if {![regexp -nocase {^[0-9]{12}$} $v]} {
1224 error "invalid $sd ethernet addr $input ($v)"
1228 proc link/ether/linkencap {packet} {
1229 global link_source link_dest
1231 append llpkt $link_source $link_dest 0800
1232 append llpkt $packet
1239 if {![llength $argv]} { error "need another arg" }
1240 set a [lindex $argv 0]
1241 set argv [lrange $argv 1 end]
1245 proc nextarg_num {} { return [expr {[nextarg] + 0}] }
1246 proc nextarg_il {} {
1248 if {![regexp -nocase {^([0-9.]+)/([0-9a-f:]+)$} $a dummy i l]} {
1249 error "--source/--dest needs <ip-addr>/<link-addr>"
1251 return [list $i [string map {: {}} $l]]
1258 set linktypename ether
1259 while {[regexp {^\-\-} [lindex $argv 0]]} {
1261 switch -exact -- $o {
1262 --infinite { set upto -1 }
1263 --debug { set debug_level [nextarg_num] }
1264 --upto { set upto [nextarg_num] }
1265 --write { pcap_open [nextarg] }
1266 --mtu { set mtu [nextarg_num] }
1267 --xseed { set xseed [nextarg] }
1268 --linktype { set linktypename [nextarg] }
1269 --source { manyset [nextarg_ih] config/ip-source config/link-source }
1270 --dest { manyset [nextarg_ih] config/ip-dest config/link-dest }
1271 default { error "bad option $o" }
1275 proc process_linkaddr {sd} {
1278 link/$linktypename/linktype
1280 get-config $sd [link/$linktypename/defaddr] linkaddr
1281 set l [link/$linktypename/procaddr [set $sd] $sd]
1284 manyset [link/$linktypename/linkparams] linktype minframelen
1285 process_linkaddr source
1286 process_linkaddr dest
1305 set fake_time_t [clock seconds]
1307 if {[llength $argv]} {
1308 foreach count $argv { emit "$xseed$count" }
1310 if {![string length $upto]} { set upto 100 }
1311 for {set count 1} {$upto<0 || $count<=$upto} {incr count} {