stest/common.tcl

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