+++ /dev/null
-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 { };
- }
-
- set f [open test-example/sites.conf r]
- set sites [read $f]
- close $f
- append cfg $sites
- append cfg {
- 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]
-}
-
-if {![catch {
- set tmp $env(AUTOPKGTEST_ARTIACTS)
-}]} {} elseif {![catch {
- set tmp $env(AUTOPKGTEST_TMP)
-}]} {} elseif {[regsub {^test/t-} $argv0 {test/d-} tmp]} {
- file mkdir $tmp
-}
-
-set socktmp $tmp/s
-exec mkdir -p -m700 $socktmp
-regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
-
-proc prefix_preload {lib} {
- global env
- set l {}
- catch { set l [split $env(PRELOAD) :] }
- set l [concat [list $lib] $l]
- set env(LD_PRELOAD) [join $l :]
-}
-
-set env(UDP_PRELOAD_DIR) $socktmp
-prefix_preload test/udp-preload.so
-
-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"
- }
-}
-
-proc test-kex {} {
- udp-proxy
- spawn-secnet inside
- spawn-secnet outside
-
- after 500 sendpkt
- after 1000 sendpkt
- after 5000 timed-out
-
- vwait ok
-}
~ian / secnet.git / blobdiff