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