X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=stest%2Fcommon.tcl;h=9a7e38f4525391b8603f32d37e5d2c40dc17418f;hb=fe1a9b27be026ab3625267c08db4022edb5dafc9;hp=12203aa40ddb6bcad7666db95b88441ae43d6156;hpb=0f8347d34ed1cc76a44a376b5fd92c9517da9287;p=secnet.git diff --git a/stest/common.tcl b/stest/common.tcl index 12203aa..9a7e38f 100644 --- 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,22 +25,27 @@ set extra(inside) { } set extra(outside) {} -proc mkconf {which} { +set privkey(inside) test-example/inside.key +set privkey(outside) test-example/outside.key + +proc mkconf {location site} { global tmp global builddir global netlink global ports global extra global netlinkfh - set pipefp $tmp/$which.netlink + upvar #0 privkey($site) privkey + 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 @@ -51,18 +58,19 @@ exec cat " close $fakeuh set cfg " + hash sha1; 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; @@ -73,15 +81,31 @@ exec cat set delim , } append cfg "; - local-name \"test-example/$which/$which\"; - local-key rsa-private(\"$builddir/test-example/$which.key\"); + local-name \"test-example/$location/$site\"; " - append cfg $extra($which) - append cfg { + switch -glob $privkey { + */ { + append cfg " + key-cache priv-cache({ + privkeys \"$builddir/${privkey}priv.\"; + }); +" + } + * { + append cfg " + local-key rsa-private(\"$builddir/$privkey\"); +" + } + } + + append cfg $extra($site) + append cfg " log logfile { - filename "/dev/tty"; - class "info","notice","warning","error","security","fatal"; + prefix \"$site\"; + class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\"; }; + " + append cfg { system { }; resolver adns { @@ -91,42 +115,108 @@ exec cat transform eax-serpent { }, serpent256-cbc { }; } + set pubkeys $tmp/$site.pubkeys + file delete -force $pubkeys + exec cp -rl $builddir/test-example/pubkeys $pubkeys + set f [open $builddir/test-example/sites.conf r] + while {[gets $f l] >= 0} { + regsub {\"[^\"]*test-example/pubkeys/} $l "\"$pubkeys/" l + append cfg $l "\n" + } 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} { +proc spawn-secnet {location site} { global tmp global builddir global netlinkfh - upvar #0 pids($which) pid - set cf $tmp/$which.conf + 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 $which] + 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)] + } + } } - puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0] + 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] } -proc netlink-readable {which} { +proc netlink-readable {location site} { global ok - upvar #0 netlinkfh($which.r) fh - read $fh; # empty the buffer - switch -exact $which { + upvar #0 readbuf($site) buf + upvar #0 netlinkfh($site.r) fh + 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!" @@ -146,7 +236,7 @@ $message ---------------------------------------- " } - exit 1 + finish 1 } proc sendpkt {} { @@ -163,34 +253,40 @@ 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 -} -if {![catch { - set builddir $env(STEST_BUILDDIR) -}]} {} else { - set builddir . -} - 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} { - 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 $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 @@ -225,8 +321,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