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
32 set pipefp $tmp/$which.netlink
34 file delete $pipefp.$tr
35 exec mkfifo -m600 $pipefp.$tr
36 set netlinkfh($which.$tr) [set fh [open $pipefp.$tr r+]]
37 fconfigure $fh -blocking 0 -buffering none -translation binary
39 fileevent $netlinkfh($which.r) readable [list netlink-readable $which]
40 set fakeuf $tmp/$which.fake-userv
41 set fakeuh [open $fakeuf w 0755]
42 puts $fakeuh "#!/bin/sh
45 cat <&3 3<&- >$pipefp.r &
55 userv-path \"$fakeuf\";
58 buffer sysbuffer(2048);
59 interface \"secnet-test-[string range $which 0 0]\";
64 foreach port $ports($which) {
68 address \"::1\", \"127.0.0.1\";
69 buffer sysbuffer(4096);
75 local-name \"test-example/$which/$which\";
76 local-key rsa-private(\"test-example/$which.key\");
78 append cfg $extra($which)
82 class "info","notice","warning","error","security","fatal";
89 random randomfile("/dev/urandom",no);
90 transform eax-serpent { }, serpent256-cbc { };
93 set f [open test-example/sites.conf r]
98 sites map(site,vpn/test-example/all-sites);
103 proc spawn-secnet {which} {
106 upvar #0 pids($which) pid
107 set cf $tmp/$which.conf
109 puts $ch [mkconf $which]
111 set argl [list strace -o$tmp/$which.strace ./secnet -dvnc $cf]
114 execl [lindex $argl 0] [lrange $argl 1 end]
116 puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0]
119 proc netlink-readable {which} {
121 upvar #0 netlinkfh($which.r) fh
122 read $fh; # empty the buffer
123 switch -exact $which {
126 set ok 1; # what a bodge
135 proc bgerror {message} {
136 global errorInfo errorCode
139 ----------------------------------------
144 ----------------------------------------
153 4500 0054 ed9d 4000 4001 24da ac12 e809
154 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
155 0000 0000 507f 0b00 0000 0000 1011 1213
156 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
157 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
160 puts -nonewline $netlinkfh(inside.t) \
161 [hbytes h2raw c0[join $p ""]c0]
165 set tmp $env(AUTOPKGTEST_ARTIACTS)
166 }]} {} elseif {![catch {
167 set tmp $env(AUTOPKGTEST_TMP)
168 }]} {} elseif {[regsub {^test/t-} $argv0 {test/d-} tmp]} {
173 exec mkdir -p -m700 $socktmp
174 regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
176 proc prefix_preload {lib} {
179 catch { set l [split $env(PRELOAD) :] }
180 set l [concat [list $lib] $l]
181 set env(LD_PRELOAD) [join $l :]
184 set env(UDP_PRELOAD_DIR) $socktmp
185 prefix_preload test/udp-preload.so
188 global socktmp udpsock
191 regsub {^(?!/)} $u {./} u
192 set udpsock [dgram-socket create $u]
193 dgram-socket on-receive $udpsock udp-relay
196 proc udp-relay {data src sock args} {
197 global udpsock socktmp
198 set headerlen [expr {52+1}]
201 set dst [hbytes range $data 0 $headerlen]
202 regsub {(?:00)*$} $dst {} dst
203 set dst [hbytes h2raw $dst]
205 hbytes overwrite data 0 [hbytes zeroes $headerlen]
206 regsub {.*/} $src {} src
207 set srch [hbytes raw2h $src]
208 hbytes append srch 00
210 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
211 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
212 hbytes overwrite data 0 $srch
213 dgram-socket transmit $udpsock $data $socktmp/$dst
215 puts stderr "$orgsrc -> $dst: $emsg"