commit 2e8e05f31abab5de2ca746525be7ab9a0b2b3fbd
parent 143137cbc663110c837992794066e5f84d682e88
Author: Daniel Barlow <dan@telent.net>
Date: Wed, 3 Jul 2024 23:35:33 +0100
wip: rewrite s6-rc-up-tree in an actual procgramming language
and write some tests for it, too
Diffstat:
10 files changed, 178 insertions(+), 2 deletions(-)
diff --git a/pkgs/s6-rc-up-tree/default.nix b/pkgs/s6-rc-up-tree/default.nix
@@ -1,4 +1,54 @@
{
- writeAshScriptBin
+ lualinux,
+ writeFennel,
+ anoia,
+ fennel,
+ stdenv,
+ fennelrepl,
}:
-writeAshScriptBin "s6-rc-up-tree" {} (builtins.readFile ./s6-rc-up-tree.sh)
+stdenv.mkDerivation {
+ name = "s6-rc-up-tree";
+ src = ./.;
+ nativeBuildInputs = [ fennelrepl ];
+ # propagatedBuildInputs = [ s6-rc-up-tree ];
+ installPhase = ''
+ mkdir -p $out/bin
+ cp -p ${writeFennel "s6-rc-up-tree" {
+ packages = [fennel
+ # anoia nellie
+ lualinux ] ;
+ mainFunction = "run";
+ } ./s6-rc-up-tree.fnl } $out/bin/s6-rc-up-tree
+ '';
+ postBuild = ''
+ export PATH=./scripts:$PATH
+ patchShebangs ./scripts
+ export TEST_LOG=./log
+ fail(){ cat $TEST_LOG | od -c; exit 1; }
+ expect(){
+ test "$(echo $(cat $TEST_LOG))" = "$@" || fail;
+ }
+ # given a service with no rdepends, starts only that service
+ fennelrepl ./test.fnl ${./test-services} turmeric
+ expect "turmeric"
+
+ # given a controlled service with no rdepends, starts only that service
+ fennelrepl ./test.fnl ${./test-services} wombat
+ expect "wombat"
+
+ # uncontrolled rdepends start
+ fennelrepl ./test.fnl ${./test-services} thyme
+ expect "thyme rosemary"
+
+ # stopped controlled rdepends don't start
+ fennelrepl ./test.fnl ${./test-services} enables-wan
+ expect "enables-wan" # not wattle, even though it depends
+
+ # started controlled rdepends are running, so starting them is harmless
+
+ # descendants which depend on a _different_ controlled service, which is down, don't start
+
+ # descendants which depend on a _different_ controlled service, which is up, do start
+
+ '';
+}
diff --git a/pkgs/s6-rc-up-tree/s6-rc-db b/pkgs/s6-rc-up-tree/s6-rc-db
@@ -0,0 +1,8 @@
+#!/usr/bin/env sh
+
+cat << DEPS
+one
+two
+three
+four
+DEPS
diff --git a/pkgs/s6-rc-up-tree/s6-rc-up-tree.fnl b/pkgs/s6-rc-up-tree/s6-rc-up-tree.fnl
@@ -0,0 +1,58 @@
+(local { : opendir : readdir } (require :lualinux))
+(local { : view } (require :fennel))
+
+(fn fail [err]
+ (print "ERROR" err)
+ (os.exit 1))
+
+(macro with-popen [[handle command] & body]
+ `(let [,handle (assert (io.popen ,command))
+ val# (do ,(unpack body))]
+ (case (: ,handle :close)
+ ok# val#
+ (nil :exit code#) (fail (.. ,command " exited " code#))
+ (nil :signal sig#) (fail (.. ,command " killed by " sig#)))))
+
+(fn popen [command]
+ (with-popen [fh command] (icollect [v (fh:lines)] v)))
+
+(fn controlled-services [dir]
+ (case (opendir dir) ;; FIXME [nit] doesn't closedir
+ d (collect [filename #(readdir d)]
+ (if (not (string.match filename "^%."))
+ (values filename filename)))
+ (nil err) (fail (.. "can't open " dir " :" err))))
+
+(fn stopped-services []
+ (popen (.. "s6-rc -da list")))
+
+(fn stopped-controlled-services [dir]
+ (let [controlled (controlled-services dir)]
+ (with-popen [h (.. "s6-rc -da list")]
+ (collect [s (h:lines)]
+ (if (. controlled s) (values s s))))))
+
+(fn dependencies [service]
+ (popen (.. "s6-rc-db all-dependencies " service)))
+
+(fn reverse-dependencies [service]
+ (popen (.. "s6-rc-db -d all-dependencies " service)))
+
+(fn start-service [name]
+ (case (os.execute (.. "s6-rc -u change " name))
+ (ok) nil
+ (nil err) (fail err)))
+
+(fn run [dir]
+ (let [service (. arg 1)
+ blocks (stopped-controlled-services (or dir "/run/services/controlled"))]
+ (print :service service :blocks (view blocks))
+ (each [_ s (ipairs (reverse-dependencies service))]
+ (print :dep s)
+ (when
+ (accumulate [start true
+ _ dep (ipairs (dependencies s))]
+ (and start (or (= s service) (not (. blocks dep)))))
+ (start-service s)))))
+
+{ : run }
diff --git a/pkgs/s6-rc-up-tree/scripts/s6-rc b/pkgs/s6-rc-up-tree/scripts/s6-rc
@@ -0,0 +1,15 @@
+#!/usr/bin/env sh
+
+echo s6-rc $@
+if [ "$1" = "-da" ]; then
+ if [ "$2" = "list" ]; then
+ echo wattle # controlled
+ echo wombat # controlled
+ echo turmeric # uncontrolled
+ fi
+fi
+if [ "$1" = "-u" ]; then
+ if [ "$2" = "change" ]; then
+ echo "$3" >> $TEST_LOG
+ fi
+fi
diff --git a/pkgs/s6-rc-up-tree/scripts/s6-rc-db b/pkgs/s6-rc-up-tree/scripts/s6-rc-db
@@ -0,0 +1,31 @@
+#!/usr/bin/env sh
+
+reverse_deps(){
+ echo $1
+ case "$1" in
+ thyme)
+ echo rosemary
+ ;;
+ enables-wan)
+ echo wattle # controlled
+ ;;
+ esac
+}
+
+deps(){
+ echo $1
+ case "$1" in
+ rosemary)
+ echo thyme;;
+ *)
+ ;;
+ esac
+}
+
+if test "$1" = "-d" && test "$2" = "all-dependencies"; then
+ shift; shift;
+ reverse_deps $@
+elif test "$1" = "all-dependencies"; then
+ shift;
+ deps $@
+fi
diff --git a/pkgs/s6-rc-up-tree/test-services/daub b/pkgs/s6-rc-up-tree/test-services/daub
diff --git a/pkgs/s6-rc-up-tree/test-services/wan-proxy b/pkgs/s6-rc-up-tree/test-services/wan-proxy
diff --git a/pkgs/s6-rc-up-tree/test-services/wattle b/pkgs/s6-rc-up-tree/test-services/wattle
diff --git a/pkgs/s6-rc-up-tree/test-services/wombat b/pkgs/s6-rc-up-tree/test-services/wombat
diff --git a/pkgs/s6-rc-up-tree/test.fnl b/pkgs/s6-rc-up-tree/test.fnl
@@ -0,0 +1,14 @@
+(local up-tree (require "s6-rc-up-tree"))
+
+(os.remove (os.getenv "TEST_LOG"))
+
+(let [[dir & services] arg]
+ (set arg services)
+ (up-tree.run dir))
+
+;; the service starts
+;; the service starts even if it is controlled
+;; uncontrolled descendants start
+;; controlled descendants don't start
+;; descendants which depend on a _different_ controlled service, which is down, don't start
+;; descendants which depend on a _different_ controlled service, which is up, do start
