3 load chiark_tcl_hbytes-1.so
4 load chiark_tcl_dgram-1.so
7 local-address "172.18.232.9";
8 secnet-address "172.18.232.10";
9 remote-networks "172.18.232.0/28";
11 set netlink(outside) {
12 local-address "172.18.232.1";
13 secnet-address "172.18.232.2";
14 remote-networks "172.18.232.0/28";
17 set ports(inside) {16913 16910}
18 set ports(outside) 16900
33 set pipefp $tmp/$which.netlink
35 file delete $pipefp.$tr
36 exec mkfifo -m600 $pipefp.$tr
37 set netlinkfh($which.$tr) [set fh [open $pipefp.$tr r+]]
38 fconfigure $fh -blocking 0 -buffering none -translation binary
40 fileevent $netlinkfh($which.r) readable [list netlink-readable $which]
41 set fakeuf $tmp/$which.fake-userv
42 set fakeuh [open $fakeuf w 0755]
43 puts $fakeuh "#!/bin/sh
46 cat <&3 3<&- >$pipefp.r &
56 userv-path \"$fakeuf\";
59 buffer sysbuffer(2048);
60 interface \"secnet-test-[string range $which 0 0]\";
65 foreach port $ports($which) {
69 address \"::1\", \"127.0.0.1\";
70 buffer sysbuffer(4096);
76 local-name \"test-example/$which/$which\";
77 local-key rsa-private(\"$builddir/test-example/$which.key\");
79 append cfg $extra($which)
83 class "info","notice","warning","error","security","fatal";
90 random randomfile("/dev/urandom",no);
91 transform eax-serpent { }, serpent256-cbc { };
94 set f [open $builddir/test-example/sites.conf r]
99 sites map(site,vpn/test-example/all-sites);
104 proc spawn-secnet {which} {
108 upvar #0 pids($which) pid
109 set cf $tmp/$which.conf
111 puts $ch [mkconf $which]
113 set argl [list $builddir/secnet -dvnc $cf]
116 execl [lindex $argl 0] [lrange $argl 1 end]
118 puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0]
121 proc netlink-readable {which} {
123 upvar #0 netlinkfh($which.r) fh
124 read $fh; # empty the buffer
125 switch -exact $which {
128 set ok 1; # what a bodge
137 proc bgerror {message} {
138 global errorInfo errorCode
141 ----------------------------------------
146 ----------------------------------------
155 4500 0054 ed9d 4000 4001 24da ac12 e809
156 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
157 0000 0000 507f 0b00 0000 0000 1011 1213
158 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
159 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
162 puts -nonewline $netlinkfh(inside.t) \
163 [hbytes h2raw c0[join $p ""]c0]
167 set builddir $env(STEST_BUILDDIR)
173 set tmp $env(AUTOPKGTEST_ARTIACTS)
174 }]} {} elseif {![catch {
175 set tmp $env(AUTOPKGTEST_TMP)
176 }]} {} elseif {[regsub {^stest/t-} $argv0 {stest/d-} tmp]} {
177 set tmp $builddir/$tmp
181 exec mkdir -p -m700 $socktmp
182 regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
184 proc prefix_preload {lib} {
187 catch { set l [split $env(PRELOAD) :] }
188 set l [concat [list $lib] $l]
189 set env(LD_PRELOAD) [join $l :]
192 set env(UDP_PRELOAD_DIR) $socktmp
193 prefix_preload $builddir/stest/udp-preload.so
196 global socktmp udpsock
199 regsub {^(?!/)} $u {./} u
200 set udpsock [dgram-socket create $u]
201 dgram-socket on-receive $udpsock udp-relay
204 proc udp-relay {data src sock args} {
205 global udpsock socktmp
206 set headerlen [expr {52+1}]
209 set dst [hbytes range $data 0 $headerlen]
210 regsub {(?:00)*$} $dst {} dst
211 set dst [hbytes h2raw $dst]
213 hbytes overwrite data 0 [hbytes zeroes $headerlen]
214 regsub {.*/} $src {} src
215 set srch [hbytes raw2h $src]
216 hbytes append srch 00
218 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
219 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
220 hbytes overwrite data 0 $srch
221 dgram-socket transmit $udpsock $data $socktmp/$dst
223 puts stderr "$orgsrc -> $dst: $emsg"