test for acquire-wan-address

this means fennelrepl in nix-shell will prefer local
source files to generated lua files, making it easier
to change library code without restarting the shell

examples/acquire-wan-address-test.fnl

@@ -0,0 +1,68 @@
+(local subject (require :acquire-wan-address))
+(local { : view } (require :fennel))
+(local { : merge : dup } (require :anoia))
+
+
+(local a1
+       {
+        "2001-ab-cd-ef_hjgKHGhKJH" {
+                                    :address "2001:ab:cd:ef"
+                                    :len "64"
+                                    :preferred "200"
+                                    :valid "200"
+                                    }
+        }
+       )
+
+(local a2
+       {
+        "2001-0-1-2-3_aNteBnb" {
+                                :address "2001:0:1:2:3"
+                                :len "64"
+                                :preferred "200"
+                                :valid "200"
+                                }
+        }
+       )
+
+(macro expect [assertion]
+  (let [msg (.. "expectation failed: " (view assertion))]
+    `(when (not ,assertion)
+       (assert false ,msg))))
+
+(fn first-address []
+  (let [(add del)
+        (subject.changes
+         { }
+         a1
+         )]
+    (expect (= (# del) 0))
+    (expect (= (# add) 1))
+    (let [[first] add]
+      (expect (= first.address "2001:ab:cd:ef")))))
+
+(fn second-address []
+  (let [(add del)
+        (subject.changes
+         a1
+         (merge (dup a1) a2)
+         )]
+    (expect (= (# del) 0))
+    (expect (= (# add) 1))
+    (let [[first] add] (expect (= first.address  "2001:0:1:2:3")))))
+
+(fn less-address []1
+  (let [(add del)
+        (subject.changes
+         (merge (dup a1) a2)
+         a1
+         )]
+    (expect (= (# add) 0))
+    (expect (= (# del) 1))
+
+    (let [[first] del] (expect (= first.address  "2001:0:1:2:3")))))
+
+
+(first-address)
+(second-address)
+(less-address)

examples/acquire-wan-address.fnl

@@ -1,26 +1,6 @@
-(local { : merge : split : file-exists? : system } (require :anoia))
+(local { : system } (require :anoia))
 (local svc (require :anoia.svc))
 
-;; structurally this is remarkably similar to
-;; acquire-lan-prefix.fnl. maybe they should be merged: if not then
-;; we could at least extract some common code
-
-;; (alternatively we could move all the parsing code into the thing in
-;; the odhcp service that *writes* this stuff)
-
-; (parse-address "2001:8b0:1111:1111:0:ffff:51bb:4cf2/128,3600,7200")
-
-
-(fn parse-address [str]
-  (fn parse-extra [s]
-    (let [out {}]
-      (each [name val (string.gmatch s ",(.-)=([^,]+)")]
-        (tset out name val))
-      out))
-  (let [(address len preferred valid extra)
-        (string.match str "(.-)/(%d+),(%d+),(%d+)(.*)$")]
-    (merge {: address : len : preferred : valid} (parse-extra extra))))
-
 (local bound-states
        { :bound true
          :rebound true
@@ -31,30 +11,37 @@
 
 (fn changes [old-addresses new-addresses]
   (let [added {}
-        deleted {}
-        old-set (collect [_ v (ipairs old-addresses)] (values v true))
-        new-set (collect [_ v (ipairs new-addresses)] (values v true))]
-    (each [_ address (ipairs new-addresses)]
-      (if (not (. old-set address))
-          (table.insert added (parse-address address))))
-    (each [_ address (ipairs old-addresses)]
-      (if (not (. new-set address))
-          (table.insert deleted (parse-address address))))
+        deleted {}]
+    (each [n address (pairs new-addresses)]
+      (if (not (. old-addresses n))
+          (table.insert added address)))
+    (each [n address (pairs old-addresses)]
+      (if (not (. new-addresses n))
+          (table.insert deleted address)))
     (values added deleted)))
 
-(let [[state-directory wan-device] arg
-      dir (svc.open state-directory)]
-  (var addresses [])
-  (while true
-    (while (not (dir:ready?)) (dir:wait))
-    (if (. bound-states (dir:output "state"))
-        (let [new-addresses (split " " (dir:output "/addresses"))
-              (added deleted) (changes addresses new-addresses)]
-          (each [_ p (ipairs added)]
-            (system
-             (.. "ip address add " p.address "/" p.len " dev " wan-device)))
-          (each [_ p (ipairs deleted)]
-            (system
-             (.. "ip address del " p.address "/" p.len " dev " wan-device)))
-    	  (set addresses new-addresses)))
-    (dir:wait)))
+(fn update-addresses [wan-device addresses new-addresses]
+  (let [(added deleted) (changes addresses new-addresses)]
+    (each [_ p (ipairs added)]
+      (system
+       (.. "ip address add " p.address "/" p.len " dev " wan-device)))
+    (each [_ p (ipairs deleted)]
+      (system
+       (.. "ip address del " p.address "/" p.len " dev " wan-device)))
+    new-addresses))
+
+(fn run [state-directory wan-device]
+  (let [dir (svc.open state-directory)]
+    (var addresses [])
+    (while true
+      (while (not (dir:ready?)) (dir:wait))
+      (when (. bound-states (dir:output "state"))
+        (set addresses
+             (update-addresses wan-device addresses (dir:output "address"))))
+      (dir:wait))))
+
+
+(if (os.getenv "RUN_TESTS")
+    { : update-addresses : changes : run }
+    (let [[state-directory wan-device] arg]
+      (run state-directory wan-device)))

pkgs/anoia/example-output/addresses/1/attribute

@@ -0,0 +1 @@
+a11

pkgs/anoia/example-output/addresses/3/attribute

@@ -0,0 +1 @@
+a33

pkgs/anoia/example-output/addresses/5/attribute

@@ -0,0 +1 @@
+a55

pkgs/anoia/example-output/addresses/6/attribute

@@ -0,0 +1 @@
+a66

pkgs/anoia/example-output/colours/black

@@ -0,0 +1 @@
+000000

pkgs/anoia/example-output/colours/blue

@@ -0,0 +1 @@
+0000ff

pkgs/anoia/example-output/colours/green

@@ -0,0 +1 @@
+00ff00

pkgs/anoia/example-output/colours/red

@@ -0,0 +1 @@
+ff0000

pkgs/anoia/example-output/name

@@ -0,0 +1 @@
+eth1

pkgs/anoia/fs.fnl

@@ -29,4 +29,8 @@
     (error (.. "can't remove " pathname " of kind \"" unknown.mode "\""))))
 
 
-{ : mktree : rmtree }
+{
+ : mktree
+ : rmtree
+ : directory?
+ }

pkgs/anoia/init.fnl

@@ -2,6 +2,9 @@
   (collect [k v (pairs table2) &into table1]
     k v))
 
+(fn dup [table]
+  (collect [k v (pairs table)] k v))
+
 (fn split [sep string]
   (icollect [v (string.gmatch string (.. "([^" sep "]+)"))]
     v))
@@ -13,4 +16,47 @@
 
 (fn system [s] (assert (os.execute s)))
 
-{ : merge : split : file-exists? : system }
+(fn hash [str]
+  (accumulate [h 5381
+               c (str:gmatch ".")]
+    (+ (* h 33) (string.byte c))))
+
+
+(local
+ base64-indices
+ (doto [
+        "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P"
+        "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f"
+        "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v"
+        "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "-" "_"
+        ]
+   (tset 0 "A")))
+
+;; local function base64(s)
+;;    local byte, rep = string.byte, string.rep
+;;    local pad = 2 - ((#s-1) % 3)
+;;    s = (s..rep('\0', pad)):gsub("...", function(cs)
+;;       local a, b, c = byte(cs, 1, 3)
+;;       return bs[a>>2] .. bs[(a&3)<<4|b>>4] .. bs[(b&15)<<2|c>>6] .. bs[c&63]
+;;    end)
+;;    return s:sub(1, #s-pad) .. rep('=', pad)
+;; end
+
+(fn base64url [s]
+  "URL-safe Base64-encoded form of s (no trailing padding)"
+  (let [pad (- 2 (% (- (# s) 1)  3))
+        bs base64-indices
+        blank (string.rep "\0" pad)
+        s (-> (.. s blank)
+              (: :gsub
+                 "..."
+                 (fn [cs]
+                   (let [(a b c) (string.byte cs  1 3)]
+                     (.. (. bs (rshift a 2))
+                         (. bs (bor (lshift (band a 3) 4)  (rshift b 4)))
+                         (. bs (bor (lshift (band b 15) 2) (rshift c 6)))
+                         (. bs (band c 63)))))))]
+    (s:sub 1 (- (# s) pad))))
+
+
+{ : merge : split : file-exists? : system : hash : base64url : dup }

pkgs/anoia/svc.fnl

@@ -1,5 +1,7 @@
 (local inotify (require :inotify))
 (local { : file-exists? } (require :anoia))
+(local { : directory? } (require :anoia.fs))
+(local lfs (require :lfs))
 
 (fn read-line [name]
   (with-open [f (assert (io.open name :r) (.. "can't open file " name))]
@@ -17,14 +19,30 @@
                      inotify.IN_CLOSE_WRITE)
     handle))
 
+(fn read-value [pathname]
+  (case (lfs.symlinkattributes pathname)
+    nil nil
+    {:mode "directory"}
+    (collect [f (lfs.dir pathname)]
+      (when (not (or (= f ".") (= f "..")))
+        (values f (read-value ( .. pathname "/" f)))))
+    {:mode "file"}
+    (read-line pathname)
+    {:mode "link"}
+    (read-line pathname)
+    unknown
+    (error (.. "can't read " pathname " of kind \"" unknown.mode "\""))))
+
+
 (fn open [directory]
   (let [watcher (watch-fsevents directory)
         has-file? (fn [filename] (file-exists? (.. directory "/" filename)))]
     {
-     :wait (fn [] (watcher:read))
+     :wait #(watcher:read)
      :ready? (fn [self]
                (and (has-file? "state") (not (has-file? ".lock"))))
-     :output (fn [_ filename] (read-line (.. directory "/" filename)))
+     :output (fn [_ filename]
+               (read-value (.. directory "/" filename)))
      :close #(watcher:close)
      }))
 

pkgs/anoia/test-svc.fnl

@@ -0,0 +1,17 @@
+(local svc (require :anoia.svc))
+(local { : view } (require :fennel))
+
+(local ex (svc.open "./example-output"))
+
+(assert (= (ex:output "name") "eth1"))
+
+(assert (=
+         (table.concat (ex:output "colours"))
+         (table.concat { :red "ff0000" :green "00ff00" :blu "0000ff" :black "000000" })))
+
+(assert (=
+         (table.concat (ex:output "addresses"))
+         (table.concat {:1 {:attribute "a11"}
+                        :3 {:attribute "a33"}
+                        :5 {:attribute "a55"}
+                        :6 {:attribute "a66"}})))

pkgs/anoia/test.fnl

@@ -0,0 +1,9 @@
+(local { : hash : base64url } (require :anoia))
+
+(assert (= (hash "") 5381))
+
+;; these examples from https://theartincode.stanis.me/008-djb2/
+(assert (= (hash "Hello") 210676686969))
+(assert (= (hash "Hello!") 6952330670010))
+
+(assert (= (base64url "hello world") "aGVsbG8gd29ybGQ"))

pkgs/fennelrepl/default.nix

@@ -28,7 +28,8 @@ in writeScriptBin "fennelrepl" ''
     package.path = ${lib.strings.escapeShellArg luapath} .. ";" .. package.path
     package.cpath = ${lib.strings.escapeShellArg luacpath} .. ";" .. (package.cpath or "")
     local fennel = require "fennel"
-    fennel.install()
+    table.insert(package.loaders or package.searchers,1, fennel.searcher)
+
     local more_fennel = os.getenv("FENNEL_PATH")
     if more_fennel then
         fennel.path = more_fennel .. ";" .. fennel.path

pkgs/odhcp-script/expected

@@ -1,20 +1,20 @@
-./address/2001-8b0-1111-1111-0-ffff-1234-5678/address:2001:8b0:1111:1111:0:ffff:1234:5678
-./address/2001-8b0-1111-1111-0-ffff-1234-5678/len:128
-./address/2001-8b0-1111-1111-0-ffff-1234-5678/preferred:3600
-./address/2001-8b0-1111-1111-0-ffff-1234-5678/valid:7200
+./address/2001-8b0-1111-1111-0-ffff-1234-5678_BVG8Gro50UM/address:2001:8b0:1111:1111:0:ffff:1234:5678
+./address/2001-8b0-1111-1111-0-ffff-1234-5678_BVG8Gro50UM/len:128
+./address/2001-8b0-1111-1111-0-ffff-1234-5678_BVG8Gro50UM/preferred:3600
+./address/2001-8b0-1111-1111-0-ffff-1234-5678_BVG8Gro50UM/valid:7200
 ./addresses:2001:8b0:1111:1111:0:ffff:1234:5678/128,3600,7200
 ./ifname:ppp0
 ./option_1:000300018cfdf02420eb
 ./option_2:000300010df0feca0df0
 ./passthru:00170020200108b0000000000000000000002020200108b0000000000000000000002021
-./prefix/2001-8b0-de3a-22/address:2001:8b0:de3a:22::
-./prefix/2001-8b0-de3a-22/len:64
-./prefix/2001-8b0-de3a-22/preferred:7200
-./prefix/2001-8b0-de3a-22/valid:7200
-./prefix/2001-8b0-de3a-abcd/address:2001:8b0:de3a:abcd::
-./prefix/2001-8b0-de3a-abcd/len:64
-./prefix/2001-8b0-de3a-abcd/preferred:7200
-./prefix/2001-8b0-de3a-abcd/valid:7200
+./prefix/2001-8b0-de3a-22_hiaEztRS00M/address:2001:8b0:de3a:22::
+./prefix/2001-8b0-de3a-22_hiaEztRS00M/len:64
+./prefix/2001-8b0-de3a-22_hiaEztRS00M/preferred:7200
+./prefix/2001-8b0-de3a-22_hiaEztRS00M/valid:7200
+./prefix/2001-8b0-de3a-abcd_HmTdEWrIMEM/address:2001:8b0:de3a:abcd::
+./prefix/2001-8b0-de3a-abcd_HmTdEWrIMEM/len:64
+./prefix/2001-8b0-de3a-abcd_HmTdEWrIMEM/preferred:7200
+./prefix/2001-8b0-de3a-abcd_HmTdEWrIMEM/valid:7200
 ./prefixes:2001:8b0:de3a:abcd::/64,7200,7200 2001:8b0:de3a:22::/64,7200,7200
 ./ra_hoplimit:64
 ./ra_mtu:0

pkgs/odhcp-script/odhcp6-script.fnl

@@ -1,4 +1,4 @@
-(local { : split : merge } (require :anoia))
+(local { : split : merge : hash : base64url } (require :anoia))
 (local { : view } (require :fennel))
 (local { : mktree : rmtree } (require :anoia.fs))
 
@@ -26,9 +26,18 @@
 (fn write-addresses [prefix addresses]
   (each [_ a (ipairs (split " " addresses))]
     (let [address (parse-address a)
-          keydir (.. prefix (-> address.address
-                                (: :gsub "::$" "")
-                                (: :gsub ":" "-")))]
+          suffix (base64url (string.pack "n" (hash a)))
+          ;; keydir should be a function of all the address
+          ;; attributes: we want it to change whenever anything changes
+          ;; so that clients can see which addresses are new without
+          ;; deep table comparisons
+          keydir (..
+                  prefix
+                  (-> address.address
+                      (: :gsub "::$" "")
+                      (: :gsub ":" "-"))
+                  "_"
+                  suffix)]
       (mktree (.. state-directory "/" keydir))
       (each [k v (pairs address)]
         (write-value (.. keydir "/" k) v)))))