commit 3900683413da08e6d5507fe227254327c862c7fd
parent 553214474747dce3a9cdb440a8f0caabc28eaac8
Author: Daniel Barlow <dan@telent.net>
Date: Sun, 2 Jul 2023 00:52:18 +0100
simplify protocol for watchers of service output directories
Previously: the service wrote a timestamp and the receiver
read and parsed it to see if there was new data
Now: the service writes and removes a .lock file to prevent
the receiver reading partial data. The receiver is responsible
for remembering the *previous* state and only updating if it's changed
Diffstat:
2 files changed, 79 insertions(+), 47 deletions(-)
diff --git a/examples/acquire-delegated-prefix.fnl b/examples/acquire-delegated-prefix.fnl
@@ -1,39 +1,28 @@
-
(local inotify (require :inotify))
-(fn watch-fsevents [directory-name]
- (let [handle (inotify.init)]
- (handle:addwatch directory-name
- inotify.IN_CREATE
- inotify.IN_MOVE
- inotify.IN_DELETE
- inotify.IN_DELETE_SELF
- inotify.IN_MOVED_FROM
- inotify.IN_MOVED_TO
- inotify.IN_CLOSE_WRITE)
- handle))
-
-
(fn merge [table1 table2]
(collect [k v (pairs table2) &into table1]
k v))
-(fn parse-extra [s]
- (let [out {}]
- (each [name val (string.gmatch s ",(.-)=([^,]+)")]
- (tset out name val))
- out))
+(fn split [sep string]
+ (icollect [v (string.gmatch string (.. "([^" sep "]+)"))]
+ v))
+
+(fn parse-prefix [str]
+ (fn parse-extra [s]
+ (let [out {}]
+ (each [name val (string.gmatch s ",(.-)=([^,]+)")]
+ (tset out name val))
+ out))
+ (let [(prefix len preferred valid extra)
+ (string.match str "(.-)::/(%d+),(%d+),(%d+)(.*)$")]
+ (merge {: prefix : len : preferred : valid} (parse-extra extra))))
-(fn parse-prefixes [prefixes]
- (icollect [val (string.gmatch prefixes "([^ ]+)")]
- (let [(prefix len preferred valid extra)
- (string.match val "(.-)::/(%d+),(%d+),(%d+)(.*)$")]
- (merge {: prefix : len : preferred : valid} (parse-extra extra))
- )))
;; Format: <prefix>/<length>,preferred,valid[,excluded=<excluded-prefix>/<length>][,class=<prefix class #>]
-;; (parse-prefixes "2001:8b0:de3a:40dc::/64,7198,7198 2001:8b0:de3a:1001::/64,7198,7188,excluded=1/2,thi=10")
+;;(parse-prefix "2001:8b0:de3a:40dc::/64,7198,7198")
+;;(parse-prefix "2001:8b0:de3a:1001::/64,7198,7188,excluded=1/2,thi=10")
(fn file-exists? [name]
@@ -41,30 +30,72 @@
f (do (f:close) true)
_ false))
-
(fn read-line [name]
(with-open [f (assert (io.open name :r) (.. "can't open file " name))]
(f:read "*l")))
-(var last-update 0)
-(fn event-time [directory]
- (if (file-exists? (.. directory "/state"))
- (tonumber (read-line (.. directory "/last-update")))
- nil))
+(fn watch-fsevents [directory-name]
+ (let [handle (inotify.init)]
+ (handle:addwatch directory-name
+ inotify.IN_CREATE
+ inotify.IN_MOVE
+ inotify.IN_DELETE
+ inotify.IN_DELETE_SELF
+ inotify.IN_MOVED_FROM
+ inotify.IN_MOVED_TO
+ inotify.IN_CLOSE_WRITE)
+ handle))
+
+(fn watch-directory [pathname]
+ (let [watcher (watch-fsevents pathname)]
+ {
+ :has-file? (fn [_ filename] (file-exists? (.. pathname "/" filename)))
+ :wait-events (fn [] (watcher:read))
+ :ready? (fn [self]
+ (and (self:has-file? "state") (not (self:has-file? ".lock"))))
+ :read-line (fn [_ filename] (read-line (.. pathname "/" filename)))
+ :close #(watcher:close)
+ }))
+
+(local bound-states
+ { :bound true
+ :rebound true
+ :informed true
+ :updated true
+ :ra-updated true
+ })
+
+; (local { : view } (require :fennel))
+
+(fn changes [old-prefixes new-prefixes]
+ (let [added {}
+ deleted {}
+ old-set (collect [_ v (ipairs old-prefixes)] (values v true))
+ new-set (collect [_ v (ipairs new-prefixes)] (values v true))]
+ (each [_ prefix (ipairs new-prefixes)]
+ (if (not (. old-set prefix))
+ (table.insert added (parse-prefix prefix))))
+ (each [_ prefix (ipairs old-prefixes)]
+ (if (not (. new-set prefix))
+ (table.insert deleted (parse-prefix prefix))))
+ (values added deleted)))
-(fn wait-for-update [directory fsevents]
- (while (<= (or (event-time directory) 0) last-update)
- (fsevents:read))
- (set last-update (event-time directory))
- true)
+;;(fn execute [s] (do (print s) true))
+(fn execute [s] (assert (os.execute s)))
(let [[state-directory lan-device] arg
- fsevents (watch-fsevents state-directory)]
- (while (wait-for-update state-directory fsevents)
- (match (read-line (.. state-directory "/state"))
- (where (or :bound :rebound :informed :updated :ra-updated))
- (let [[{ : prefix : len : preferred : valid }]
- (parse-prefixes (read-line (.. state-directory "/prefixes")))]
- (os.execute (.. "ip address add " prefix "::1/" len
- " dev " lan-device)))
- _ (os.exit 1))))
+ dir (watch-directory state-directory)]
+ (var prefixes [])
+ (while true
+ (while (not (dir:ready?)) (dir:wait-events))
+ (if (. bound-states (dir:read-line "state"))
+ (let [new-prefixes (split " " (dir:read-line "/prefixes"))
+ (added deleted) (changes prefixes new-prefixes)]
+ (each [_ p (ipairs added)]
+ (execute
+ (.. "ip address add " p.prefix "::1/" p.len " dev " lan-device)))
+ (each [_ p (ipairs deleted)]
+ (execute
+ (.. "ip address del " p.prefix "::1/" p.len " dev " lan-device)))
+ (set prefixes new-prefixes)))
+ (dir:wait-events)))
diff --git a/pkgs/odhcp-script/odhcp6-script.fnl b/pkgs/odhcp-script/odhcp6-script.fnl
@@ -56,8 +56,9 @@
"unbound" false
"stopped" false
_ true)]
- (write-value "last-update" (tostring (os.time)))
+ (write-value ".lock" (tostring (os.time)))
(write-value "ifname" ifname)
(write-value "state" state)
+ (os.remove (.. state-directory "/.lock"))
(when ready
(with-open [fd (io.open "/proc/self/fd/10" :w)] (fd:write "\n"))))
