X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=stest%2Fcommon.tcl;h=7891e1d4a4901ce696242b550c92a2767b1a0eb9;hb=c9b81d7160651322ed81520e851152e9e9fb2644;hp=064d8740fe245b9295e2688dfc618f641d448b6d;hpb=c51dedf733b465a6f68195ddd5965d1653c696c1;p=secnet.git diff --git a/stest/common.tcl b/stest/common.tcl index 064d874..7891e1d 100644 --- a/stest/common.tcl +++ b/stest/common.tcl @@ -111,7 +111,10 @@ proc spawn-secnet {location site} { global builddir global netlinkfh global env + global pidmap + global readbuf upvar #0 pids($site) pid + set readbuf($site) {} set cf $tmp/$site.conf set ch [open $cf w] puts $ch [mkconf $location $site] @@ -145,6 +148,7 @@ proc spawn-secnet {location site} { } if {[llength $argl]} { set pid [fork] + set pidmap($pid) "secnet $location/$site" if {!$pid} { execl [lindex $argl 0] [lrange $argl 1 end] } @@ -154,13 +158,37 @@ proc spawn-secnet {location site} { proc netlink-readable {location site} { global ok + upvar #0 readbuf($site) buf upvar #0 netlinkfh($site.r) fh - read $fh; # empty the buffer + while 1 { + set x [read $fh] + set h [hbytes raw2h $x] + if {![hbytes length $h]} return + append buf $h + #puts "READABLE $site buf=$buf" + while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} { + #puts "READABLE $site now=$now (buf=$buf)" + regsub -all {^((?:..)*?)dbdc} $now {\1c0} now + regsub -all {^((?:..)*?)dbdd} $now {\1db} now + puts "netlink-got-packet $location $site $now" + netlink-got-packet $location $site $now + } + } +} + +proc netlink-got-packet {location site data} { + if {![hbytes length $data]} return switch -exact $site { inside { - puts OK - set ok 1; # what a bodge - return + switch -glob $data { + 45000054ed9d4000fe0166d9ac12e802ac12e80900* { + puts "OK $data" + finish 0 + } + * { + error "unexpected $site $data" + } + } } outside { error "inside rx'd!" @@ -208,9 +236,29 @@ prefix_preload $builddir/stest/udp-preload.so proc finish {estatus} { puts stderr "FINISHING $estatus" + signal default SIGCHLD + global pidmap + foreach pid [array names pidmap] { + kill KILL $pid + } exit $estatus } +proc reap {} { + global pidmap + #puts stderr REAPING + foreach pid [array names pidmap] { + set got [wait -nohang $pid] + if {![llength $got]} continue + set info $pidmap($pid) + unset pidmap($pid) + puts stderr "reaped $info: $got" + finish 1 + } +} + +signal -restart trap SIGCHLD { after idle reap } + proc udp-proxy {} { global socktmp udpsock set u $socktmp/udp