test/invoke

   1 #! /usr/bin/tclsh
   2
   3 package require Tclx
   4
   5 load chiark_tcl_hbytes-1.so
   6
   7 set netlink(inside) {
   8     local-address "172.18.232.9";
   9     secnet-address "172.18.232.10";
  10     remote-networks "172.18.232.0/28";
  11 }
  12 set netlink(outside) {
  13     local-address "172.18.232.1";
  14     secnet-address "172.18.232.2";
  15     remote-networks "172.18.232.0/28";
  16 }
  17
  18 set ports(inside) {16913 16910}
  19 set ports(outside) 16900
  20
  21 set extra(inside) {
  22     local-mobile True;
  23     mtu-target 1260;
  24 }
  25 set extra(outside) {}
  26
  27 proc mkconf {which} {
  28     global netlink
  29     global ports
  30     global extra
  31     global netlinkfh
  32     set pipefp test/$which.netlink
  33     foreach tr {t r} {
  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
  38     }
  39     fileevent $netlinkfh($which.r) readable [list netlink-readable $which]
  40     set fakeuf test/$which.fake-userv
  41     set fakeuh [open $fakeuf w 0755]
  42     puts $fakeuh "#!/bin/sh
  43 set -e
  44 exec 3<&0
  45 cat <&3 3<&- >$pipefp.r &
  46 exec 3<>$pipefp.t
  47 exec <$pipefp.t
  48 exec 3<&-
  49 exec cat
  50 "
  51     close $fakeuh
  52     set cfg "
  53         netlink userv-ipif {
  54             name \"netlink\";
  55             userv-path \"$fakeuf\";
  56         $netlink($which)
  57             mtu 1400;
  58             buffer sysbuffer(2048);
  59             interface \"secnet-test-[string range $which 0 0]\";
  60         };
  61         comm
  62 "
  63     set delim {}
  64     foreach port $ports($which) {
  65         append cfg "$delim
  66             udp {
  67                 port $port;
  68                 buffer sysbuffer(4096);
  69             }
  70         "
  71         set delim ,
  72     }
  73     append cfg ";
  74         local-name \"test-example/$which/$which\";
  75         local-key rsa-private(\"test-example/$which.key\");
  76 "
  77     append cfg $extra($which)
  78     append cfg {
  79         log logfile {
  80             filename "/dev/tty";
  81             class "info","notice","warning","error","security","fatal";
  82         };
  83         system {
  84         };
  85         resolver adns {
  86         };
  87         log-events "all";
  88         random randomfile("/dev/urandom",no);
  89         transform eax-serpent { }, serpent256-cbc { };
  90         include test-example/sites.conf
  91         sites map(site,vpn/test-example/all-sites);
  92     }
  93     return $cfg
  94 }
  95
  96 proc spawn-secnet {which} {
  97     global netlinkfh
  98     upvar #0 pids($which) pid
  99     set cf test/$which.conf
 100     set ch [open $cf w]
 101     puts $ch [mkconf $which]
 102     close $ch
 103     set argl [list -dvnc $cf]
 104     set pid [fork]
 105     if {!$pid} {
 106         execl ./secnet $argl
 107     }
 108     puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0]
 109 }
 110
 111 proc netlink-readable {which} {
 112     global ok
 113     upvar #0 netlinkfh($which.r) fh
 114     read $fh; # empty the buffer
 115     switch -exact $which {
 116         outside {
 117             puts OK
 118             set ok 1; # what a bodge
 119             return
 120         }
 121         inside {
 122             error "inside rx'd!"
 123         }
 124     }
 125 }
 126
 127 proc bgerror {message} {
 128     global errorInfo errorCode
 129     catch {
 130         puts stderr "
 131 ----------------------------------------
 132 $errorInfo
 133
 134 $errorCode
 135 $message
 136 ----------------------------------------
 137     "
 138     }
 139     exit 1
 140 }
 141
 142 proc sendpkt {} {
 143     global netlinkfh
 144     set p {
 145         4500 0054 ed9d 4000 4001 24da ac12 e809
 146         ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
 147         0000 0000 507f 0b00 0000 0000 1011 1213
 148         1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
 149         2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
 150         3435 3637
 151     }
 152     puts -nonewline $netlinkfh(inside.t) \
 153         [hbytes h2raw c0[join $p ""]c0]
 154 }
 155
 156 spawn-secnet inside
 157 spawn-secnet outside
 158
 159 after 500 sendpkt
 160 after 1000 sendpkt
 161
 162 vwait ok