From 4bcc3d5b2802a46903ff0799d6054a79f5a23ae5 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Fri, 16 Feb 2024 18:47:12 +0000 Subject: [PATCH] dhcpc6 scripts: simplify (and improve correctness) --- modules/dhcp6c/acquire-delegated-prefix.fnl | 46 +++---- modules/dhcp6c/acquire-wan-address-test.fnl | 128 +++++++++++++++----- modules/dhcp6c/acquire-wan-address.fnl | 48 +++----- pkgs/odhcp-script/odhcp6-script.fnl | 8 +- 4 files changed, 138 insertions(+), 92 deletions(-) diff --git a/modules/dhcp6c/acquire-delegated-prefix.fnl b/modules/dhcp6c/acquire-delegated-prefix.fnl index d785126..6fc7f21 100644 --- a/modules/dhcp6c/acquire-delegated-prefix.fnl +++ b/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] - (let [added {} - deleted {}] - (each [n address (pairs new-addresses)] - (if (not (. old-addresses n)) - (table.insert added address))) +(fn deletions [old-addresses new-addresses] + (let [deleted {}] (each [n address (pairs old-addresses)] - (if (not (. new-addresses n)) - (table.insert deleted address))) - (values added deleted))) + (let [now (. new-addresses n)] + (if (or (not now) (not (= now.len address.len))) + (table.insert deleted address)))) + deleted)) -(fn update-prefixes [device prefixes new-prefixes] - (let [(added deleted) (changes prefixes new-prefixes)] - ;; if some address has changed (e.g. preferred/valid lifetime) - ;; then we don't want to delete it before re-adding it because - ;; the kernel will drop any routes that go through it. On the - ;; other hand, we can't add it _before_ deleting it as we'll - ;; get an error that it already exists. Therefore, use "change" - ;; instead of "add", it works a bit more like an upsert - (each [_ p (ipairs added)] - (system - (.. "ip address change " p.address "1/" p.len " dev " device - " valid_lft " p.valid - " preferred_lft " p.preferred - ))) - (each [_ p (ipairs deleted)] - (system - (.. "ip address del " p.address "1/" p.len " dev " device))))) +(fn update-prefixes [wan-device addresses new-addresses exec] + (each [_ p (ipairs (deletions addresses new-addresses))] + (exec + (.. "ip address del " p.address "1/" p.len " dev " wan-device))) + (each [_ p (pairs new-addresses)] + (exec + (.. "ip address change " p.address "1/" p.len + " dev " wan-device + " valid_lft " p.valid + " preferred_lft " p.preferred + ))) + new-addresses) (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 } diff --git a/modules/dhcp6c/acquire-wan-address-test.fnl b/modules/dhcp6c/acquire-wan-address-test.fnl index 8153d72..c71b67b 100644 --- a/modules/dhcp6c/acquire-wan-address-test.fnl +++ b/modules/dhcp6c/acquire-wan-address-test.fnl @@ -5,23 +5,45 @@ (local a1 { - "2001-ab-cd-ef_hjgKHGhKJH" { - :address "2001:ab:cd:ef" - :len "64" - :preferred "200" - :valid "200" - } + "2001-ab-cd-ef" { + :address "2001:ab:cd:ef" + :len "64" + :preferred "3600" + :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" { - :address "2001:0:1:2:3" - :len "64" - :preferred "200" - :valid "200" - } + "2001-0-1-2-3" { + :address "2001:0:1:2:3" + :len "64" + :preferred "3600" + :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) - (subject.changes + (let [deleted + (subject.deletions { } a1 )] - (expect (= (# del) 0)) - (expect (= (# add) 1)) - (let [[first] add] - (expect (= first.address "2001:ab:cd:ef"))))) + (expect= deleted []))) (fn second-address [] - (let [(add del) - (subject.changes + (let [del + (subject.deletions a1 (merge (dup a1) a2) )] - (expect (= (# del) 0)) - (expect (= (# add) 1)) - (let [[first] add] (expect (= first.address "2001:0:1:2:3"))))) + (expect= del []))) -(fn less-address []1 - (let [(add del) - (subject.changes +(fn old-address-is-deleted [] + (let [del + (subject.deletions (merge (dup a1) a2) a1 )] - (expect (= (# add) 0)) - (expect (= (# del) 1)) + (expect= (. del 1) (. a2 "2001-0-1-2-3")) + )) - (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") diff --git a/modules/dhcp6c/acquire-wan-address.fnl b/modules/dhcp6c/acquire-wan-address.fnl index 38847bc..c1c4e6c 100644 --- a/modules/dhcp6c/acquire-wan-address.fnl +++ b/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 -;; this to anoia.svc when we see what the general form would look like - -(fn changes [old-addresses new-addresses] - (let [added {} - deleted {}] - (each [n address (pairs new-addresses)] - (if (not (. old-addresses n)) - (table.insert added address))) +(fn deletions [old-addresses new-addresses] + (let [deleted {}] (each [n address (pairs old-addresses)] - (if (not (. new-addresses n)) - (table.insert deleted address))) - (values added deleted))) + (let [now (. new-addresses n)] + (if (or (not now) (not (= now.len address.len))) + (table.insert deleted address)))) + deleted)) -(fn update-addresses [wan-device addresses new-addresses] - (let [(added deleted) (changes addresses new-addresses)] - ;; see comment in acquire-delegated-prefix.fnl - (each [_ p (ipairs added)] - (system - (.. "ip address change " p.address "/" p.len - " dev " wan-device - " valid_lft " p.valid - " preferred_lft " p.preferred - ))) - (each [_ p (ipairs deleted)] - (system - (.. "ip address del " p.address "/" p.len " dev " wan-device))) - new-addresses)) +(fn update-addresses [wan-device addresses new-addresses exec] + (each [_ p (ipairs (deletions addresses new-addresses))] + (exec + (.. "ip address del " p.address "/" p.len " dev " wan-device))) + (each [_ p (pairs new-addresses)] + (exec + (.. "ip address change " p.address "/" p.len + " dev " wan-device + " valid_lft " p.valid + " preferred_lft " p.preferred + ))) + 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 } diff --git a/pkgs/odhcp-script/odhcp6-script.fnl b/pkgs/odhcp-script/odhcp6-script.fnl index 699f695..02c415e 100644 --- a/pkgs/odhcp-script/odhcp6-script.fnl +++ b/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 ":" "-")) - "_" - suffix)] + (: :gsub ":" "-")))] (mktree (.. state-directory "/" keydir)) (each [k v (pairs address)] (write-value (.. keydir "/" k) v)))))