5 load chiark_tcl_hbytes-1.so
6 load chiark_tcl_dgram-1.so
9 local-address "172.18.232.9";
10 secnet-address "172.18.232.10";
11 remote-networks "172.18.232.0/28";
13 set netlink(outside) {
14 local-address "172.18.232.1";
15 secnet-address "172.18.232.2";
16 remote-networks "172.18.232.0/28";
19 set ports(inside) {16913 16910}
20 set ports(outside) 16900
28 set privkey(inside) test-example/inside.privkeys/
29 set privkey(outside) test-example/outside.privkeys/
33 proc sitesconf_hook {l} { return $l }
35 proc oldsecnet {site} {
36 upvar #0 oldsecnet($site) oldsecnet
37 expr {[info exists oldsecnet] && [set oldsecnet]}
40 proc mkconf {location site} {
47 upvar #0 privkey($site) privkey
48 set pipefp $tmp/$site.netlink
50 file delete $pipefp.$tr
51 exec mkfifo -m600 $pipefp.$tr
52 set netlinkfh($site.$tr) [set fh [open $pipefp.$tr r+]]
53 fconfigure $fh -blocking 0 -buffering none -translation binary
55 fileevent $netlinkfh($site.r) readable \
56 [list netlink-readable $location $site]
57 set fakeuf $tmp/$site.fake-userv
58 set fakeuh [open $fakeuf w 0755]
59 puts $fakeuh "#!/bin/sh
62 cat <&3 3<&- >$pipefp.r &
73 userv-path \"$fakeuf\";
76 buffer sysbuffer(2048);
77 interface \"secnet-test-[string range $site 0 0]\";
82 foreach port $ports($site) {
86 address \"::1\", \"127.0.0.1\";
87 buffer sysbuffer(4096);
93 local-name \"test-example/$location/$site\";
95 switch -glob $privkey {
97 set sitesconf sites.conf
99 key-cache priv-cache({
100 privkeys \"$builddir/${privkey}priv.\";
105 set sitesconf sites-nonego.conf
107 local-key load-private(\"[lindex $privkey 1]\",\"$builddir/[lindex $privkey 2]\");
111 set sitesconf sites-nonego.conf
113 local-key rsa-private(\"$builddir/$privkey\");
117 set sitesconf $builddir/test-example/$sitesconf
119 append cfg $extra($site)
123 class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\";
125 if {[oldsecnet $site]} { append cfg "
126 filename \"/dev/stderr\";
137 random randomfile("/dev/urandom",no);
138 transform eax-serpent { }, serpent256-cbc { };
141 set pubkeys $tmp/$site.pubkeys
142 file delete -force $pubkeys
143 exec cp -rl $builddir/test-example/pubkeys $pubkeys
145 set f [open $sitesconf r]
146 while {[gets $f l] >= 0} {
147 regsub {\"[^\"]*test-example/pubkeys/} $l "\"$pubkeys/" l
148 set l [sitesconf_hook $l]
155 sites map(site,all-sites);
161 proc spawn-secnet {location site} {
168 upvar #0 pids($site) pid
169 set readbuf($site) {}
170 set cf $tmp/$site.conf
172 puts $ch [mkconf $location $site]
174 set secnet $builddir/secnet
175 if {[oldsecnet $site]} {
176 set secnet $env(OLD_SECNET_DIR)/secnet
178 set argl [list $secnet -dvnc $cf]
179 set divertk SECNET_STEST_DIVERT_$site
180 puts -nonewline "spawn"
181 foreach k [array names env] {
183 SECNET_STEST_DIVERT_* -
184 SECNET_TEST_BUILDDIR - OLD_SECNET_DIR { }
186 *PRELOAD* { puts -nonewline " $k=$env($k)" }
189 if {[info exists env($divertk)]} {
190 switch -glob $env($divertk) {
192 regsub {^i} $env($divertk) {} divert_prefix
193 puts "$divert_prefix $argl"
194 puts -nonewline "run ^ command, hit return "
204 set argl [split $env($divertk)]
208 error "$divertk not understood"
212 if {[llength $argl]} {
214 set pidmap($pid) "secnet $location/$site"
216 execl [lindex $argl 0] [lrange $argl 1 end]
219 puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
222 proc netlink-readable {location site} {
224 upvar #0 readbuf($site) buf
225 upvar #0 netlinkfh($site.r) fh
228 set h [hbytes raw2h $x]
229 if {![hbytes length $h]} return
231 #puts "READABLE $site buf=$buf"
232 while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
233 #puts "READABLE $site now=$now (buf=$buf)"
234 regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
235 regsub -all {^((?:..)*?)dbdd} $now {\1db} now
236 puts "netlink-got-packet $location $site $now"
237 netlink-got-packet $location $site $now
242 proc netlink-got-packet {location site data} {
244 if {![hbytes length $data]} return
245 switch -exact $site!$initiator {
246 inside!inside - outside!outside {
248 45000054ed9d4000fe0166d9ac12e802ac12e80900* {
253 error "unexpected $site $data"
258 error "$site rx'd! (initiator $initiator)"
263 proc bgerror {message} {
264 global errorInfo errorCode
267 ----------------------------------------
272 ----------------------------------------
282 4500 0054 ed9d 4000 4001 24da ac12 e809
283 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
284 0000 0000 507f 0b00 0000 0000 1011 1213
285 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
286 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
289 puts -nonewline $netlinkfh($initiator.t) \
290 [hbytes h2raw c0[join $p ""]c0]
294 exec mkdir -p -m700 $socktmp
295 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
297 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
299 set env(UDP_PRELOAD_DIR) $socktmp
300 prefix_preload $builddir/stest/udp-preload.so
302 proc finish {estatus} {
303 puts stderr "FINISHING $estatus"
304 signal default SIGCHLD
306 foreach pid [array names pidmap] {
315 foreach pid [array names pidmap] {
316 set got [wait -nohang $pid]
317 if {![llength $got]} continue
318 set info $pidmap($pid)
320 puts stderr "reaped $info: $got"
325 signal -restart trap SIGCHLD { after idle reap }
328 global socktmp udpsock
331 regsub {^(?!/)} $u {./} u
332 set udpsock [dgram-socket create $u]
333 dgram-socket on-receive $udpsock udp-relay
336 proc udp-relay {data src sock args} {
337 global udpsock socktmp
338 set headerlen [expr {52+1}]
341 set dst [hbytes range $data 0 $headerlen]
342 regsub {(?:00)*$} $dst {} dst
343 set dst [hbytes h2raw $dst]
345 hbytes overwrite data 0 [hbytes zeroes $headerlen]
346 regsub {.*/} $src {} src
347 set srch [hbytes raw2h $src]
348 hbytes append srch 00
350 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
351 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
352 hbytes overwrite data 0 $srch
353 dgram-socket transmit $udpsock $data $socktmp/$dst
355 puts stderr "$orgsrc -> $dst: $emsg"
359 proc adj-after {timeout args} {
360 upvar #0 env(SECNET_STEST_TIMEOUT_MUL) mul
361 if {[info exists mul]} { set timeout [expr {$timeout * $mul}] }
362 eval after $timeout $args
367 spawn-secnet in inside
368 spawn-secnet out outside
370 adj-after 500 sendpkt
371 adj-after 1000 sendpkt
372 adj-after 5000 timed-out