diff --git a/examples/acquire-wan-address.fnl b/examples/acquire-wan-address.fnl index cf28799..68a66ca 100644 --- 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)))