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