test/invoke

   1 #! /usr/bin/tclsh
   2
   3 package require Tclx
   4
   5 set netlink(inside) {
   6     local-address "172.18.232.9";
   7     secnet-address "172.18.232.10";
   8     remote-networks "172.18.232.0/28";
   9 }
  10 set netlink(outside) {
  11     local-address "172.18.232.1";
  12     secnet-address "172.18.232.2";
  13     remote-networks "172.18.232.0/28";
  14 }
  15
  16 set ports(inside) {16913 16910}
  17 set ports(outside) 16900
  18
  19 set extra(inside) {
  20     local-mobile True;
  21     mtu-target 1260;
  22 }
  23 set extra(outside) {}
  24
  25 proc mkconf {which} {
  26     global netlink
  27     global ports
  28     global extra
  29     global netlinkfh
  30     set pipefp test/$which.netlink
  31     foreach tr {t r} {
  32         file delete $pipefp.$tr
  33         exec mkfifo -m600 $pipefp.$tr
  34         set netlinkfh($which.$tr) [set fh [open $pipefp.$tr r+]]
  35         fconfigure $fh -blocking 0 -buffering none -translation binary
  36     }
  37     fileevent $netlinkfh($which.r) readable [list netlink-readable $which]
  38     set fakeuf test/$which.fake-userv
  39     set fakeuh [open $fakeuf w 0755]
  40     puts $fakeuh "#!/bin/sh
  41 set -e
  42 exec 3<&0
  43 cat <&3 3<&- >$pipefp.r &
  44 exec 3<>$pipefp.t
  45 exec <$pipefp.t
  46 exec 3<&-
  47 exec cat
  48 "
  49     close $fakeuh
  50     set cfg "
  51         netlink userv-ipif {
  52             name \"netlink\";
  53             userv-path \"$fakeuf\";
  54         $netlink($which)
  55             mtu 1400;
  56             buffer sysbuffer(2048);
  57             interface \"secnet-test-[string range $which 0 0]\";
  58         };
  59         comm
  60 "
  61     set delim {}
  62     foreach port $ports($which) {
  63         append cfg "$delim
  64             udp {
  65                 port $port;
  66                 buffer sysbuffer(4096);
  67             }
  68         "
  69         set delim ,
  70     }
  71     append cfg ";
  72         local-name \"test-example/$which/$which\";
  73         local-key rsa-private(\"test-example/$which.key\");
  74 "
  75     append cfg $extra($which)
  76     append cfg {
  77         log logfile {
  78             filename "/dev/tty";
  79             class "info","notice","warning","error","security","fatal";
  80         };
  81         system {
  82         };
  83         resolver adns {
  84         };
  85         log-events "all";
  86         random randomfile("/dev/urandom",no);
  87         transform eax-serpent { }, serpent256-cbc { };
  88         include test-example/sites.conf
  89         sites map(site,vpn/test-example/all-sites);
  90     }
  91     return $cfg
  92 }
  93
  94 proc spawn-secnet {which} {
  95     global netlinkfh
  96     upvar #0 pids($which) pid
  97     set cf test/$which.conf
  98     set ch [open $cf w]
  99     puts $ch [mkconf $which]
 100     close $ch
 101     set argl [list -dvnc $cf]
 102     set pid [fork]
 103     if {!$pid} {
 104         execl ./secnet $argl
 105     }
 106     puts -nonewline $netlinkfh($which.t) "\xc0"
 107 }
 108
 109 proc netlink-readable {which} {
 110     global ok
 111     upvar #0 netlinkfh($which.r) fh
 112     read $fh; # empty the buffer
 113     switch -exact $which {
 114         outside {
 115             puts OK
 116             set ok 1; # what a bodge
 117             return
 118         }
 119         inside {
 120             error "inside rx'd!"
 121         }
 122     }
 123 }
 124
 125 proc bgerror {message} {
 126     global errorInfo errorCode
 127     catch {
 128         puts stderr "
 129 ----------------------------------------
 130 $errorInfo
 131
 132 $errorCode
 133 $message
 134 ----------------------------------------
 135     "
 136     }
 137     exit 1
 138 }
 139
 140 spawn-secnet inside
 141 spawn-secnet outside
 142
 143 vwait ok