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