#! /usr/bin/tclsh package require Tclx load chiark_tcl_hbytes-1.so set netlink(inside) { local-address "172.18.232.9"; secnet-address "172.18.232.10"; remote-networks "172.18.232.0/28"; } set netlink(outside) { local-address "172.18.232.1"; secnet-address "172.18.232.2"; remote-networks "172.18.232.0/28"; } set ports(inside) {16913 16910} set ports(outside) 16900 set extra(inside) { local-mobile True; mtu-target 1260; } set extra(outside) {} proc mkconf {which} { global tmp global netlink global ports global extra global netlinkfh set pipefp $tmp/$which.netlink foreach tr {t r} { file delete $pipefp.$tr exec mkfifo -m600 $pipefp.$tr set netlinkfh($which.$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 set fakeuh [open $fakeuf w 0755] puts $fakeuh "#!/bin/sh set -e exec 3<&0 cat <&3 3<&- >$pipefp.r & exec 3<>$pipefp.t exec <$pipefp.t exec 3<&- exec cat " close $fakeuh set cfg " netlink userv-ipif { name \"netlink\"; userv-path \"$fakeuf\"; $netlink($which) mtu 1400; buffer sysbuffer(2048); interface \"secnet-test-[string range $which 0 0]\"; }; comm " set delim {} foreach port $ports($which) { append cfg "$delim udp { port $port; buffer sysbuffer(4096); } " set delim , } append cfg "; local-name \"test-example/$which/$which\"; local-key rsa-private(\"test-example/$which.key\"); " append cfg $extra($which) append cfg { log logfile { filename "/dev/tty"; class "info","notice","warning","error","security","fatal"; }; system { }; resolver adns { }; log-events "all"; random randomfile("/dev/urandom",no); transform eax-serpent { }, serpent256-cbc { }; include test-example/sites.conf sites map(site,vpn/test-example/all-sites); } return $cfg } proc spawn-secnet {which} { global netlinkfh global tmp upvar #0 pids($which) pid set cf $tmp/$which.conf set ch [open $cf w] puts $ch [mkconf $which] close $ch set argl [list strace -o$tmp/$which.strace ./secnet -dvnc $cf] set pid [fork] if {!$pid} { execl [lindex $argl 0] [lrange $argl 1 end] } puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0] } proc netlink-readable {which} { global ok upvar #0 netlinkfh($which.r) fh read $fh; # empty the buffer switch -exact $which { inside { puts OK set ok 1; # what a bodge return } outside { error "inside rx'd!" } } } proc bgerror {message} { global errorInfo errorCode catch { puts stderr " ---------------------------------------- $errorInfo $errorCode $message ---------------------------------------- " } exit 1 } proc sendpkt {} { global netlinkfh set p { 4500 0054 ed9d 4000 4001 24da ac12 e809 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d 0000 0000 507f 0b00 0000 0000 1011 1213 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233 3435 3637 } puts -nonewline $netlinkfh(inside.t) \ [hbytes h2raw c0[join $p ""]c0] } file mkdir test/tmp set tmp test/tmp spawn-secnet inside spawn-secnet outside after 500 sendpkt after 1000 sendpkt after 5000 timed-out vwait ok