From 3c4ada9dd8943828d917b9830cb4218bbfc5cd79 Mon Sep 17 00:00:00 2001
From: ian <ian>
Date: Sat, 2 Mar 2002 18:38:03 +0000
Subject: [PATCH] Appending in formatting

---
 make-probes.tcl | 204 +++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 159 insertions(+), 45 deletions(-)

diff --git a/make-probes.tcl b/make-probes.tcl
index 52a580e..8c912d3 100755
--- a/make-probes.tcl
+++ b/make-probes.tcl
@@ -1,11 +1,7 @@
 #!/usr/bin/tclsh8.2
 
 
-       package require profiler
-       ::profiler::init
-
-
-set debug_level 1
+set debug_level 0
 
 proc debug {level str} {
     global debug_level
@@ -265,9 +261,10 @@ 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.
-	# Tabs are forbidden.
+	# 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.
 	#
 	# Field names are converted to lowercase; internal spaces
 	# are replaced with _.  They are then assumed to be
@@ -307,6 +304,7 @@ namespace eval Assembler {
     proc parse {format} {
 	set lno 0
 	set outbytes 0
+	set atend 0
 	debug 7 "ASSEMBLY $format"
 	foreach l [split $format "\n"] {
 	    incr lno
@@ -315,7 +313,7 @@ namespace eval Assembler {
 		    error "vspace not in data @$lno\n?$l?"
 		}
 		incr words
-	    } elseif {[regexp -nocase {^ *[|? a-z0-9]+$} $l]} {
+	    } elseif {[regexp -nocase {^ *[|? a-z0-9.]+$} $l]} {
 		if {[info exists words]} {
 		    error "data without delimline @$lno\n?$l?"
 		}
@@ -342,10 +340,18 @@ namespace eval Assembler {
 		    incr outbytes [expr {$words*$wordbits/8}]
 		    set l $cue
 		    while {[regexp -nocase \
-			    {^([ =]*)\|( *[? a-z0-9]*[a-z0-9] *)\|(.*)$} \
+			    {^([ =]*)\|( *[? 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 {
@@ -364,7 +370,15 @@ namespace eval Assembler {
 			set bitlen [expr {
 			    $atpos($p2) - $atpos($p1) + ($words-1)*$wordbits
 			}]
-			set location [list $bit1 $bitlen $varname]
+			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
@@ -378,6 +392,9 @@ namespace eval Assembler {
 			append l |$after
 		    }
 		    debug 7 "REMAIN ?$l?"
+		    if {![regexp {^[ =]*\|? *$} $l]} {
+			error "unclear @$lno\n?$l?"
+		    }
 		} else {
 		    if {$wordbits % 8 || $wordbits >32} {
 			error "bad wordbits $wordbits @$lno ?$l? $newlineform"
@@ -397,16 +414,23 @@ namespace eval Assembler {
     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)} {
+	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}]
-	    set repl [format %0${charlen}x $value]
-	    set out [string replace $out $char0no $chareno $repl]
+	    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}]
@@ -486,9 +510,10 @@ define ip-proto 1 icmp {mtu} {
     assemble icmp {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |     Type      |     Code      |        ? Checksum             |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Body ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    append icmp $body
     assembly-overwrite icmp ${?_checksum} [packet-csum-ip $icmp]
     return $icmp
 }
@@ -525,13 +550,14 @@ define icmp-type 5 redirect {mbl} {
     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]
 }
 
@@ -547,13 +573,14 @@ proc icmp-echo {mbl} {
     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 {} {}
@@ -602,7 +629,7 @@ define icmp-inforeq-code 0 timestamp {} {}
 # 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 \
@@ -614,6 +641,8 @@ proc port_pair_data {scope mtu mtuadjust} {
     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
@@ -625,22 +654,25 @@ proc port_pair_data {scope mtu mtuadjust} {
 	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_none 0.20 \
 	    checksum_good
-    manyset [port_pair_data udp $mtu 8] source_port dest_port 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 [packet-len $data]
     set checksum 0
     assemble udp {
@@ -648,9 +680,10 @@ define ip-proto 17 udp {mtu} {
    |       Source Port             |        Dest Port              |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |         Length                |      ? Checksum               |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     Data ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    append udp $data
     if {"$checksum" != "none"} {
 	set csum [packet-csum-ip $udp]
 	if {!$csum} { set csum 0xffff }
@@ -735,9 +768,10 @@ define udp-port 50 remailck {mtu style} {
             assemble packet {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |         Auth                                                  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |     User ...                                                  |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
             }
-	    append packet $user
 	}
 	resp-* {
 	    assemble packet {
@@ -763,6 +797,100 @@ 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
+# }
+# 
+
 
 proc emit {count} {
     global getlog_log errorInfo
@@ -784,17 +912,3 @@ if {![llength $argv]} {
 } else {
     foreach count $argv { emit $count }
 }
-
-
-puts [::profiler::dump]
-
-puts ---------------------IWJ
-
-puts [::profiler::print]
-
-puts ---------------------IWJ
-
-foreach i [::profiler::sortFunctions totalRuntime] {
-    manyset $i f v
-    puts [::profiler::print $f]
-}
-- 
2.30.2