Makefiles: Break some settings out into common.make

[secnet.git] / test / invoke

diff --git a/test/invoke b/test/invoke
index 479507519ded68b6505c2770ef069798526fca74..22554cfbe72b3a4dce97f84d62af20f2a01724d3 100755 (executable)
--- a/test/invoke
+++ b/test/invoke
@@ -2,14 +2,204 @@
 
 package require Tclx
 
+load chiark_tcl_hbytes-1.so
+load chiark_tcl_dgram-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;
+                address \"::1\", \"127.0.0.1\";
+               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 argl [list ./secnet -dvnc test-example/$which.conf]
+    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 really $argl
+       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
+set socktmp $tmp
+regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
+
+proc udp-proxy {} {
+    global socktmp udpsock
+    set u $socktmp/udp
+    file delete $u
+    regsub {^(?!/)} $u {./} u
+    set udpsock [dgram-socket create $u]
+    dgram-socket on-receive $udpsock udp-relay
+}
+
+proc udp-relay {data src sock args} {
+    global udpsock socktmp
+    set headerlen [expr {52+1}]
+    set orgsrc $src
+
+    set dst [hbytes range $data 0 $headerlen]
+    regsub {(?:00)*$} $dst {} dst
+    set dst [hbytes h2raw $dst]
+
+    hbytes overwrite data 0 [hbytes zeroes $headerlen]
+    regsub {.*/} $src {} src
+    set srch [hbytes raw2h $src]
+    hbytes append srch 00
+    if {[catch {
+       if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
+       if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
+       hbytes overwrite data 0 $srch
+       dgram-socket transmit $udpsock $data $socktmp/$dst
+    } emsg]} {
+       puts stderr "$orgsrc -> $dst: $emsg"
     }
 }
 
+udp-proxy
 spawn-secnet inside
 spawn-secnet outside
+
+after 500 sendpkt
+after 1000 sendpkt
+after 5000 timed-out
+
+vwait ok