dhcpc6 scripts: simplify (and improve correctness)

modules/dhcp6c/acquire-delegated-prefix.fnl

@@ -1,40 +1,32 @@
 (local { : system } (require :anoia))
 (local svc (require :anoia.svc))
 
-(fn changes [old-addresses new-addresses]
+(fn deletions [old-addresses new-addresses]
-  (let [added {}
+  (let [deleted {}]
-        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))
+      (let [now (. new-addresses n)]
-          (table.insert deleted address)))
+        (if (or (not now) (not (= now.len address.len)))
-    (values added deleted)))
+            (table.insert deleted address))))
+    deleted))
 
-(fn update-prefixes [device prefixes new-prefixes]
+(fn update-prefixes [wan-device addresses new-addresses exec]
-  (let [(added deleted) (changes prefixes new-prefixes)]
+  (each [_ p (ipairs (deletions addresses new-addresses))]
-    ;; if some address has changed (e.g. preferred/valid lifetime)
+    (exec
-    ;; then we don't want to delete it before re-adding it because
+     (.. "ip address del " p.address "1/" p.len " dev " wan-device)))
-    ;; the kernel will drop any routes that go through it. On the
+  (each [_ p (pairs new-addresses)]
-    ;; other hand, we can't add it _before_ deleting it as we'll
+    (exec
-    ;; get an error that it already exists. Therefore, use "change"
+     (.. "ip address change " p.address "1/" p.len
-    ;; instead of "add", it works a bit more like an upsert
+         " dev " wan-device
-    (each [_ p (ipairs added)]
+         " valid_lft " p.valid
-      (system
+         " preferred_lft " p.preferred
-       (.. "ip address change " p.address "1/" p.len " dev " device
+         )))
-           " valid_lft " p.valid
+  new-addresses)
-           " preferred_lft " p.preferred
-           )))
-    (each [_ p (ipairs deleted)]
-      (system
-       (.. "ip address del " p.address "1/" p.len " dev " device)))))
 
 (fn run []
   (let [[state-directory lan-device] arg
         dir (svc.open state-directory)]
     (accumulate [addresses []
                  v (dir:events)]
-      (update-prefixes lan-device addresses (v:output "prefix")))))
+      (update-prefixes lan-device addresses (v:output "prefix") system))))
 
 { : changes : run }

modules/dhcp6c/acquire-wan-address-test.fnl

@@ -5,23 +5,45 @@
 
 (local a1
        {
-        "2001-ab-cd-ef_hjgKHGhKJH" {
+        "2001-ab-cd-ef" {
-                                    :address "2001:ab:cd:ef"
+                      	 :address "2001:ab:cd:ef"
-                                    :len "64"
+                         :len "64"
-                                    :preferred "200"
+                         :preferred "3600"
-                                    :valid "200"
+                         :valid "7200"
-                                    }
+                         }
+        }
+       )
+
+(local a156
+       {
+        "2001-ab-cd-ef" {
+                      	 :address "2001:ab:cd:ef"
+                         :len "56"
+                         :preferred "3600"
+                         :valid "7200"
+                         }
         }
        )
 
 (local a2
        {
-        "2001-0-1-2-3_aNteBnb" {
+        "2001-0-1-2-3" {
-                                :address "2001:0:1:2:3"
+                        :address "2001:0:1:2:3"
-                                :len "64"
+                        :len "64"
-                                :preferred "200"
+                        :preferred "3600"
-                                :valid "200"
+                        :valid "7200"
-                                }
+                        }
+        }
+       )
+
+(local a21
+       {
+        "2001-0-1-2-3" {
+                        :address "2001:0:1:2:3"
+                        :len "64"
+                        :preferred "1800"
+                        :valid "5400"
+                        }
         }
        )
 
@@ -30,39 +52,85 @@
     `(when (not ,assertion)
        (assert false ,msg))))
 
+(macro expect= [actual expected]
+  `(let [ve# (view ,expected)
+         va# (view ,actual)]
+     (when (not (= ve# va#))
+       (assert false
+               (.. "\nexpected " ve# "\ngot " va#)
+               ))))
+
 (fn first-address []
-  (let [(add del)
+  (let [deleted
-        (subject.changes
+        (subject.deletions
          { }
          a1
          )]
-    (expect (= (# del) 0))
+    (expect= deleted [])))
-    (expect (= (# add) 1))
-    (let [[first] add]
-      (expect (= first.address "2001:ab:cd:ef")))))
 
 (fn second-address []
-  (let [(add del)
+  (let [del
-        (subject.changes
+        (subject.deletions
          a1
          (merge (dup a1) a2)
          )]
-    (expect (= (# del) 0))
+    (expect= del [])))
-    (expect (= (# add) 1))
-    (let [[first] add] (expect (= first.address  "2001:0:1:2:3")))))
 
-(fn less-address []1
+(fn old-address-is-deleted []
-  (let [(add del)
+  (let [del
-        (subject.changes
+        (subject.deletions
          (merge (dup a1) a2)
          a1
          )]
-    (expect (= (# add) 0))
+    (expect= (. del 1) (. a2 "2001-0-1-2-3"))
-    (expect (= (# del) 1))
+    ))
 
-    (let [[first] del] (expect (= first.address  "2001:0:1:2:3")))))
+(fn changed-lifetime-not-deleted []
+  (let [del
+        (subject.deletions
+         (merge (dup a1) a2)
+         (merge (dup a1) a21)
+         )]
+    ;; when an address lifetime changes, "ip address change"
+    ;; will update that so it need not (should not) be deleted
+    (expect= del [])))
 
+(fn changed-prefix-is-deleted []
+  (let [del
+        (subject.deletions a1 a156)]
+    ;; when an address prefix changes, "ip address change"
+    ;; ignores that cjhange, so we have to remove the
+    ;; address before reinstating it
+    (expect= del [(. a1 "2001-ab-cd-ef")])))
 
 (first-address)
 (second-address)
-(less-address)
+(old-address-is-deleted)
+(changed-lifetime-not-deleted)
+(changed-prefix-is-deleted)
+
+(let [cmds []]
+  (subject.update-addresses
+   "ppp0" a1 (merge (dup a1) a2)
+   (fn [a] (table.insert cmds a)))
+  (expect=
+   (doto cmds table.sort)
+   [
+    ;; order of changes is unimportant
+    "ip address change 2001:0:1:2:3/64 dev ppp0 valid_lft 7200 preferred_lft 3600"
+    "ip address change 2001:ab:cd:ef/64 dev ppp0 valid_lft 7200 preferred_lft 3600"
+    ]))
+
+(let [cmds []]
+  (subject.update-addresses
+   "ppp0" (merge (dup a1) a2) a1
+   (fn [a] (table.insert cmds a)))
+  (expect=
+   cmds
+   [
+    ;; deletes are executed before changes
+    "ip address del 2001:0:1:2:3/64 dev ppp0"
+    "ip address change 2001:ab:cd:ef/64 dev ppp0 valid_lft 7200 preferred_lft 3600"
+    ]))
+
+(print "OK")

modules/dhcp6c/acquire-wan-address.fnl

@@ -1,40 +1,32 @@
 (local { : system } (require :anoia))
 (local svc (require :anoia.svc))
 
-;; acquire-delegated-prefix has very similar code: we'd like to move
+(fn deletions [old-addresses new-addresses]
-;; this to anoia.svc when we see what the general form would look like
+  (let [deleted {}]
-
-(fn changes [old-addresses new-addresses]
-  (let [added {}
-        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))
+      (let [now (. new-addresses n)]
-          (table.insert deleted address)))
+        (if (or (not now) (not (= now.len address.len)))
-    (values added deleted)))
+            (table.insert deleted address))))
+    deleted))
 
-(fn update-addresses [wan-device addresses new-addresses]
+(fn update-addresses [wan-device addresses new-addresses exec]
-  (let [(added deleted) (changes addresses new-addresses)]
+  (each [_ p (ipairs (deletions addresses new-addresses))]
-    ;; see comment in acquire-delegated-prefix.fnl
+    (exec
-    (each [_ p (ipairs added)]
+     (.. "ip address del " p.address "/" p.len " dev " wan-device)))
-      (system
+  (each [_ p (pairs new-addresses)]
-       (.. "ip address change " p.address "/" p.len
+    (exec
-           " dev " wan-device
+     (.. "ip address change " p.address "/" p.len
-           " valid_lft " p.valid
+         " dev " wan-device
-           " preferred_lft " p.preferred
+         " valid_lft " p.valid
-           )))
+         " preferred_lft " p.preferred
-    (each [_ p (ipairs deleted)]
+         )))
-      (system
+  new-addresses)
-       (.. "ip address del " p.address "/" p.len " dev " wan-device)))
-    new-addresses))
 
 (fn run []
   (let [[state-directory wan-device] arg
         dir (svc.open state-directory)]
     (accumulate [addresses []
                  v (dir:events)]
-      (update-addresses wan-device addresses (v:output "address")))))
+      (update-addresses wan-device addresses (v:output "address") system))))
 
-{ : update-addresses : changes : run }
+{ : update-addresses : deletions : run }

pkgs/odhcp-script/odhcp6-script.fnl

@@ -30,17 +30,11 @@
   (each [_ a (ipairs (split " " addresses))]
     (let [address (parse-address a)
           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 ":" "-"))
+                      (: :gsub ":" "-")))]
-                  "_"
-                  suffix)]
       (mktree (.. state-directory "/" keydir))
       (each [k v (pairs address)]
         (write-value (.. keydir "/" k) v)))))