liminix

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

s6-rc-up-tree.fnl (2098B)


      1 (local { : opendir : readdir } (require :lualinux))
      2 
      3 (fn fail [err]
      4   (print "ERROR" err)
      5   (os.exit 1))
      6 
      7 (macro with-popen [[handle command] & body]
      8   `(let [,handle (assert (io.popen ,command))
      9          val# (do ,(unpack body))]
     10     (case (: ,handle :close)
     11       ok# val#
     12       (nil :exit code#) (fail (.. ,command " exited "  code#))
     13       (nil :signal sig#) (fail (.. ,command " killed by " sig#)))))
     14 
     15 (fn popen [command]
     16   (with-popen [fh command] (icollect [v (fh:lines)] v)))
     17 
     18 (fn controlled-services [dir]
     19   (case (opendir dir)   ;; FIXME [nit] doesn't closedir
     20     d (collect [filename #(readdir d)]
     21         (if (not (string.match filename "^%."))
     22             (values filename filename)))
     23     (nil err) (fail (.. "can't open " dir " :" err))))
     24 
     25 (fn stopped-controlled-services [dir]
     26   (let [controlled (controlled-services dir)]
     27     (with-popen [h (.. "s6-rc -b -da list")]
     28       (collect [s (h:lines)]
     29         (if (. controlled s) (values s s))))))
     30 
     31 (fn dependencies [service]
     32   (popen (.. "s6-rc-db all-dependencies " service)))
     33 
     34 (fn reverse-dependencies [service]
     35   (popen (.. "s6-rc-db -d all-dependencies " service)))
     36 
     37 (fn start-service [name]
     38   (with-popen [h (.. "s6-rc -b -u change " name)]
     39     (print (h:read "*a"))))
     40 
     41 (fn keys [t]
     42   (icollect [_ v (pairs t)] v))
     43 
     44 (fn run [dir]
     45   (let [service (. arg 1)
     46         blocks (doto
     47                    (stopped-controlled-services (or dir "/run/services/controlled"))
     48                  (tset service nil))
     49         rdepends (reverse-dependencies service)
     50         starts
     51         (icollect [_ s (ipairs rdepends)]
     52           (when
     53               (accumulate [start true
     54                            _ dep (ipairs (dependencies s))]
     55                 (and start (not (. blocks dep))))
     56             s))]
     57     (print "s6-rc-up-tree"
     58            service
     59            "blocks (" (table.concat (keys blocks) ", ") ")"
     60            ;; "rdepends (" (table.concat rdepends ", ") ")"
     61            "start (" (table.concat  starts ", ") ")")
     62     (if (> (# starts) 0)
     63         (each [_ s (ipairs starts)]
     64           (start-service s))
     65         (os.exit 1))))
     66 
     67 
     68 { : run }