liminix

commit 7683ed69de8b3de74d95a747e14d3530346bc9f9
parent 3ff55d3aad7e725bb39c30beeb4d625e1a66e08b
Author: Daniel Barlow <dan@telent.net>
Date:   Mon, 11 Sep 2023 00:07:11 +0100

acquire-wan-address uses parsed addresses from odhcp

Diffstat:
M
examples/acquire-wan-address.fnl
 | 
79
+++++++++++++++++++++++++++++++++----------------------------------------------

1 file changed, 33 insertions(+), 46 deletions(-)
diff --git a/examples/acquire-wan-address.fnl b/examples/acquire-wan-address.fnl
@@ -1,26 +1,6 @@
-(local { : merge : split : file-exists? : system } (require :anoia))
+(local { : system } (require :anoia))
 (local svc (require :anoia.svc))
 
-;; structurally this is remarkably similar to
-;; acquire-lan-prefix.fnl. maybe they should be merged: if not then
-;; we could at least extract some common code
-
-;; (alternatively we could move all the parsing code into the thing in
-;; the odhcp service that *writes* this stuff)
-
-; (parse-address "2001:8b0:1111:1111:0:ffff:51bb:4cf2/128,3600,7200")
-
-
-(fn parse-address [str]
-  (fn parse-extra [s]
-    (let [out {}]
-      (each [name val (string.gmatch s ",(.-)=([^,]+)")]
-        (tset out name val))
-      out))
-  (let [(address len preferred valid extra)
-        (string.match str "(.-)/(%d+),(%d+),(%d+)(.*)$")]
-    (merge {: address : len : preferred : valid} (parse-extra extra))))
-
 (local bound-states
        { :bound true
          :rebound true
@@ -31,30 +11,37 @@
 
 (fn changes [old-addresses new-addresses]
   (let [added {}
-        deleted {}
-        old-set (collect [_ v (ipairs old-addresses)] (values v true))
-        new-set (collect [_ v (ipairs new-addresses)] (values v true))]
-    (each [_ address (ipairs new-addresses)]
-      (if (not (. old-set address))
-          (table.insert added (parse-address address))))
-    (each [_ address (ipairs old-addresses)]
-      (if (not (. new-set address))
-          (table.insert deleted (parse-address address))))
+        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 wan-device] arg
-      dir (svc.open state-directory)]
-  (var addresses [])
-  (while true
-    (while (not (dir:ready?)) (dir:wait))
-    (if (. bound-states (dir:output "state"))
-        (let [new-addresses (split " " (dir:output "/addresses"))
-              (added deleted) (changes addresses new-addresses)]
-          (each [_ p (ipairs added)]
-            (system
-             (.. "ip address add " p.address "/" p.len " dev " wan-device)))
-          (each [_ p (ipairs deleted)]
-            (system
-             (.. "ip address del " p.address "/" p.len " dev " wan-device)))
-    	  (set addresses new-addresses)))
-    (dir:wait)))
+(fn update-addresses [wan-device addresses new-addresses]
+  (let [(added deleted) (changes addresses new-addresses)]
+    (each [_ p (ipairs added)]
+      (system
+       (.. "ip address add " p.address "/" p.len " dev " wan-device)))
+    (each [_ p (ipairs deleted)]
+      (system
+       (.. "ip address del " p.address "/" p.len " dev " wan-device)))
+    new-addresses))
+
+(fn run [state-directory wan-device]
+  (let [dir (svc.open state-directory)]
+    (var addresses [])
+    (while true
+      (while (not (dir:ready?)) (dir:wait))
+      (when (. bound-states (dir:output "state"))
+        (set addresses
+             (update-addresses wan-device addresses (dir:output "address"))))
+      (dir:wait))))
+
+
+(if (os.getenv "RUN_TESTS")
+    { : update-addresses : changes : run }
+    (let [[state-directory wan-device] arg]
+      (run state-directory wan-device)))