From: ian <ian>
Date: Sat, 2 Mar 2002 17:06:37 +0000 (+0000)
Subject: Does re-mail-ck.  About to profile
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=vinegar-ip.git;a=commitdiff_plain;h=cd3164c561a6099105e4bcf0332991d6ecccc9a7

Does re-mail-ck.  About to profile
---

diff --git a/make-probes.tcl b/make-probes.tcl
index 8782f1a..f41cae1 100755
--- a/make-probes.tcl
+++ b/make-probes.tcl
@@ -63,7 +63,7 @@ namespace import Random-Bytes::*
 proc choice-int {min max} {
     set rv 0x[random-bytes 3]
     return [expr {
-	int( double($rv) / double(0xffffff) * double($max+1-$min) )
+	int( double($rv) / double(0x1000000) * double($max+1-$min) )
 	+ $min
     }]
 }
@@ -74,6 +74,19 @@ proc choice-prob {cv def} {
     return [expr {$rv < double($prob)*0x1000000}]
 }
 
+proc choice-mult {args} {
+    if {!([llength $args] % 2)} { error "choice-mult must have default" }
+    set x 0x[random-bytes 3]
+    set x [expr { double($x) / double(0x1000000) }]
+    set cump 0.0
+    set def [lindex $args end]
+    set args [lreplace $args end end]
+    foreach {val p} $args {
+	set cump [expr {$cump + double($p)}]
+	if {$x < $cump} { return $val }
+    }
+    return $def
+}
 
 proc getlog {msg} {
     upvar #0 getlog_log log
@@ -105,7 +118,7 @@ proc depending-on {scope enum_and_var mtu mtuadjust args} {
 	# half the time random
 	getlog (junk)
 	get-for $scope-fill
-	get data randupto $mtu
+	get data rand 0 $mtu
 	return $data
     } else {
 	uplevel 1 [list $procname] $mtu $args
@@ -140,14 +153,8 @@ proc get-config {variable def kind args} {
     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}]]
-    }
+proc get-enum-got {s v rv} {
+    upvar #0 enum/val2name/$s-$v v2n
     if {[info exists v2n($rv)]} {
 	getlog "$v=$v2n($rv)\[$rv]"
     } else {
@@ -156,6 +163,28 @@ proc get/enum {s v min max} {
     return $rv
 }
 
+proc get/enum-rand {s v min max} {
+    set rv [choice-int $min $max]
+    return [get-enum-got $s $v $rv]
+}
+
+proc get/enum-def {s v} {
+    upvar #0 enum/val2name/$s-$v v2n
+    set rv [choice-int 1 [array size v2n]]
+    set rv [lindex [array names v2n] [expr {$rv-1}]]
+    return [get-enum-got $s $v $rv]
+}
+
+proc get/enum {s v min max prand} {
+    get-for $s-$v
+    get any choice $prand
+    if {$any} {
+	return [get/enum-rand $s $v $min $max]
+    } else {
+	return [get/enum-def $s $v]
+    }
+}
+
 proc get/number {s v min max} {
     set rv [choice-int $min $max]
     getlog "$v=$rv"
@@ -174,9 +203,9 @@ proc get/choice {s v defprob} {
     return $rv
 }
 
-proc get/randupto {s v maxlen} {
+proc get/rand {s v minlen maxlen} {
     get-for $s-$v
-    get l number 0 $maxlen
+    get l number $minlen $maxlen
     return [random-bytes $l]
 }
 
@@ -200,6 +229,24 @@ proc get/v4addr {s v} {
     return $rv
 }
 
+proc get/choice-mult {s v args} {
+    set rv [eval choice-mult $args]
+    getlog "($rv)"
+    return $rv
+}
+
+proc get/string {s v minlen maxlen first rest} {
+    set o {}
+    set now $first
+    for {set l [choice-int $minlen $maxlen]} {$l>0} {incr l -1} {
+	set cn [choice-int 0 [expr {[string length $now]-1}]]
+	append o [string index $now $cn]
+	set now $rest
+    }
+    getlog "$v=\"$o\""
+    return $o
+}
+
 
 proc assemble {outvarname format} {
     # format should look like those RFC diagrams.
@@ -365,7 +412,7 @@ proc gen_1_ip {mtu} {
 	get frag number 0 0x1fff
     }
     get-config ttl 255 number 0 255
-    get proto enum 1 255
+    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
@@ -395,7 +442,7 @@ proc gen_1_ip {mtu} {
 define ip-proto 1 icmp {mtu} {
     # RFC792
     get-for icmp
-    get type enum 0 255
+    get type enum 0 255 0.2
     manyset [depending-on icmp type $mtu -4] body code
     if {![string length $code]} { get code number 0 255 }
     set checksum 0
@@ -414,8 +461,8 @@ proc define-icmp-type-vanilla {num name} {
 }
 proc icmp-vanilla {mbl typename} {
     get-for icmp-$typename
-    get code enum 0 255
-    get body randupto $mbl
+    get code enum 0 255 0.4
+    get body rand 0 $mbl
     return [list $body $code]
 }
 
@@ -439,14 +486,14 @@ define icmp-sourcequench-code 0 quench {} {}
 
 define icmp-type 5 redirect {mbl} {
     get-for icmp-redirect
-    get code enum 0 255
+    get code enum 0 255 0.4
     get gateway v4addr
     assemble body {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    |                 Gateway                                       |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    get data randupto [expr {$mbl-4}]
+    get data rand 0 [expr {$mbl-4}]
     append body $data
     return [list $body $code]
 }
@@ -460,7 +507,7 @@ 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 code enum 0 255 0.4
     get id number 0 0xffff
     get seq number 0 0xffff
     assemble body {
@@ -468,7 +515,7 @@ proc icmp-echo {mbl} {
    |       Id                      |        Seq                    |
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
-    get data randupto [expr {$mbl-8}]
+    get data rand 0 [expr {$mbl-8}]
     append body $data
     return [list $body $code]
 }
@@ -478,7 +525,7 @@ 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 code enum 0 255 0.4
     get id number 0 0xffff
     get seq number 0 0xffff
     get originate ip-timestamp
@@ -503,7 +550,7 @@ 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 code enum 0 255 0.4
     get id number 0 0xffff
     get seq number 0 0xffff
     assemble body {
@@ -518,11 +565,45 @@ define icmp-inforeq-code 0 timestamp {} {}
 # MAYADD ICMP traceroute RFC1393
 # MAYADD ICMP router discovery RFC1256
 
+proc port_pair_data {scope mtu mtuadjust} {
+    get-for $scope
+
+    get style choice-mult \
+	    request 0.24 \
+	    reply 0.24 \
+	    random 0.16 \
+	    servers
+
+    if {"$style" != "random"} {
+	get port enum-def
+	set def_port $port
+    }
+    if {"$style" != "servers"} {
+	get port enum-rand 0 0xffff
+	set rand_port $port
+    }
+    switch -exact $style {
+	random  { set source_port $rand_port; set dest_port $rand_port }
+	request { set source_port $rand_port; set dest_port $def_port }
+	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]
+}
+
 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}]
+    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
     set length [packet-len $data]
     set checksum 0
     assemble udp {
@@ -533,19 +614,109 @@ define ip-proto 17 udp {mtu} {
    +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
     }
     append udp $data
-    get checksum choice 0.75
-    if {$checksum} {
+    if {"$checksum" != "none"} {
 	set csum [packet-csum-ip $udp]
 	if {!$csum} { set csum 0xffff }
+	if {"$checksum" == "bad"} {
+	    get error number 1 0xffff
+	    set csum [expr {$csum ^ $error}]
+	}
     } else {
 	set csum 0
     }
     assembly-overwrite udp ${?_checksum} $csum
 }
 
-
-
-
+define udp-port 50 remailck {mtu style} {
+    get-for remailck
+    if {"$style" == "request"} {
+	get what choice-mult \
+		req-baduser 0.15 \
+		req-auth 0.15 \
+		resp-ok 0.15 \
+		resp-auth 0.15 \
+		req-user
+    } else {
+	get what choice-mult \
+		req-baduser 0.15 \
+		req-auth 0.15 \
+		resp-auth 0.15 \
+		req-user 0.15 \
+		resp-ok
+    }
+    switch -exact $what {
+	req-user {
+	    set auth 0
+	    get user string 1 8 \
+		    abcdefghijklmnopqrustuvwxyz \
+		    abcdefghijklmnopqrustuvwxyz-0123456789_
+	}
+	req-baduser {
+	    set auth 0
+	    get user rand 0 [expr {$mtu - 4}]
+	}
+	req-auth {
+	    get auth enum 0 31
+	    set user [depending-on auth {$mtu - 4}]
+	}
+	resp-auth {
+	    get auth number 0 0xffff
+	    set modified 0
+	    set read 0
+	}
+	resp-ok {
+	    get mail choice-mult \
+		    newmail 0.15 \
+		    oldmail 0.15 \
+		    nomail 0.20 \
+		    times
+	    set auth 0
+	    switch -exact $mail {
+		newmail {
+		    set modified 0
+		    set read 1
+		}
+		oldmail {
+		    set modified 1
+		    set read 0
+		}
+		nomail {
+		    set modified 0
+		    set read 0
+		}
+		times {
+		    get modified number 1 600
+		    get read number 1 600
+		}
+		default { error "mail? $mail" }
+	    }
+	}
+	default { error "what? $what" }
+    }
+    switch -glob $what {
+	req-* {
+            assemble packet {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |         Auth                                                  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+            }
+	    append packet $user
+	}
+	resp-* {
+	    assemble packet {
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |         Auth                                                  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |         Modified                                              |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+   |         Read                                                  |
+   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+            }
+	}
+	default { error "what?? $what" }
+    }
+    return $packet
+}
 
 proc emit {count} {
     global getlog_log errorInfo