chiark
/
gitweb
/
~ian
/
secnet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
tests: Rename locations to `in' and `out'
[secnet.git]
/
stest
/
common.tcl
diff --git
a/stest/common.tcl
b/stest/common.tcl
index ca503314eec88d75e651e8c6ba5a3aa108de45cb..7ed810f689faf24cf98988bf09fc74727b4f9fbe 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
package require Tclx
load chiark_tcl_hbytes-1.so
@@
-23,21
+25,23
@@
set extra(inside) {
}
set extra(outside) {}
}
set extra(outside) {}
-proc mkconf {
which
} {
+proc mkconf {
location site
} {
global tmp
global tmp
+ global builddir
global netlink
global ports
global extra
global netlinkfh
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
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
}
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
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 userv-ipif {
name \"netlink\";
userv-path \"$fakeuf\";
- $netlink($
which
)
+ $netlink($
site
)
mtu 1400;
buffer sysbuffer(2048);
mtu 1400;
buffer sysbuffer(2048);
- interface \"secnet-test-[string range $
which
0 0]\";
+ interface \"secnet-test-[string range $
site
0 0]\";
};
comm
"
set delim {}
};
comm
"
set delim {}
- foreach port $ports($
which
) {
+ foreach port $ports($
site
) {
append cfg "$delim
udp {
port $port;
append cfg "$delim
udp {
port $port;
@@
-72,10
+76,10
@@
exec cat
set delim ,
}
append cfg ";
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";
append cfg {
log logfile {
filename "/dev/tty";
@@
-90,7
+94,7
@@
exec cat
transform eax-serpent { }, serpent256-cbc { };
}
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
set sites [read $f]
close $f
append cfg $sites
@@
-100,27
+104,28
@@
exec cat
return $cfg
}
return $cfg
}
-proc spawn-secnet {which} {
- global netlinkfh
+proc spawn-secnet {location site} {
global tmp
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]
set ch [open $cf w]
- puts $ch [mkconf $
which
]
+ puts $ch [mkconf $
location $site
]
close $ch
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]
}
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
global ok
- upvar #0 netlinkfh($
which
.r) fh
+ upvar #0 netlinkfh($
site
.r) fh
read $fh; # empty the buffer
read $fh; # empty the buffer
- switch -exact $
which
{
+ switch -exact $
site
{
inside {
puts OK
set ok 1; # what a bodge
inside {
puts OK
set ok 1; # what a bodge
@@
-161,28
+166,14
@@
proc sendpkt {} {
[hbytes h2raw c0[join $p ""]c0]
}
[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 /
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
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
proc udp-proxy {} {
global socktmp udpsock
@@
-218,8
+209,8
@@
proc udp-relay {data src sock args} {
proc test-kex {} {
udp-proxy
proc test-kex {} {
udp-proxy
- spawn-secnet inside
- spawn-secnet outside
+ spawn-secnet in
in
side
+ spawn-secnet out
out
side
after 500 sendpkt
after 1000 sendpkt
after 500 sendpkt
after 1000 sendpkt