From 52863edc87ab1c3dccf4bee8118050e2732b656d Mon Sep 17 00:00:00 2001
From: ian <ian>
Date: Sat, 2 Mar 2002 02:19:45 +0000
Subject: [PATCH 1/1] Can generate icmp and some udp

---
 make-probes.tcl | 550 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 550 insertions(+)
 create mode 100755 make-probes.tcl

diff --git a/make-probes.tcl b/make-probes.tcl
new file mode 100755
index 0000000..2fb83be
--- /dev/null
+++ b/make-probes.tcl
@@ -0,0 +1,550 @@
+#!/usr/bin/tclsh8.2
+
+
+set debug_level 1
+
+proc debug {level str} {
+    global debug_level
+    if {$level < $debug_level} { puts stderr "debug\[$level] $str" }
+}
+
+proc manyset {list args} {
+    foreach val $list var $args {
+	upvar 1 $var my
+	set my $val
+    }
+}
+
+
+proc start_gen {use_gen_counter} {
+    global gen_counter rand_counter getlog_log rand_buf
+    set gen_counter $use_gen_counter
+    set rand_counter 0
+    set rand_buf {}
+    set getlog_log {}
+}
+
+proc packet-len {p} { expr {[string length $p]/2} }
+
+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
+    }
+    return [expr {$cs & 0xffff}]
+}
+
+set rand_buf {}
+proc random-bytes {n} {
+    global gen_counter rand_counter rand_buf
+    set n [expr {$n*2}]
+    set o {}
+    while {[set w [expr {$n - [string length $o]}]] > 0} {
+	if {![string length $rand_buf]} {
+	    set md5 [exec md5sum << "$gen_counter $rand_counter"]
+	    regexp {^[0-9a-f]{32}} $md5 rand_buf
+	    if {![string length $rand_buf]} { error "?$md5?" }
+	    incr rand_counter
+	}
+	append o [string range $rand_buf 0 [expr {$w-1}]]
+	set rand_buf [string range $rand_buf $w end]
+    }
+    return $o
+}
+
+proc choice-int {min max} {
+    set rv 0x[random-bytes 3]
+    return [expr {
+	int( double($rv) / double(0xffffff) * double($max+1-$min) )
+	+ $min
+    }]
+}
+
+proc choice-prob {cv def} {
+    set prob [config $cv $def]
+    set rv 0x[random-bytes 3]
+    return [expr {$rv < double($prob)*0x1000000}]
+}
+
+
+proc getlog {msg} {
+    upvar #0 getlog_log log
+    append log " $msg"
+    debug 2 "getlog $msg"
+}
+
+proc config {cv def} {
+    upvar #0 config/$cv v
+    if {[info exists v]} { return $v }
+    return $def
+}
+
+
+proc define {enum val name argnames body} {
+    upvar #0 enum/val2name/$enum v2n
+    upvar #0 enum/name2val/$enum n2v
+    set v2n($val) $name
+    set n2v($name) $val
+    proc enum/val/$enum/$val $argnames $body
+}
+
+proc depending-on {scope enum_and_var mtu mtuadjust args} {
+    upvar 1 $enum_and_var val
+    set mtu [expr {$mtu + $mtuadjust}]
+    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 randupto $mtu
+	return $data
+    } else {
+	uplevel 1 [list $procname] $mtu $args
+    }
+}
+
+
+proc get-for {scope} {
+    upvar 1 get/scope ns
+    set ns $scope
+}
+
+proc get {variable kind args} {
+    upvar 1 get/scope scope
+    upvar 1 $variable var
+    set var [eval [list get/$kind $scope $variable] $args]
+}
+
+proc get-config/number {val min max} { return $val }
+proc get-config/v4addr {val} {
+    if {![regexp {^(\d+)\.(\d+)\.(\d+)\.(\d+)$} $val dummy a b c d]} {
+	error "bad v4addr ?$val?"
+    }
+    return [format 0x%02x%02x%02x%02x $a $b $c $d]
+}
+
+proc get-config {variable def kind args} {
+    # args currently ignored
+    upvar 1 get/scope scope
+    upvar 1 $variable var
+    set val [config $scope-$variable $def]
+    set var [eval [list get-config/$kind $val] $args]
+}
+
+proc get/enum {s v min max} {
+    if {[choice-prob $s-$v-unknown 0.5]} {
+	set rv [choice-int $min $max]
+    } else {
+	upvar #0 enum/val2name/$s-$v v2n
+	set rv [choice-int 1 [array size v2n]]
+	set rv [lindex [array names v2n] [expr {$rv-1}]]
+    }
+    if {[info exists v2n($rv)]} {
+	getlog "$v=$v2n($rv)\[$rv]"
+    } else {
+	getlog "$v=$rv"
+    }
+    return $rv
+}
+
+proc get/number {s v min max} {
+    set rv [choice-int $min $max]
+    getlog "$v=$rv"
+    return $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/choice {s v defprob} {
+    set rv [choice-prob $s-$v $defprob]
+    if {$rv} { getlog "($v)" } else { getlog "(!$v)" }
+    return $rv
+}
+
+proc get/randupto {s v maxlen} {
+    get-for $s-$v
+    get l number 0 $maxlen
+    return [random-bytes $l]
+}
+
+proc get/ip-timestamp {s v} {
+    set rv [expr {[clock seconds] | 0x80000000}]
+    getlog "$v=[format %x $rv]"
+    return $rv
+}
+
+proc get/v4addr {s v} {
+    set rv 0x
+    set p {}
+    set d {}
+    for {set i 0} {$i<4} {incr i} {
+	set b [random-bytes 1]
+	append rv $b
+	append p $d [format %d $b]
+	set d .
+    }
+    getlog "$v=$p"
+    return $rv
+}
+
+
+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?"
+	    }
+	    incr words
+	} elseif {[regexp -nocase {^ *[|? a-z0-9]+$} $l]} {
+	    if {[info exists words]} {
+		error "data without delimline @$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 "
+	    }
+	    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?"
+		}
+		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)]} {
+ error "vdelims not found @$lno $varname $p1 $p2 -- $lineform ?$cue?"
+		    }
+		    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
+		    }
+		    if {"$varname" == "0"} {
+			set value 0
+		    } else {
+			set value [uplevel 1 [list set $varname]]
+		    }
+		    assembly-overwrite out $location $value
+		    set l "$before="
+		    append l [string repeat = [string length $midpart]]
+		    append l |$after
+		}
+		debug 7 "REMAIN ?$l?"
+	    } else {
+		if {$wordbits % 8 || $wordbits >32} {
+		    error "bad wordbits $wordbits @$lno ?$l? $newlineform"
+		}
+		set lineform $newlineform
+	    }
+	    catch { unset words }
+	} elseif {[regexp {^ *$} $l]} {
+	} else {
+	    error "huh? @$lno ?$l?"
+	}
+    }
+    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"
+    }
+    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
+    }
+}
+
+
+proc gen_1_ip {mtu} {
+    # RFC791
+    upvar #0 ip_proto proto
+    upvar #0 ip_source source
+    upvar #0 ip_dest dest
+    get-for ip
+    set version 4
+    get tos number 0x00 0xff
+    get id number 0x0000 0xffff
+    get df flag 0.5
+    if {$df} {
+	set mf 0
+	set frag 0
+    } {
+	get mf flag 0.5
+	get frag number 0 0x1fff
+    }
+    get-config ttl 255 number 0 255
+    get proto enum 1 255
+    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}]
+    assemble ip {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |Version|  IHL  |TOS            |         Total Length          |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |         Id                    |Flags|      Frag               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |  TTL          |    Proto      |      ? Header Checksum        |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                       Source                                  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                    Dest                                       |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    assembly-overwrite ip ${?_header_checksum} [packet-csum-ip $ip]
+    append $ip $body
+    return $ip
+}
+
+define ip-proto 1 icmp {mtu} {
+    # RFC792
+    get-for icmp
+    get type enum 0 255
+    manyset [depending-on icmp type $mtu -4] body code
+    if {![string length $code]} { get code number 0 255 }
+    set checksum 0
+    assemble icmp {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Type      |     Code      |        ? Checksum             |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    append icmp $body
+    assembly-overwrite icmp ${?_checksum} [packet-csum-ip $icmp]
+    return $icmp
+}
+
+proc define-icmp-type-vanilla {num name} {
+    define icmp-type $num $name {mbl} "icmp-vanilla \$mbl [list $name]"
+}
+proc icmp-vanilla {mbl typename} {
+    get-for icmp-$typename
+    get code enum 0 255
+    get body randupto $mbl
+    return [list $body $code]
+}
+
+define-icmp-type-vanilla 3 unreach
+define icmp-unreach-code 0 net {} {}
+define icmp-unreach-code 1 host {} {}
+define icmp-unreach-code 2 proto {} {}
+define icmp-unreach-code 3 port {} {}
+define icmp-unreach-code 4 fragneeded {} {}
+define icmp-unreach-code 5 sourceroutefail {} {}
+
+define-icmp-type-vanilla 11 timeout
+define icmp-timeout-code 0 intransit {} {}
+define icmp-timeout-code 1 fragment {} {}
+
+define-icmp-type-vanilla 12 parameters
+define icmp-parameters-code 0 seepointer {} {}
+
+define-icmp-type-vanilla 4 sourcequench
+define icmp-sourcequench-code 0 quench {} {}
+
+define icmp-type 5 redirect {mbl} {
+    get-for icmp-redirect
+    get code enum 0 255
+    get gateway v4addr
+    assemble body {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |                 Gateway                                       |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    get data randupto [expr {$mbl-4}]
+    append body $data
+    return [list $body $code]
+}
+
+define icmp-redirect-code 0 net {} {}
+define icmp-redirect-code 1 host {} {}
+define icmp-redirect-code 2 net+tos {} {}
+define icmp-redirect-code 3 host+tos {} {}
+
+define icmp-type 8 ping {mbl} { icmp-echo $mbl }
+define icmp-type 0 pong {mbl} { icmp-echo $mbl }
+proc icmp-echo {mbl} {
+    get-for icmp-echo
+    get code enum 0 255
+    get id number 0 0xffff
+    get seq number 0 0xffff
+    assemble body {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       Id                      |        Seq                    |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    get data randupto [expr {$mbl-8}]
+    append body $data
+    return [list $body $code]
+}
+define icmp-echo-code 0 echo {} {}
+
+define icmp-type 13 timestamp {mbl} { icmp-timestamp }
+define icmp-type 14 timestampreply {mbl} { icmp-timestamp }
+proc icmp-timestamp {} {
+    get-for icmp-timestamp
+    get code enum 0 255
+    get id number 0 0xffff
+    get seq number 0 0xffff
+    get originate ip-timestamp
+    get receive ip-timestamp
+    get transmit ip-timestamp
+    assemble body {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |           Id                  |        Seq                    |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Originate                                                 |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Receive                                                   |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Transmit                                                  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    return [list $body $code]
+}
+define icmp-timestamp-code 0 timestamp {} {}
+
+define icmp-type 15 inforequest {mbl} { icmp-inforeq }
+define icmp-type 16 inforeply {mbl} { icmp-inforeq }
+proc icmp-inforeq {} {
+    get-for icmp-inforeq
+    get code enum 0 255
+    get id number 0 0xffff
+    get seq number 0 0xffff
+    assemble body {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |           Id                  |        Seq                    |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    return [list $body $code]
+}
+define icmp-inforeq-code 0 timestamp {} {}
+
+# MAYADD ICMP traceroute RFC1393
+# MAYADD ICMP router discovery RFC1256
+
+define ip-proto 17 udp {mtu} {
+    get-for udp
+    set dest_port 4321
+    get source_port number 0 0xffff
+    get data randupto [expr {$mtu-8}]
+    set length [packet-len $data]
+    set checksum 0
+    assemble udp {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |       Source Port             |        Dest Port              |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |         Length                |      ? Checksum               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+    }
+    append udp $data
+    get checksum choice 0.75
+    if {$checksum} {
+	set csum [packet-csum-ip $udp]
+	if {!$csum} { set csum 0xffff }
+    } else {
+	set csum 0
+    }
+    assembly-overwrite udp ${?_checksum} $csum
+}
+
+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"
+    } emsg]} {
+	puts stderr "\nERROR\n$count\n\n$emsg\n\n$errorInfo\n\n"
+	puts stdout "[format %06d $count] error"
+    }
+}
+
+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 }
+} else {
+    foreach count $argv { emit $count }
+}
-- 
2.30.2