wip: rewrite s6-rc-up-tree in an actual procgramming language

and write some tests for it, too

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
+
+  '';
+}

pkgs/s6-rc-up-tree/s6-rc-db

@@ -0,0 +1,8 @@
+#!/usr/bin/env sh
+
+cat << DEPS
+one
+two
+three
+four
+DEPS

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 }

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

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

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