commit 4bcc3d5b2802a46903ff0799d6054a79f5a23ae5
parent 28fe37d555d8110f7389280b72c7890f95d79041
Author: Daniel Barlow <dan@telent.net>
Date: Fri, 16 Feb 2024 18:47:12 +0000
dhcpc6 scripts: simplify (and improve correctness)
Diffstat:
4 files changed, 138 insertions(+), 92 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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)))))
