From 8d49f0a4fa631295c3c0e2353c384f5065c38d6d Mon Sep 17 00:00:00 2001 From: ian Date: Sun, 3 Mar 2002 17:52:51 +0000 Subject: [PATCH] Probability adjustment. --- make-probes.tcl | 170 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 113 insertions(+), 57 deletions(-) diff --git a/make-probes.tcl b/make-probes.tcl index b8b520f..9026c99 100755 --- a/make-probes.tcl +++ b/make-probes.tcl @@ -94,7 +94,9 @@ proc choice-int {min max} { proc choice-prob {cv def} { set prob [config $cv $def] set rv 0x[random-bytes 3] - return [expr {$rv < double($prob)*0x1000000}] + set rv [expr {$rv < double($prob)*0x1000000}] + debug 2 "choice-prob $rv <- $prob ($cv)" + return $rv } proc choice-mult {args} { @@ -106,8 +108,12 @@ proc choice-mult {args} { set args [lreplace $args end end] foreach {val p} $args { set cump [expr {$cump + double($p)}] - if {$x < $cump} { return $val } + if {$x < $cump} { + debug 2 "choice-mult $val <= [concat $args [list $def]]" + return $val + } } + debug 2 "choice-mult $def <- [concat $args [list $def]]" return $def } @@ -124,11 +130,30 @@ proc config {cv def} { } -proc define {enum val name argnames body} { +proc define {enum val mult name argnames body} { + # mult may be: + # * full share of `known' enum values + # ? only as often as `random' enum values + # Or * or ? meaning /100 times as often as * or ?. + upvar #0 enum/val2name/$enum v2n + upvar #0 enum/val2mult/$enum v2m upvar #0 enum/name2val/$enum n2v + foreach kind {? *} { + upvar #0 enum/total$kind/$enum total$kind + if {![info exists total$kind]} { set total$kind 0 } + } + + regsub {^[?*]$} $mult {&100} mult + if {![regexp {^([?*])([0-9]+)$} $mult dummy kind times]} { + error "invalid mult $mult" + } + set v2n($val) $name + set v2m($val) [list $kind $times] set n2v($name) $val + incr total$kind $times + proc enum/val/$enum/$val $argnames $body } @@ -193,20 +218,50 @@ proc get/enum-rand {s v 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 [lsort [array names v2n]] [expr {$rv-1}]] +proc enum-prepare-choice-list {s v nvalues prand} { + upvar #0 "enum/choice-list/$s-${v}($nvalues $prand)" cl + upvar #0 enum/val2mult/$s-$v v2m + upvar #0 enum/total*/$s-$v total*org + upvar #0 enum/total?/$s-$v total? + + set total* ${total*org} + if {!${total*}} { set total* [expr {double(${total*org}) + 0.001}] } + + set pr $prand + if {!${total?}} { set pr 0.0 } + set pm? [expr {$pr / (100.0*double($nvalues))}] + set pm* [expr {(1.0 - $pr) / double(${total*})}] + debug 1 "epcl $s-$v $nvalues $prand: pr $pr ? pm ${pm?} total ${total?} * pm ${pm*} total ${total*}" + + set cl {} + foreach rv [lsort [array names v2m]] { + manyset $v2m($rv) kind times + set p [expr { double($times) * [set pm$kind] }] + debug 1 "epcl $s-$v $nvalues $prand: $rv $kind$times := $p" + lappend cl $rv $p + } + if {${total*org}} { + set cl [lreplace $cl end end] + } else { + lappend cl * + } +} + +proc get/enum-def {s v min max prand} { + set nvalues [expr {$max-$min+1}] + upvar #0 "enum/choice-list/$s-${v}($nvalues $prand)" cl + if {![info exists cl]} { enum-prepare-choice-list $s $v $nvalues $prand } + set rv [eval choice-mult $cl] + if {"$rv" == "*"} { set rv [choice-int $min $max] } return [get-enum-got $s $v $rv] } proc get/enum {s v min max prand} { - get-for $s-$v - get any choice $prand + set any [choice-prob $s-$v-any $prand] if {$any} { return [get/enum-rand $s $v $min $max] } else { - return [get/enum-def $s $v] + return [get/enum-def $s $v $min $max $prand] } } @@ -522,7 +577,7 @@ proc gen_1_ip {mtu source_spec dest_spec} { get frag number 0 0x1fff } get-config ttl 255 number 0 255 - get proto enum 1 255 0.05 + get proto enum 0 255 0.2 set flags [expr {$df*2 + $mf}] set header_checksum 0 @@ -557,7 +612,7 @@ proc gen_1_ip {mtu source_spec dest_spec} { return $ip } -define ip-proto 1 icmp {mtu} { +define ip-proto 1 *50 icmp {mtu} { # RFC792 get-for icmp get type enum 0 255 0.2 @@ -576,7 +631,7 @@ define ip-proto 1 icmp {mtu} { } proc define-icmp-type-vanilla {num name} { - define icmp-type $num $name {mbl} "icmp-vanilla \$mbl [list $name]" + define icmp-type $num * $name {mbl} "icmp-vanilla \$mbl [list $name]" } proc icmp-vanilla {mbl typename} { get-for icmp-$typename @@ -586,24 +641,24 @@ proc icmp-vanilla {mbl typename} { } 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-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-timeout-code 0 * intransit {} {} +define icmp-timeout-code 1 * fragment {} {} define-icmp-type-vanilla 12 parameters -define icmp-parameters-code 0 seepointer {} {} +define icmp-parameters-code 0 * seepointer {} {} define-icmp-type-vanilla 4 sourcequench -define icmp-sourcequench-code 0 quench {} {} +define icmp-sourcequench-code 0 * quench {} {} -define icmp-type 5 redirect {mbl} { +define icmp-type 5 * redirect {mbl} { get-for icmp-redirect get code enum 0 255 0.4 get gateway v4addr @@ -618,13 +673,13 @@ define icmp-type 5 redirect {mbl} { 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-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 } +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 0.4 @@ -640,10 +695,10 @@ proc icmp-echo {mbl} { } return [list $body $code] } -define icmp-echo-code 0 echo {} {} +define icmp-echo-code 0 * echo {} {} -define icmp-type 13 timestamp {mbl} { icmp-timestamp } -define icmp-type 14 timestampreply {mbl} { icmp-timestamp } +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 0.4 @@ -665,10 +720,10 @@ proc icmp-timestamp {} { } return [list $body $code] } -define icmp-timestamp-code 0 timestamp {} {} +define icmp-timestamp-code 0 * timestamp {} {} -define icmp-type 15 inforequest {mbl} { icmp-inforeq } -define icmp-type 16 inforeply {mbl} { icmp-inforeq } +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 0.4 @@ -681,13 +736,13 @@ proc icmp-inforeq {} { } return [list $body $code] } -define icmp-inforeq-code 0 timestamp {} {} +define icmp-inforeq-code 0 * timestamp {} {} # MAYADD ICMP traceroute RFC1393 # MAYADD ICMP router discovery RFC1256 -define ip-proto 4 ip {mtu} { +define ip-proto 4 * ip {mtu} { # RFC2003 get-for ip-ip get source v4addr @@ -696,7 +751,7 @@ define ip-proto 4 ip {mtu} { } -define ip-proto 2 igmp {mtu} { +define ip-proto 2 ? igmp {mtu} { get-for igmp get type enum 0 255 0.5 get timeout number 0 255 @@ -722,13 +777,13 @@ define ip-proto 2 igmp {mtu} { return $igmp } -define igmp-type 17 membquery {} {} -define igmp-type 16 membreport {} {} -define igmp-type 23 leavegroup {} {} -define igmp-type 18 membreport {} {} +define igmp-type 17 * membquery {} {} +define igmp-type 16 * membreport {} {} +define igmp-type 23 * leavegroup {} {} +define igmp-type 18 * membreport {} {} -define ip-proto 51 ah {mtu} { +define ip-proto 51 ? ah {mtu} { # RFC1826 get-for ah get next number 0 255 @@ -756,7 +811,7 @@ proc udp-rport {} { return $port } -define ip-proto 17 udp {mtu} { +define ip-proto 17 * udp {mtu} { # RFC768 get-for udp @@ -765,14 +820,15 @@ define ip-proto 17 udp {mtu} { checksum_none 0.20 \ checksum_good] + set prand 0.50 get style choice-mult \ + random $prand \ request 0.15 \ reply 0.15 \ - servers 0.20 \ - random + servers if {"$style" != "random"} { - get port enum-def + get port enum-def 0 255 $prand set def_port $port } else { set def_port x @@ -830,7 +886,7 @@ define ip-proto 17 udp {mtu} { return $udp } -define udp-port 50 remailck {mtu style} { +define udp-port 50 ?200 remailck {mtu style} { # RFC1339 get-for remailck if {"$style" == "request"} { @@ -923,7 +979,7 @@ define udp-port 50 remailck {mtu style} { return $payload } -define remailck-auth 31 passwd {mtu} { +define remailck-auth 31 * passwd {mtu} { get-for remailck-passwd get passwd string 6 8 \ 0123456789abcdefghijklmnopqrstuvxwyz \ @@ -931,8 +987,8 @@ define remailck-auth 31 passwd {mtu} { return $passwd } -define udp-port 67 dhcpserv {mtu style} { return [dhcp $mtu] } -define udp-port 68 dhcpclient {mtu style} { return [dhcp $mtu] } +define udp-port 67 ? dhcpserv {mtu style} { return [dhcp $mtu] } +define udp-port 68 ? dhcpclient {mtu style} { return [dhcp $mtu] } proc dhcp {mtu} { get-for dhcp get op enum 0 255 0.2 @@ -974,12 +1030,12 @@ proc dhcp {mtu} { return $dhcp } -define dhcp-op 1 request {} {} -define dhcp-op 2 reply {} {} -define dhcp-htype 1 ethernet {} {} +define dhcp-op 1 * request {} {} +define dhcp-op 2 * reply {} {} +define dhcp-htype 1 * ethernet {} {} -define ip-proto 6 tcp {mtu} { +define ip-proto 6 * tcp {mtu} { # RFC793 get-for tcp @@ -1115,7 +1171,7 @@ define ip-proto 6 tcp {mtu} { return $packet } -define tcp-opt 2 mss {mdl} { +define tcp-opt 2 * mss {mdl} { get-for tcp-opt get mss hex 0 0xffff assemble od { -- 2.30.2