stest/common.tcl

   1 source test-common.tcl
   2
   3 package require Tclx
   4
   5 load chiark_tcl_hbytes-1.so
   6 load chiark_tcl_dgram-1.so
   7
   8 set netlink(inside) {
   9     local-address "172.18.232.9";
  10     secnet-address "172.18.232.10";
  11     remote-networks "172.18.232.0/28";
  12 }
  13 set netlink(outside) {
  14     local-address "172.18.232.1";
  15     secnet-address "172.18.232.2";
  16     remote-networks "172.18.232.0/28";
  17 }
  18
  19 set ports(inside) {16913 16910}
  20 set ports(outside) 16900
  21
  22 set extra(inside) {
  23     local-mobile True;
  24     mtu-target 1260;
  25 }
  26 set extra(outside) {}
  27
  28 proc mkconf {location site} {
  29     global tmp
  30     global builddir
  31     global netlink
  32     global ports
  33     global extra
  34     global netlinkfh
  35     set pipefp $tmp/$site.netlink
  36     foreach tr {t r} {
  37         file delete $pipefp.$tr
  38         exec mkfifo -m600 $pipefp.$tr
  39         set netlinkfh($site.$tr) [set fh [open $pipefp.$tr r+]]
  40         fconfigure $fh -blocking 0 -buffering none -translation binary
  41     }
  42     fileevent $netlinkfh($site.r) readable \
  43         [list netlink-readable $location $site]
  44     set fakeuf $tmp/$site.fake-userv
  45     set fakeuh [open $fakeuf w 0755]
  46     puts $fakeuh "#!/bin/sh
  47 set -e
  48 exec 3<&0
  49 cat <&3 3<&- >$pipefp.r &
  50 exec 3<>$pipefp.t
  51 exec <$pipefp.t
  52 exec 3<&-
  53 exec cat
  54 "
  55     close $fakeuh
  56     set cfg "
  57         netlink userv-ipif {
  58             name \"netlink\";
  59             userv-path \"$fakeuf\";
  60         $netlink($site)
  61             mtu 1400;
  62             buffer sysbuffer(2048);
  63             interface \"secnet-test-[string range $site 0 0]\";
  64         };
  65         comm
  66 "
  67     set delim {}
  68     foreach port $ports($site) {
  69         append cfg "$delim
  70             udp {
  71                 port $port;
  72                 address \"::1\", \"127.0.0.1\";
  73                 buffer sysbuffer(4096);
  74             }
  75         "
  76         set delim ,
  77     }
  78     append cfg ";
  79         local-name \"test-example/$location/$site\";
  80         local-key rsa-private(\"$builddir/test-example/$site.key\");
  81 "
  82     append cfg $extra($site)
  83     append cfg "
  84         log logfile {
  85             prefix \"$site\";
  86             class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\";
  87         };
  88     "
  89     append cfg {
  90         system {
  91         };
  92         resolver adns {
  93         };
  94         log-events "all";
  95         random randomfile("/dev/urandom",no);
  96         transform eax-serpent { }, serpent256-cbc { };
  97     }
  98
  99     set f [open $builddir/test-example/sites.conf r]
 100     set sites [read $f]
 101     close $f
 102     append cfg $sites
 103     append cfg {
 104         sites map(site,all-sites);
 105     }
 106     return $cfg
 107 }
 108
 109 proc spawn-secnet {location site} {
 110     global tmp
 111     global builddir
 112     global netlinkfh
 113     global env
 114     global pidmap
 115     global readbuf
 116     upvar #0 pids($site) pid
 117     set readbuf($site) {}
 118     set cf $tmp/$site.conf
 119     set ch [open $cf w]
 120     puts $ch [mkconf $location $site]
 121     close $ch
 122     set argl [list $builddir/secnet -dvnc $cf]
 123     set divertk SECNET_STEST_DIVERT_$site
 124     puts -nonewline "spawn"
 125     foreach k [array names env] {
 126         switch -glob $k {
 127             SECNET_STEST_DIVERT_* -
 128             SECNET_TEST_BUILDDIR { }
 129             *SECNET* -
 130             *PRELOAD* { puts -nonewline " $k=$env($k)" }
 131         }
 132     }
 133     puts " $argl"
 134     if {[info exists env($divertk)]} {
 135         switch -glob $env($divertk) {
 136             i {
 137                 puts -nonewline "run ^ command, hit return "
 138                 flush stdout
 139                 gets stdin
 140                 set argl {}
 141             }
 142             0 - "" {
 143             }
 144             * {
 145                 set argl [split $env($divertk)]
 146             }
 147         }
 148     }
 149     if {[llength $argl]} {
 150         set pid [fork]
 151         set pidmap($pid) "secnet $location/$site"
 152         if {!$pid} {
 153             execl [lindex $argl 0] [lrange $argl 1 end]
 154         }
 155     }
 156     puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
 157 }
 158
 159 proc netlink-readable {location site} {
 160     global ok
 161     upvar #0 readbuf($site) buf
 162     upvar #0 netlinkfh($site.r) fh
 163     while 1 {
 164         set x [read $fh]
 165         set h [hbytes raw2h $x]
 166         if {![hbytes length $h]} return
 167         append buf $h
 168         #puts "READABLE $site buf=$buf"
 169         while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
 170             #puts "READABLE $site now=$now (buf=$buf)"
 171             regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
 172             regsub -all {^((?:..)*?)dbdd} $now {\1db} now
 173             puts "netlink-got-packet $location $site $now"
 174             netlink-got-packet $location $site $now
 175         }
 176     }
 177 }
 178
 179 proc netlink-got-packet {location site data} {
 180     if {![hbytes length $data]} return
 181     switch -exact $site {
 182         inside {
 183             switch -glob $data {
 184                 45000054ed9d4000fe0166d9ac12e802ac12e80900* {
 185                     puts "OK $data"
 186                     finish 0
 187                 }
 188                 * {
 189                     error "unexpected $site $data"
 190                 }
 191             }
 192         }
 193         outside {
 194             error "inside rx'd!"
 195         }
 196     }
 197 }
 198
 199 proc bgerror {message} {
 200     global errorInfo errorCode
 201     catch {
 202         puts stderr "
 203 ----------------------------------------
 204 $errorInfo
 205
 206 $errorCode
 207 $message
 208 ----------------------------------------
 209     "
 210     }
 211     finish 1
 212 }
 213
 214 proc sendpkt {} {
 215     global netlinkfh
 216     set p {
 217         4500 0054 ed9d 4000 4001 24da ac12 e809
 218         ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
 219         0000 0000 507f 0b00 0000 0000 1011 1213
 220         1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
 221         2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
 222         3435 3637
 223     }
 224     puts -nonewline $netlinkfh(inside.t) \
 225         [hbytes h2raw c0[join $p ""]c0]
 226 }
 227
 228 set socktmp $tmp/s
 229 exec mkdir -p -m700 $socktmp
 230 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
 231
 232 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
 233
 234 set env(UDP_PRELOAD_DIR) $socktmp
 235 prefix_preload $builddir/stest/udp-preload.so
 236
 237 proc finish {estatus} {
 238     puts stderr "FINISHING $estatus"
 239     signal default SIGCHLD
 240     global pidmap
 241     foreach pid [array names pidmap] {
 242         kill KILL $pid
 243     }
 244     exit $estatus
 245 }
 246
 247 proc reap {} {
 248     global pidmap
 249     #puts stderr REAPING
 250     foreach pid [array names pidmap] {
 251         set got [wait -nohang $pid]
 252         if {![llength $got]} continue
 253         set info $pidmap($pid)
 254         unset pidmap($pid)
 255         puts stderr "reaped $info: $got"
 256         finish 1
 257     }
 258 }
 259
 260 signal -restart trap SIGCHLD { after idle reap }
 261
 262 proc udp-proxy {} {
 263     global socktmp udpsock
 264     set u $socktmp/udp
 265     file delete $u
 266     regsub {^(?!/)} $u {./} u
 267     set udpsock [dgram-socket create $u]
 268     dgram-socket on-receive $udpsock udp-relay
 269 }
 270
 271 proc udp-relay {data src sock args} {
 272     global udpsock socktmp
 273     set headerlen [expr {52+1}]
 274     set orgsrc $src
 275
 276     set dst [hbytes range $data 0 $headerlen]
 277     regsub {(?:00)*$} $dst {} dst
 278     set dst [hbytes h2raw $dst]
 279
 280     hbytes overwrite data 0 [hbytes zeroes $headerlen]
 281     regsub {.*/} $src {} src
 282     set srch [hbytes raw2h $src]
 283     hbytes append srch 00
 284     if {[catch {
 285         if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
 286         if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
 287         hbytes overwrite data 0 $srch
 288         dgram-socket transmit $udpsock $data $socktmp/$dst
 289     } emsg]} {
 290         puts stderr "$orgsrc -> $dst: $emsg"
 291     }
 292 }
 293
 294 proc test-kex {} {
 295     udp-proxy
 296     spawn-secnet in inside
 297     spawn-secnet out outside
 298
 299     after 500 sendpkt
 300     after 1000 sendpkt
 301     after 5000 timed-out
 302
 303     vwait ok
 304 }