1 # This file is part of secnet.
2 # See LICENCE and this file CREDITS for full list of copyright holders.
3 # SPDX-License-Identifier: GPL-3.0-or-later
4 # There is NO WARRANTY.
10 load chiark_tcl_hbytes-1.so
11 load chiark_tcl_dgram-1.so
14 local-address "172.18.232.9";
15 secnet-address "172.18.232.10";
16 remote-networks "172.18.232.0/28";
18 set netlink(outside) {
19 local-address "172.18.232.1";
20 secnet-address "172.18.232.2";
21 remote-networks "172.18.232.0/28";
24 set ports(inside) {16913 16910}
25 set ports(outside) 16900
27 set defnet_v4 198.51.100
28 set defnet_v6 2001:db8:ff00
29 set defaddr_v4 ${defnet_v4}.1
30 set defaddr_v6 ${defnet_v6}::1
38 set privkey(inside) test-example/inside.privkeys/
39 set privkey(outside) test-example/outside.privkeys/
43 proc sitesconf_hook {l} { return $l }
45 proc oldsecnet {site} {
46 upvar #0 oldsecnet($site) oldsecnet
47 expr {[info exists oldsecnet] && [set oldsecnet]}
50 proc mkconf {location site} {
57 global defaddr_v4 defaddr_v6
58 upvar #0 privkey($site) privkey
59 set pipefp $tmp/$site.netlink
61 file delete $pipefp.$tr
62 exec mkfifo -m600 $pipefp.$tr
63 set netlinkfh($site.$tr) [set fh [open $pipefp.$tr r+]]
64 fconfigure $fh -blocking 0 -buffering none -translation binary
66 fileevent $netlinkfh($site.r) readable \
67 [list netlink-readable $location $site]
68 set fakeuf $tmp/$site.fake-userv
69 set fakeuh [open $fakeuf w 0755]
70 puts $fakeuh "#!/bin/sh
73 cat <&3 3<&- >$pipefp.r &
84 userv-path \"$fakeuf\";
87 buffer sysbuffer(2048);
88 interface \"secnet-test-[string range $site 0 0]\";
93 foreach port $ports($site) {
97 address \"$defaddr_v6\", \"$defaddr_v4\";
98 buffer sysbuffer(4096);
104 local-name \"test-example/$location/$site\";
106 switch -glob $privkey {
108 set sitesconf sites.conf
110 key-cache priv-cache({
111 privkeys \"$builddir/${privkey}priv.\";
116 set sitesconf sites-nonego.conf
118 local-key load-private(\"[lindex $privkey 1]\",\"$builddir/[lindex $privkey 2]\");
122 set sitesconf sites-nonego.conf
124 local-key rsa-private(\"$builddir/$privkey\");
128 set sitesconf $builddir/test-example/$sitesconf
130 append cfg $extra($site)
134 class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\";
136 if {[oldsecnet $site]} { append cfg "
137 filename \"/dev/stderr\";
148 random randomfile("/dev/urandom",no);
149 transform eax-serpent { }, serpent256-cbc { };
152 set pubkeys $tmp/$site.pubkeys
153 file delete -force $pubkeys
154 exec cp -rl $builddir/test-example/pubkeys $pubkeys
156 set f [open $sitesconf r]
157 while {[gets $f l] >= 0} {
158 regsub {\"[^\"]*test-example/pubkeys/} $l "\"$pubkeys/" l
159 regsub -all {\"\[127\.0\.0\.1\]\"} $l "\"\[$defaddr_v4\]\"" l
160 regsub -all {\"\[::1]\"} $l "\"\[$defaddr_v6\]\"" l
161 set l [sitesconf_hook $l]
168 sites map(site,all-sites);
174 proc spawn-secnet {location site} {
181 upvar #0 pids($site) pid
182 set readbuf($site) {}
183 set cf $tmp/$site.conf
185 puts $ch [mkconf $location $site]
187 set secnet $builddir/secnet
188 if {[oldsecnet $site]} {
189 set secnet $env(OLD_SECNET_DIR)/secnet
191 set argl [list $secnet -dvnc $cf]
192 set divertk SECNET_STEST_DIVERT_$site
194 foreach k [array names env] {
196 SECNET_STEST_DIVERT_* -
197 SECNET_TEST_BUILDDIR - OLD_SECNET_DIR { }
199 *PRELOAD* { puts -nonewline " $k=$env($k)" }
202 if {[info exists env($divertk)]} {
203 switch -glob $env($divertk) {
205 regsub {^i} $env($divertk) {} divert_prefix
206 puts "$divert_prefix $argl"
207 puts -nonewline "run ^ command, hit return "
217 set argl [split $env($divertk)]
221 error "$divertk not understood"
225 if {[llength $argl]} {
227 set pidmap($pid) "secnet $location/$site"
229 execl [lindex $argl 0] [lrange $argl 1 end]
232 puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
235 proc netlink-readable {location site} {
237 upvar #0 readbuf($site) buf
238 upvar #0 netlinkfh($site.r) fh
241 set h [hbytes raw2h $x]
242 if {![hbytes length $h]} return
244 #puts "READABLE $site buf=$buf"
245 while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
246 #puts "READABLE $site now=$now (buf=$buf)"
247 regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
248 regsub -all {^((?:..)*?)dbdd} $now {\1db} now
249 puts "netlink-got-packet $location $site $now"
250 netlink-got-packet $location $site $now
255 proc netlink-got-packet {location site data} {
257 if {![hbytes length $data]} return
258 switch -exact $site!$initiator {
259 inside!inside - outside!outside {
261 45000054ed9d4000fe0166d9ac12e802ac12e80900* {
266 error "unexpected $site $data"
271 error "$site rx'd! (initiator $initiator)"
276 proc bgerror {message} {
277 global errorInfo errorCode
280 ----------------------------------------
285 ----------------------------------------
295 4500 0054 ed9d 4000 4001 24da ac12 e809
296 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
297 0000 0000 507f 0b00 0000 0000 1011 1213
298 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
299 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
302 puts -nonewline $netlinkfh($initiator.t) \
303 [hbytes h2raw c0[join $p ""]c0]
307 exec mkdir -p -m700 $socktmp
308 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
310 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
312 set env(UDP_PRELOAD_DIR) $socktmp
313 prefix_preload $builddir/stest/udp-preload.so
315 proc finish {estatus} {
316 puts stderr "FINISHING $estatus"
317 signal default SIGCHLD
319 foreach pid [array names pidmap] {
328 foreach pid [array names pidmap] {
329 set got [wait -nohang $pid]
330 if {![llength $got]} continue
331 set info $pidmap($pid)
333 puts stderr "reaped $info: $got"
338 signal -restart trap SIGCHLD { after idle reap }
341 global socktmp udpsock
344 regsub {^(?!/)} $u {./} u
345 set udpsock [dgram-socket create $u]
346 dgram-socket on-receive $udpsock udp-relay
349 proc udp-relay {data src sock args} {
350 global udpsock socktmp
351 set headerlen [expr {52+1}]
354 set dst [hbytes range $data 0 $headerlen]
355 regsub {(?:00)*$} $dst {} dst
356 set dst [hbytes h2raw $dst]
358 hbytes overwrite data 0 [hbytes zeroes $headerlen]
359 regsub {.*/} $src {} src
360 set srch [hbytes raw2h $src]
361 hbytes append srch 00
363 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
364 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
365 hbytes overwrite data 0 $srch
366 dgram-socket transmit $udpsock $data $socktmp/$dst
368 puts stderr "$orgsrc -> $dst: $emsg"
372 proc adj-after {timeout args} {
373 upvar #0 env(SECNET_STEST_TIMEOUT_MUL) mul
374 if {[info exists mul]} { set timeout [expr {$timeout * $mul}] }
375 eval after $timeout $args
380 spawn-secnet in inside
381 spawn-secnet out outside
383 adj-after 500 sendpkt
384 adj-after 1000 sendpkt
385 adj-after 5000 timed-out