DGNum/liminix
14
0
Fork 2
Code Issues 15 Pull requests 7 Projects Releases Packages Wiki Activity Actions

dhcpc6 scripts: simplify (and improve correctness)

Browse source
This commit is contained in:
Daniel Barlow 2024-02-16 18:47:12 +00:00
parent 28fe37d555
commit 4bcc3d5b28
4 changed files with 138 additions and 92 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
modules/dhcp6c/acquire-delegated-prefix.fnl
View file

@ -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
(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
)))
(each [_ p (ipairs deleted)]
(system
(.. "ip address del " p.address "1/" p.len " dev " device)))))
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 }

116
modules/dhcp6c/acquire-wan-address-test.fnl
View file

@ -5,22 +5,44 @@
(local a1
{
"2001-ab-cd-ef_hjgKHGhKJH" {
"2001-ab-cd-ef" {
:address "2001:ab:cd:ef"
:len "64"
:preferred "200"
:valid "200"
: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" {
"2001-0-1-2-3" {
:address "2001:0:1:2:3"
:len "64"
:preferred "200"
:valid "200"
: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")

38
modules/dhcp6c/acquire-wan-address.fnl
View file

@ -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
(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
)))
(each [_ p (ipairs deleted)]
(system
(.. "ip address del " p.address "/" p.len " dev " wan-device)))
new-addresses))
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 }

8
pkgs/odhcp-script/odhcp6-script.fnl
View file

@ -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)))))