liminix-fork/pkgs/odhcp-script/odhcp6-script.fnl
Daniel Barlow 12e25722fa odhcp-script: delete stale dirs from previous runs
This requires adding LFS as a dependency because native Lua has
no way to iterate a directory, but it seems to be Not Huge and
hopefully we'll have other uses for it
2023-09-08 20:48:01 +01:00

112 lines
2.9 KiB
Fennel

(local { : split : merge : mkdir } (require :anoia))
(local { : view } (require :fennel))
(local lfs (require :lfs))
(fn rmtree [pathname]
(case (lfs.symlinkattributes pathname)
nil true
{:mode "directory"}
(do
(each [f (lfs.dir pathname)]
(when (not (or (= f ".") (= f "..")))
(rmtree ( .. pathname "/" f)))
(lfs.rmdir pathname)))
{:mode "file"}
(os.remove pathname)
{:mode "link"}
(os.remove pathname)
unknown
(error (.. "can't remove " pathname " of kind \"" unknown.mode "\""))))
(local state-directory (assert (os.getenv "SERVICE_STATE")))
(mkdir state-directory)
(fn write-value [name value]
(let [path (.. state-directory "/" name)]
(with-open [fout (io.open path :w)]
(when value (fout:write value)))))
(fn write-value-from-env [name]
(write-value name (os.getenv (string.upper name))))
(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))))
(fn write-addresses [prefix addresses]
(each [_ a (ipairs (split " " addresses))]
(let [address (parse-address a)
keydir (.. prefix (-> address.address
(: :gsub "::$" "")
(: :gsub ":" "-")))]
(mkdir (.. state-directory "/" keydir))
(each [k v (pairs address)]
(write-value (.. keydir "/" k) v)))))
;; we remove state before updating to ensure that consumers don't get
;; a half-updated snapshot
(os.remove (.. state-directory "/state"))
;; remove parsed addresses/prefixes from any previous run
(rmtree (.. state-directory "/prefix"))
(rmtree (.. state-directory "/address"))
(let [wanted
[
:addresses
:aftr
:cer
:domains
:lw406
:mape
:mapt
:ntp_fqdn
:ntp_ip
:option_1
:option_2
:option_3
:option_4
:option_5
:passthru
:prefixes
:ra_addresses
:ra_dns
:ra_domains
:ra_hoplimit
:ra_mtu
:ra_reachable
:ra_retransmit
:ra_routes
:rdnss
:server
:sip_domain
:sip_ip
:sntp_ip
:sntp_fqdn
]]
(each [_ n (ipairs wanted)]
(write-value-from-env n))
(write-addresses "address/" (os.getenv :ADDRESSES))
(write-addresses "prefix/" (os.getenv :PREFIXES)))
(let [[ifname state] arg
ready (match state
"started" false
"unbound" false
"stopped" false
_ true)]
(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"))))