build system, tests: Marginally speed some things up with -f

[secnet.git] / stest / common.tcl

diff --git a/stest/common.tcl b/stest/common.tcl
index ca503314eec88d75e651e8c6ba5a3aa108de45cb..0c1202ca378b3b34ed58820447a0a206a13ec628 100644 (file)
--- a/stest/common.tcl
+++ b/stest/common.tcl
@@ -1,3 +1,5 @@
+source test-common.tcl
+
 package require Tclx
 
 load chiark_tcl_hbytes-1.so
@@ -23,21 +25,23 @@ set extra(inside) {
 }
 set extra(outside) {}
 
-proc mkconf {which} {
+proc mkconf {location site} {
     global tmp
+    global builddir
     global netlink
     global ports
     global extra
     global netlinkfh
-    set pipefp $tmp/$which.netlink
+    set pipefp $tmp/$site.netlink
     foreach tr {t r} {
        file delete $pipefp.$tr
        exec mkfifo -m600 $pipefp.$tr
-       set netlinkfh($which.$tr) [set fh [open $pipefp.$tr r+]]
+       set netlinkfh($site.$tr) [set fh [open $pipefp.$tr r+]]
        fconfigure $fh -blocking 0 -buffering none -translation binary
     }
-    fileevent $netlinkfh($which.r) readable [list netlink-readable $which]
-    set fakeuf $tmp/$which.fake-userv
+    fileevent $netlinkfh($site.r) readable \
+       [list netlink-readable $location $site]
+    set fakeuf $tmp/$site.fake-userv
     set fakeuh [open $fakeuf w 0755]
     puts $fakeuh "#!/bin/sh
 set -e
@@ -53,15 +57,15 @@ exec cat
        netlink userv-ipif {
            name \"netlink\";
             userv-path \"$fakeuf\";
-       $netlink($which)
+       $netlink($site)
            mtu 1400;
            buffer sysbuffer(2048);
-           interface \"secnet-test-[string range $which 0 0]\";
+           interface \"secnet-test-[string range $site 0 0]\";
         };
         comm
 "
     set delim {}
-    foreach port $ports($which) {
+    foreach port $ports($site) {
        append cfg "$delim
            udp {
                 port $port;
@@ -72,10 +76,10 @@ exec cat
         set delim ,
     }
     append cfg ";
-       local-name \"test-example/$which/$which\";
-       local-key rsa-private(\"test-example/$which.key\");
+       local-name \"test-example/$location/$site\";
+       local-key rsa-private(\"$builddir/test-example/$site.key\");
 "
-    append cfg $extra($which)
+    append cfg $extra($site)
     append cfg {
        log logfile {
            filename "/dev/tty";
@@ -90,37 +94,38 @@ exec cat
        transform eax-serpent { }, serpent256-cbc { };
     }
 
-    set f [open test-example/sites.conf r]
+    set f [open $builddir/test-example/sites.conf r]
     set sites [read $f]
     close $f
     append cfg $sites
     append cfg {
-       sites map(site,vpn/test-example/all-sites);
+       sites map(site,all-sites);
     }
     return $cfg
 }
 
-proc spawn-secnet {which} {
-    global netlinkfh
+proc spawn-secnet {location site} {
     global tmp
-    upvar #0 pids($which) pid
-    set cf $tmp/$which.conf
+    global builddir
+    global netlinkfh
+    upvar #0 pids($site) pid
+    set cf $tmp/$site.conf
     set ch [open $cf w]
-    puts $ch [mkconf $which]
+    puts $ch [mkconf $location $site]
     close $ch
-    set argl [list strace -o$tmp/$which.strace ./secnet -dvnc $cf]
+    set argl [list $builddir/secnet -dvnc $cf]
     set pid [fork]
     if {!$pid} {
        execl [lindex $argl 0] [lrange $argl 1 end]
     }
-    puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0]
+    puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
 }
 
-proc netlink-readable {which} {
+proc netlink-readable {location site} {
     global ok
-    upvar #0 netlinkfh($which.r) fh
+    upvar #0 netlinkfh($site.r) fh
     read $fh; # empty the buffer
-    switch -exact $which {
+    switch -exact $site {
        inside {
            puts OK
            set ok 1; # what a bodge
@@ -161,28 +166,14 @@ proc sendpkt {} {
        [hbytes h2raw c0[join $p ""]c0]
 }
 
-if {![catch {
-    set tmp $env(AUTOPKGTEST_ARTIACTS)
-}]} {} elseif {![catch {
-    set tmp $env(AUTOPKGTEST_TMP)
-}]} {} elseif {[regsub {^stest/t-} $argv0 {stest/d-} tmp]} {
-    file mkdir $tmp
-}
-
 set socktmp $tmp/s
 exec mkdir -p -m700 $socktmp
 regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
 
-proc prefix_preload {lib} {
-    global env
-    set l {}
-    catch { set l [split $env(PRELOAD) :] }
-    set l [concat [list $lib] $l]
-    set env(LD_PRELOAD) [join $l :]
-}
+proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
 
 set env(UDP_PRELOAD_DIR) $socktmp
-prefix_preload stest/udp-preload.so
+prefix_preload $builddir/stest/udp-preload.so
 
 proc udp-proxy {} {
     global socktmp udpsock
@@ -218,8 +209,8 @@ proc udp-relay {data src sock args} {
 
 proc test-kex {} {
     udp-proxy
-    spawn-secnet inside
-    spawn-secnet outside
+    spawn-secnet in inside
+    spawn-secnet out outside
 
     after 500 sendpkt
     after 1000 sendpkt