liminix

commit 92e107d77c34f25856445885e45651a8dd58b364
parent fa040a194c0ed7d9fc3f58d46ac229189ae9d959
Author: Daniel Barlow <dan@telent.net>
Date:   Wed, 13 Sep 2023 17:49:57 +0100

update acquire-delegated-prefix to use svc.events

Diffstat:
M
examples/acquire-delegated-prefix.fnl
 | 
80
++++++++++++++++++++++++++-----------------------------------------------------
M
examples/acquire-delegated-prefix.nix
 | 
9
+++++----
M
examples/acquire-wan-address.fnl
 | 
3
+++

3 files changed, 34 insertions(+), 58 deletions(-)
diff --git a/examples/acquire-delegated-prefix.fnl b/examples/acquire-delegated-prefix.fnl
@@ -1,59 +1,31 @@
-(local { : merge : split : file-exists? : system } (require :anoia))
+(local { : system } (require :anoia))
 (local svc (require :anoia.svc))
 
-(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))))
-
-
-;; Format: <prefix>/<length>,preferred,valid[,excluded=<excluded-prefix>/<length>][,class=<prefix class #>]
-
-;;(parse-prefix "2001:8b0:de3a:40dc::/64,7198,7198")
-;;(parse-prefix "2001:8b0:de3a:1001::/64,7198,7188,excluded=1/2,thi=10")
-
-
-(local bound-states
-       { :bound true
-         :rebound true
-         :informed true
-         :updated true
-         :ra-updated true
-         })
-
-; (local { : view } (require :fennel))
-
-(fn changes [old-prefixes new-prefixes]
+(fn changes [old-addresses new-addresses]
   (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))))
+        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))
+          (table.insert deleted address)))
     (values added deleted)))
 
-(let [[state-directory lan-device] arg
-      dir (svc.open state-directory)]
-  (var prefixes [])
-  (while true
-    (while (not (dir:ready?)) (dir:wait))
-    (if (. bound-states (dir:output "state"))
-        (let [new-prefixes (split " " (dir:output "/prefixes"))
-              (added deleted) (changes prefixes new-prefixes)]
-          (each [_ p (ipairs added)]
-            (system
-             (.. "ip address add " p.prefix "::1/" p.len " dev " lan-device)))
-          (each [_ p (ipairs deleted)]
-            (system
-             (.. "ip address del " p.prefix "::1/" p.len " dev " lan-device)))
-    	  (set prefixes new-prefixes)))
-    (dir:wait)))
+(fn update-prefixes [device prefixes new-prefixes]
+  (let [(added deleted) (changes prefixes new-prefixes)]
+    (each [_ p (ipairs added)]
+      (system
+       (.. "ip address add " p.address "1/" p.len " dev " device)))
+    (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")))))
+
+{ : changes : run }
diff --git a/examples/acquire-delegated-prefix.nix b/examples/acquire-delegated-prefix.nix
@@ -1,9 +1,10 @@
 {
-  writeFennelScript
+  writeFennel
 , linotify
 , anoia
 , lua
 }:
-writeFennelScript "acquire-delegated-prefix"
-  [ linotify anoia lua.pkgs.luafilesystem ]
-  ./acquire-delegated-prefix.fnl
+writeFennel "acquire-delegated-prefix" {
+  packages = [ linotify anoia lua.pkgs.luafilesystem ];
+  mainFunction = "run";
+} ./acquire-delegated-prefix.fnl
diff --git a/examples/acquire-wan-address.fnl b/examples/acquire-wan-address.fnl
@@ -1,6 +1,9 @@
 (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 {}]