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 {}
+ random-bytes-init $use_gen_counter
set getlog_log {}
}
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
+
+namespace eval Random-Bytes {
+ namespace export random-bytes random-bytes-init
+
+ proc random-bytes-init {seed} {
+ variable counter
+ variable fh
+ catch { set h $fh; unset fh; close $h }
+ set counter 0
+ set fh [open |[list openssl bf-ofb < /dev/zero -e -k " $seed"] r]
+ fconfigure $fh -translation binary
+ }
+ proc random-bytes {n} {
+ variable fh
+ set x [read $fh $n]
+ if {[string length $x] != $n} {
+ set h $fh; unset fh; close $h
+ error "openssl bf-ofb exited unexpectedly"
}
- append o [string range $rand_buf 0 [expr {$w-1}]]
- set rand_buf [string range $rand_buf $w end]
+ binary scan $x H* y
+ if {[string length $y] != $n*2} { error "binary format failed $n $y" }
+ return $y
}
- return $o
}
+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
}]
}
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
# 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
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 {
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"
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]
}
for {set i 0} {$i<4} {incr i} {
set b [random-bytes 1]
append rv $b
- append p $d [format %d $b]
+ append p $d [format %d 0x$b]
set d .
}
getlog "$v=$p"
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.
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]]
+ 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]
+ } else {
+ 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
+ incr bitlen -1
+ incr bit1
+ }
}
}
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
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
assembly-overwrite ip ${?_header_checksum} [packet-csum-ip $ip]
- append $ip $body
+ append ip $body
return $ip
}
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
}
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]
}
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]
}
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 {
| Id | Seq |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
- get data randupto [expr {$mbl-8}]
+ get data rand 0 [expr {$mbl-8}]
append body $data
return [list $body $code]
}
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
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 {
# 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 {
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
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
if {[catch {
~ianmdlvl / vinegar-ip.git / blobdiff