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     puts "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* { puts -nonewline " $k=$env($k)" }
 200         }
 201     }
 202     if {[info exists env($divertk)]} {
 203         switch -glob $env($divertk) {
 204             i - {i *} {
 205                 regsub {^i} $env($divertk) {} divert_prefix
 206                 puts "$divert_prefix $argl"
 207                 puts -nonewline "run ^ command, hit return "
 208                 flush stdout
 209                 gets stdin
 210                 set argl {}
 211             }
 212             0 - "" {
 213                 puts " $argl"
 214             }
 215             /* - ./* {
 216                 puts " $argl"
 217                 set argl [split $env($divertk)]
 218                 puts "... $argl"
 219             }
 220             * {
 221                 error "$divertk not understood"
 222             }
 223         }
 224     }
 225     if {[llength $argl]} {
 226         set pid [fork]
 227         set pidmap($pid) "secnet $location/$site"
 228         if {!$pid} {
 229             execl [lindex $argl 0] [lrange $argl 1 end]
 230         }
 231     }
 232     puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
 233 }
 234
 235 proc netlink-readable {location site} {
 236     global ok
 237     upvar #0 readbuf($site) buf
 238     upvar #0 netlinkfh($site.r) fh
 239     while 1 {
 240         set x [read $fh]
 241         set h [hbytes raw2h $x]
 242         if {![hbytes length $h]} return
 243         append buf $h
 244         #puts "READABLE $site buf=$buf"
 245         while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
 246             #puts "READABLE $site now=$now (buf=$buf)"
 247             regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
 248             regsub -all {^((?:..)*?)dbdd} $now {\1db} now
 249             puts "netlink-got-packet $location $site $now"
 250             netlink-got-packet $location $site $now
 251         }
 252     }
 253 }
 254
 255 proc netlink-got-packet {location site data} {
 256     global initiator
 257     if {![hbytes length $data]} return
 258     switch -exact $site!$initiator {
 259         inside!inside - outside!outside {
 260             switch -glob $data {
 261                 45000054ed9d4000fe0166d9ac12e802ac12e80900* {
 262                     puts "OK $data"
 263                     finish 0
 264                 }
 265                 * {
 266                     error "unexpected $site $data"
 267                 }
 268             }
 269         }
 270         default {
 271             error "$site rx'd! (initiator $initiator)"
 272         }
 273     }
 274 }
 275
 276 proc bgerror {message} {
 277     global errorInfo errorCode
 278     catch {
 279         puts stderr "
 280 ----------------------------------------
 281 $errorInfo
 282
 283 $errorCode
 284 $message
 285 ----------------------------------------
 286     "
 287     }
 288     finish 1
 289 }
 290
 291 proc sendpkt {} {
 292     global netlinkfh
 293     global initiator
 294     set p {
 295         4500 0054 ed9d 4000 4001 24da ac12 e809
 296         ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
 297         0000 0000 507f 0b00 0000 0000 1011 1213
 298         1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
 299         2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
 300         3435 3637
 301     }
 302     puts -nonewline $netlinkfh($initiator.t) \
 303         [hbytes h2raw c0[join $p ""]c0]
 304 }
 305
 306 set socktmp $tmp/s
 307 exec mkdir -p -m700 $socktmp
 308 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
 309
 310 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
 311
 312 set env(UDP_PRELOAD_DIR) $socktmp
 313 prefix_preload $builddir/stest/udp-preload.so
 314
 315 proc finish {estatus} {
 316     puts stderr "FINISHING $estatus"
 317     signal default SIGCHLD
 318     global pidmap
 319     foreach pid [array names pidmap] {
 320         kill KILL $pid
 321     }
 322     exit $estatus
 323 }
 324
 325 proc reap {} {
 326     global pidmap
 327     #puts stderr REAPING
 328     foreach pid [array names pidmap] {
 329         set got [wait -nohang $pid]
 330         if {![llength $got]} continue
 331         set info $pidmap($pid)
 332         unset pidmap($pid)
 333         puts stderr "reaped $info: $got"
 334         finish 1
 335     }
 336 }
 337
 338 signal -restart trap SIGCHLD { after idle reap }
 339
 340 proc udp-proxy {} {
 341     global socktmp udpsock
 342     set u $socktmp/udp
 343     file delete $u
 344     regsub {^(?!/)} $u {./} u
 345     set udpsock [dgram-socket create $u]
 346     dgram-socket on-receive $udpsock udp-relay
 347 }
 348
 349 proc udp-relay {data src sock args} {
 350     global udpsock socktmp
 351     set headerlen [expr {52+1}]
 352     set orgsrc $src
 353
 354     set dst [hbytes range $data 0 $headerlen]
 355     regsub {(?:00)*$} $dst {} dst
 356     set dst [hbytes h2raw $dst]
 357
 358     hbytes overwrite data 0 [hbytes zeroes $headerlen]
 359     regsub {.*/} $src {} src
 360     set srch [hbytes raw2h $src]
 361     hbytes append srch 00
 362     if {[catch {
 363         if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
 364         if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
 365         hbytes overwrite data 0 $srch
 366         dgram-socket transmit $udpsock $data $socktmp/$dst
 367     } emsg]} {
 368         puts stderr "$orgsrc -> $dst: $emsg"
 369     }
 370 }
 371
 372 proc adj-after {timeout args} {
 373     upvar #0 env(SECNET_STEST_TIMEOUT_MUL) mul
 374     if {[info exists mul]} { set timeout [expr {$timeout * $mul}] }
 375     eval after $timeout $args
 376 }
 377
 378 proc test-kex {} {
 379     udp-proxy
 380     spawn-secnet in inside
 381     spawn-secnet out outside
 382
 383     adj-after 500 sendpkt
 384     adj-after 1000 sendpkt
 385     adj-after 5000 timed-out
 386
 387     vwait ok
 388 }