X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=stest%2Fcommon.tcl;h=e9ca6583e56581e798248fe4aefe6db585e0bcb8;hb=c9063b891fe3f1edc9fe67bb123f100a221d7c4f;hp=5952e9107bc6fbc6eb43a8a4302d7e0dd33a7657;hpb=6b4910f2646ac9cfda9b9426099d494218c28e0c;p=secnet.git diff --git a/stest/common.tcl b/stest/common.tcl index 5952e91..e9ca658 100644 --- a/stest/common.tcl +++ b/stest/common.tcl @@ -83,7 +83,7 @@ exec cat append cfg " log logfile { prefix \"$site\"; - class \"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\"; + class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\"; }; " append cfg { @@ -110,15 +110,46 @@ proc spawn-secnet {location site} { global tmp global builddir global netlinkfh + global env + global pidmap upvar #0 pids($site) pid set cf $tmp/$site.conf set ch [open $cf w] puts $ch [mkconf $location $site] close $ch set argl [list $builddir/secnet -dvnc $cf] - set pid [fork] - if {!$pid} { - execl [lindex $argl 0] [lrange $argl 1 end] + set divertk SECNET_STEST_DIVERT_$site + puts -nonewline "spawn" + foreach k [array names env] { + switch -glob $k { + SECNET_STEST_DIVERT_* - + SECNET_TEST_BUILDDIR { } + *SECNET* - + *PRELOAD* { puts -nonewline " $k=$env($k)" } + } + } + puts " $argl" + if {[info exists env($divertk)]} { + switch -glob $env($divertk) { + i { + puts -nonewline "run ^ command, hit return " + flush stdout + gets stdin + set argl {} + } + 0 - "" { + } + * { + set argl [split $env($divertk)] + } + } + } + if {[llength $argl]} { + set pid [fork] + set pidmap($pid) "secnet $location/$site" + if {!$pid} { + execl [lindex $argl 0] [lrange $argl 1 end] + } } puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0] } @@ -151,7 +182,7 @@ $message ---------------------------------------- " } - exit 1 + finish 1 } proc sendpkt {} { @@ -170,13 +201,18 @@ proc sendpkt {} { set socktmp $tmp/s exec mkdir -p -m700 $socktmp -regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or / +regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or / proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib } set env(UDP_PRELOAD_DIR) $socktmp prefix_preload $builddir/stest/udp-preload.so +proc finish {estatus} { + puts stderr "FINISHING $estatus" + exit $estatus +} + proc udp-proxy {} { global socktmp udpsock set u $socktmp/udp