#!/usr/bin/tclsh8.2
- package require profiler
- ::profiler::init
-
-
-set debug_level 1
+set debug_level 0
proc debug {level str} {
global debug_level
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
proc parse {format} {
set lno 0
set outbytes 0
+ set atend 0
debug 7 "ASSEMBLY $format"
foreach l [split $format "\n"] {
incr lno
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?"
}
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 {
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
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"
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}]
assemble icmp {
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Type | Code | ? Checksum |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Body ... |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
- append icmp $body
assembly-overwrite icmp ${?_checksum} [packet-csum-ip $icmp]
return $icmp
}
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]
}
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 {} {}
# 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 \
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
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 {
| Source Port | Dest Port |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Length | ? Checksum |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Data ... |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
- append udp $data
if {"$checksum" != "none"} {
set csum [packet-csum-ip $udp]
if {!$csum} { set csum 0xffff }
assemble packet {
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Auth |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | User ... |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
}
- append packet $user
}
resp-* {
assemble packet {
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
} 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]
-}
~ianmdlvl / vinegar-ip.git / blobdiff