use round-robin failiover in l2tp example

for values of "fix" more than slightly reminiscent of "kludge"

THOUGHTS.txt

@@ -5161,3 +5161,215 @@ for s in $(s6-rc-db -d all-dependencies $service); do
     esac
   done
 done
+
+Sun Jun 16 23:13:53 BST 2024
+
+what we are trying to do is set up an l2tp by hostname
+
+1) this means looking up the hostname in the dns
+2) this means having a route to the dns server
+3) this means parsing the space-separated list of dns servers
+  provided by dhcp
+
+we could write the servers each into their own file, but that
+helps less than you'd think unless we give those files predictable
+names
+
+Thu Jun 20 10:16:52 BST 2024
+
+now we have l2tp-over-wwan, we need to do the failover mechanism
+
+- can't have both l2tp and pppoe running at once (at least for aaisp)
+  because same creds used for both and starting l2tp will cause them
+  to route all traffic to the l2tp instead of the FTTx
+
+- we could have the wwan stick permanently configured and ready to go,
+  as long as we're not actvely using it unless the main connection is
+  b0rked
+
+- can we have the same odhcp stuff running and point it to either?
+  maybe renaming the wan interface would be an easy-ish way to do this
+
+we need some kind of health check on the main connection that will
+bring up the backup if e.g. packet loss over x%. Or is lcp echo good
+enough here? for multipath to the same backhaul, if some weird routing
+cockup makes google unavailable from the main connection it will most
+likely also be unavailable from the backup, so lcp echo is arguably better
+
+
+on a side note, use of shell functions to get the output from another
+service is a bit icky
+
+Fri Jun 21 21:05:21 BST 2024
+
+We can have a controller with two controlled services, which runs the
+second one when the first one isn't working.
+
+how do we connect the dependent services (dhcp pd, defaultroute, anything
+else dependent on wan) to the correct upstream?
+
+we can't use bundles because bundles just flatten to atomic services, there's
+no either/or there
+
+controller
+  - main service
+  - backup service
+  - proxy service
+
+The proxy service is running when one of the main or backup services is
+up.  It provides all the outputs of whichever backend service is active
+
+https://skarnet.org/software/s6/s6-svwait.html
+
+proxy could use "s6-svwait -U -o main backup" to wait for one of the two
+backend services, provded that both are longruns
+
+so in the controller we start main-service, and if/when that fails start
+backup-service. we run proxy-service if any of the backend services is
+running, and use its outputs to indicate which.
+
+the proxy could just symlink to the backing service outputs directory,
+or it could copy and translate if the main and backup services have
+different outputs, so that it presents a common interface. I'm not
+sure proxy is the best name but I haven't thought of a better.
+
+we can do a manual switch back to main-service by restarting the
+controller.  we could do an automatic switch by adding logic to the
+controller to make it restart itself.
+
+perhaps the controller has an output that indicates which backend is
+active, then the proxy just needs to look at that to figure which one to
+use.
+
+while true; do
+  if s6-rc -u change $primary; then # will wait until succeeded, or exit 1 if timeout
+    ln -sf $primary outputs/active
+    s6-rc -u change $proxy
+  elif s6-rc -u change $secondary;  then
+    ln -sf $secondary outputs/active
+    s6-rc -u change $proxy
+  else
+    rm outputs/active
+    s6-rc -d change $proxy
+  fi
+  # wait for the backend to die (down cleanup will
+  # remove outputs directory)
+  while test -d outputs/active/.outputs
+    inotifywait outputs/active/.outputs
+  fi
+  rm outputs/active
+  s6-rc -d change $proxy
+end
+
+this script will when when primary dies, attempt to start primary: if
+it doesn't come up, start secondary
+
+if the primary comes up and then goes down later, we'll start it
+again - which isn't what we want. When the primary dies, we
+want to try the secondary next
+
+backends="primary secondary tertiary etc"
+rest=$backends
+while true ; do
+  first="${rest%% *}"
+  rest="${backends#* }"
+  if test -n "$first"; then
+    if s6-rc -u change $first; then
+      ln -sf $first outputs/active
+      s6-rc -u change $proxy
+
+      while test -d outputs/active/.outputs
+	inotifywait outputs/active/.outputs
+      fi
+    fi
+    rm outputs/active
+    s6-rc -d change $proxy
+  else
+    rest=$backends
+  fi
+done
+
+in this version when the secondary dies then we try the third backend
+(round-robin). are there circumstances where we'd rather retry the primary?
+Presumably there are circumstances where we would _not_ rather
+retry the primary, otherwise why are we even providing a tertiary?
+If we could answer that question then we'd know.
+
+
+Mon Jun 24 21:22:34 BST 2024
+
+the controller needs to know the names of its backends, which is ugly
+if they're computed names because we can't define the services themselves
+first without their references to the controller
+
+mutual recursion ... maybe it's time to understand how this fixpoint
+thing works
+
+Wed Jun 26 22:16:25 BST 2024
+
+s6 will restart the pppoe service when it dies, and keep doing this
+indefinitely - unless the ./finish script returns 125. Note that this
+is only true for longruns, but it's not as though oneshots can die
+anyway as there's no process to fail.
+
+Sat Jun 29 21:43:10 BST 2024
+
+> s6-supervise says it restarts the supervised process when it exits
+  "unless told not to"; however s6-rc talks about "failed
+  transitions": if a s6-rc service doesn't signal readiness before
+  timeout-up expires, it is stopped and won't be restarted.  I *think*
+  the behaviour I am observing is that ./run may be invoked several
+  times if it dies without ever signalling readiness, and then it's
+  killed when the timeout is exceeded
+
+
+... so ... that's OK, probably. pppoe will stop running after n
+lcp-echoes time out
+
+----
+
+inotifywait apparently requires c++ and libgcc and transitively the
+kitchen sink, which is a bit silly as we have linotify in lua. So
+we should replace the failover scripty thing with a lua program
+
+(table.concat rdepends ", ")
+
+
+Fri Jul  5 21:21:18 BST 2024
+
+
+1970-01-01 00:01:00.797696621 wan-switcher      blocks (        modem-modeswitch, modem-atz, wan.link.pppoe, 194.4.172.12.l2tp, wan-proxy     )       rdepends (      194.4.172.12.l2tp       )       start ( 194.4.172.12.l2tp       )
+
+
+why is it starting l2tp when it should depend on having a route to the
+l2tp server
+
+Sat Jul  6 14:24:26 BST 2024
+
+The logic for up-tree is not correct, as it assumes that the
+requested service is itself ready to start (so excludes it from
+the blocked list). If the requested service is dependent on
+some other block, it should not be started.
+
+[ I am confused. Isn't this what happens already? ]
+
+
+@40000000000000441b51b24c wan-switcher  blocks (        modem-atz, modem-modeswitch, 194.4.172.12.l2tp, wan.link.pppoe, wan-proxy     )       rdepends (      194.4.172.12.l2tp       )       start ( 194.4.172.12.l2tp       )
+
+
+# s6-rc-db all-dependencies  194.4.172.12.l2tp
+route-05029a9e8e2c-ee8d76f34e9c
+hostname
+modem-atz
+modem-modeswitch
+wwan0.link
+check-lns-address
+resolve-l2tp-server
+controlled
+route-07d8f171cb5a-ee8d76f34e9c
+wwan0.link.dhcpc
+wwan0.link.dhcpc-log
+194.4.172.12.l2tp-log
+194.4.172.12.l2tp
+s6rc-fdholder
+s6rc-oneshot-runner

devices/gl-ar750/default.nix

@@ -126,11 +126,11 @@
           in {
             lan = link.build {
               ifname = "lan";
-              devpath = "/devices/platform/ahb/19000000.eth";
+              devpath = "/devices/platform/ahb/1a000000.eth";
             };
             wan = link.build {
               ifname = "wan";
-              devpath = "/devices/platform/ahb/1a000000.eth";
+              devpath = "/devices/platform/ahb/19000000.eth";
             };
             wlan = link.build {
               ifname = "wlan0";

examples/l2tp.nix

@@ -26,7 +26,7 @@
 
   lns = { hostname = "l2tp.aaisp.net.uk"; address = "194.4.172.12"; };
 
-  inherit (pkgs.liminix.services) oneshot target;
+  inherit (pkgs.liminix.services) oneshot longrun target;
   inherit (pkgs.pseudofile) dir symlink;
   inherit (pkgs) serviceFns;
   svc = config.system.service;
@@ -57,21 +57,76 @@ in rec {
     authType = "chap";
   };
 
-  services.dhcpc = svc.network.dhcp.client.build {
-    interface = config.services.wwan;
-    dependencies = [ config.services.hostname ];
-  };
+  services.wan =
+    let
+      z = final : prev: {
+        controller = longrun rec {
+          name = "wan-switcher";
+          run = ''
+            in_outputs ${name}
+            exec ${pkgs.s6-rc-round-robin}/bin/s6-rc-round-robin \
+               -p ${final.proxy.name} \
+               ${lib.concatStringsSep " "
+                 (builtins.map (f: f.name) [final.pppoe final.l2tp])}
+          '';
+        };
+        pppoe = (svc.pppoe.build {
+          interface = config.hardware.networkInterfaces.wan;
+
+          ppp-options = [
+            "debug" "+ipv6" "noauth"
+            "name" rsecrets.l2tp.name
+            "password" rsecrets.l2tp.password
+          ];
+        }).overrideAttrs(o: { inherit (final) controller; });
+
+        l2tp =
+          let
+            check-address = oneshot rec {
+              name = "check-lns-address";
+              up = "grep -Fx ${ lns.address} $(output_path ${services.lns-address} addresses)";
+              dependencies = [ services.lns-address ];
+            };
+            route = svc.network.route.build {
+              via = "$(output ${services.dhcpc} router)";
+              target = lns.address;
+              dependencies = [services.dhcpc check-address];
+            };
+          in (svc.l2tp.build {
+            lns = lns.address;
+            ppp-options = [
+              "debug" "+ipv6" "noauth"
+              "name" rsecrets.l2tp.name
+              "connect-delay" "5000"
+              "password" rsecrets.l2tp.password
+            ];
+            dependencies = [config.services.lns-address route check-address];
+          }).overrideAttrs(o: { inherit (final) controller; });
+        proxy = oneshot rec {
+          name = "wan-proxy";
+          inherit (final) controller;
+          buildInputs = with final; [ pppoe l2tp];
+          up = ''
+            echo start proxy ${name}
+            set -x
+            (in_outputs ${name}
+             cp -rv $(output_path ${final.controller} active)/* .
+            )
+          '';
+        };
+      };
+    in (lib.fix (lib.extends z (prev : { }))).proxy;
 
   services.sshd = svc.ssh.build { };
 
   services.resolvconf = oneshot rec {
-    dependencies = [ services.l2tp ];
+    dependencies = [ services.wan ];
     name = "resolvconf";
     up = ''
       . ${serviceFns}
        ( in_outputs ${name}
         for i in ns1 ns2 ; do
-          ns=$(output ${services.l2tp} $i)
+          ns=$(output ${services.wan} $i)
           echo "nameserver $ns" >> resolv.conf
         done
        )
@@ -83,6 +138,11 @@ in rec {
     };
   };
 
+  services.dhcpc = svc.network.dhcp.client.build {
+    interface = config.services.wwan;
+    dependencies = [ config.services.hostname ];
+  };
+
   services.lns-address = let
     ns = "$(output_word ${services.dhcpc} dns 1)";
     route-to-bootstrap-nameserver = svc.network.route.build {
@@ -101,35 +161,10 @@ in rec {
     '';
   };
 
-  services.l2tp =
-    let
-      check-address = oneshot rec {
-        name = "check-lns-address";
-        up = ''
-          grep -Fx ${lns.address} $(output_path ${services.lns-address} addresses)
-        '';
-        dependencies = [ services.lns-address ];
-      };
-      route = svc.network.route.build {
-        via = "$(output ${services.dhcpc} router)";
-        target = lns.address;
-        dependencies = [services.dhcpc check-address];
-      };
-    in svc.l2tp.build {
-      lns = lns.address;
-      ppp-options = [
-        "debug" "+ipv6" "noauth"
-        "name" rsecrets.l2tp.name
-        "connect-delay" "5000"
-        "password" rsecrets.l2tp.password
-      ];
-      dependencies = [config.services.lns-address route check-address];
-  };
-
   services.defaultroute4 = svc.network.route.build {
-    via = "$(output ${services.l2tp} peer-address)";
+    via = "$(output ${services.wan} peer-address)";
     target = "default";
-    dependencies = [services.l2tp];
+    dependencies = [services.wan];
   };
 
 #  defaultProfile.packages = [ pkgs.go-l2tp ];
@@ -138,4 +173,9 @@ in rec {
     passwd = lib.mkForce secrets.root.passwd;
     openssh.authorizedKeys.keys = secrets.root.keys;
   };
+
+  programs.busybox.options = {
+    FEATURE_FANCY_TAIL = "y";
+  };
+
 }

modules/cdc-ncm/wwan.nix

@@ -41,7 +41,10 @@ let
   };
   atz = oneshot rec {
     name = "modem-atz";
-    dependencies = [ modeswitch ];
+    # atz does not depend on modeswitch because modeswitch service
+    # is only running when the stick is in the wrong mode
+    dependencies = [ modeswitch.controller ];
+    buildInputs = [ modeswitch ];
     controller = (svc.uevent-rule.build {
       serviceName = name;
       terms = {

modules/ppp/l2tp.nix

@@ -8,6 +8,8 @@
 { lns, ppp-options }:
 let
   inherit (liminix.services) longrun;
+  lcp-echo-interval = 4;
+  lcp-echo-failure = 3;
   name = "${lns}.l2tp";
   ip-up = writeAshScript "ip-up" {} ''
     . ${serviceFns} 
@@ -36,6 +38,8 @@ let
     "ipparam" name
     "nodetach"
     "usepeerdns"
+    "lcp-echo-interval" (builtins.toString lcp-echo-interval)
+    "lcp-echo-failure" (builtins.toString lcp-echo-failure)
     "logfd" "2"
   ];
   conf = writeText "xl2tpd.conf" ''
@@ -45,6 +49,8 @@ let
     pppoptfile = ${writeText "ppp-options" ppp-options'}
     autodial = yes
     redial = yes
+    redial timeout = 1
+    max redials = 2 # this gives 1 actual retry, as xl2tpd can't count
   '';
   control = "/run/xl2tpd/control-${name}";
 in
@@ -53,6 +59,7 @@ longrun {
   run = ''
     mkdir -p /run/xl2tpd
     touch ${control}
+    in_outputs $name
     exec ${xl2tpd}/bin/xl2tpd -D -p /run/xl2tpd/${name}.pid -c ${conf} -C ${control} 
   '';
   notification-fd = 10;

modules/ppp/pppoe.nix

@@ -9,6 +9,8 @@
 { interface, ppp-options }:
 let
   inherit (liminix.services) longrun;
+  lcp-echo-interval = 4;
+  lcp-echo-failure = 3;
   name = "${interface.name}.pppoe";
   ip-up = writeAshScript "ip-up" {} ''
     . ${serviceFns} 
@@ -37,15 +39,19 @@ let
     "ipparam" name
     "nodetach"
     "usepeerdns"
+    "lcp-echo-interval" (builtins.toString lcp-echo-interval)
+    "lcp-echo-failure" (builtins.toString lcp-echo-failure)
     "logfd" "2"
   ];
 in
 longrun {
   inherit name;
   run = ''
-    . ${serviceFns} 
-    ${ppp}/bin/pppd pty "${pppoe}/bin/pppoe -I $(output ${interface} ifname)" ${lib.concatStringsSep " " ppp-options'}
+    . ${serviceFns}
+    echo Starting pppoe, pppd pid is $$
+    exec ${ppp}/bin/pppd pty "${pppoe}/bin/pppoe -T ${builtins.toString (4 * lcp-echo-interval)}  -I $(output ${interface} ifname)" ${lib.concatStringsSep " " ppp-options'}
   '';
   notification-fd = 10;
+  timeout-up = (10 + lcp-echo-failure * lcp-echo-interval) * 1000;
   dependencies = [ interface ];
 }

overlay.nix

@@ -291,4 +291,8 @@ extraPkgs // {
     translateManpages = false;
     capabilitiesSupport = false;
   };
+
+  xl2tpd = prev.xl2tpd.overrideAttrs(o: {
+    patches = [ ./pkgs/xl2tpd-exit-on-close.patch ];
+  });
 }

pkgs/default.nix

@@ -95,6 +95,7 @@ in {
   run-liminix-vm = callPackage ./run-liminix-vm { };
   s6-init-bin = callPackage ./s6-init-bin { };
   s6-rc-database = callPackage ./s6-rc-database { };
+  s6-rc-round-robin = callPackage ./s6-rc-round-robin { };
   s6-rc-up-tree = callPackage ./s6-rc-up-tree { };
 
   # schnapps is written by Turris and provides a high-level interface

pkgs/s6-rc-round-robin/default.nix

@@ -0,0 +1,21 @@
+{
+  lualinux,
+  writeFennel,
+  anoia,
+  linotify,
+  fennel,
+  stdenv,
+  s6-rc-up-tree,
+}:
+stdenv.mkDerivation {
+  name = "s6-rc-round-robin";
+  src = ./.;
+  propagatedBuildInputs = [ s6-rc-up-tree ];
+  installPhase = ''
+    mkdir -p $out/bin
+    cp -p ${writeFennel "uevent-watch" {
+      packages = [fennel anoia linotify lualinux s6-rc-up-tree] ;
+      mainFunction = "run";
+    } ./robin.fnl} $out/bin/s6-rc-round-robin
+  '';
+}

pkgs/s6-rc-round-robin/robin.fnl

@@ -0,0 +1,59 @@
+(local { : directory? : symlink } (require :anoia.fs))
+(local { : assoc : system } (require :anoia))
+(local inotify (require :inotify))
+
+(fn parse-args [args]
+  (match args
+    ["-p" proxy & rest] (assoc (parse-args rest) :proxy proxy)
+    backends { : backends }
+    _  nil))
+
+(fn %% [fmt ...] (string.format fmt ...))
+
+(fn start-service [service]
+  (let [(ok msg) (pcall system (%% "s6-rc-up-tree %q" service))]
+    (when (not ok) (print msg))
+    ok))
+
+(fn stop-service [service]
+  (let [(ok msg) (pcall system (%% "s6-rc -b -d change %q" service))]
+    (when (not ok) (print msg))
+    ok))
+
+(fn watch-fsevents [directory-name]
+  (doto (inotify.init)
+    (: :addwatch directory-name
+       inotify.IN_CREATE
+       inotify.IN_MOVE
+       inotify.IN_DELETE
+       inotify.IN_DELETE_SELF
+       inotify.IN_MOVED_FROM
+       inotify.IN_MOVED_TO
+       inotify.IN_CLOSE_WRITE)))
+
+(fn round-robin [els]
+  (var i -1)
+  (fn []
+    (set i (% (+ 1 i) (# els)))
+    (. els (+ 1 i))))
+
+(fn run []
+  (let [{ : proxy : backends } (parse-args arg)]
+    (each [s (round-robin backends)]
+      (print "ROBIN starting " s)
+      (when (start-service s)
+        (let [outputs-dir (.. "/run/services/outputs/" s)]
+          (print "ROBIN started " s "expecting outputs in " outputs-dir)
+          (with-open [watcher (watch-fsevents outputs-dir)]
+            (symlink outputs-dir "active")
+            (start-service proxy)
+            (while (directory? outputs-dir)
+              (print :ROBIN (watcher:read))))))
+      ;; service failed to start, or started and finished
+      (print "ROBIN finished " s "stopping proxy")
+      (stop-service proxy)
+      (stop-service s)
+      (os.remove "active")
+      )))
+
+{ : run }

pkgs/s6-rc-up-tree/default.nix

@@ -1,4 +1,64 @@
 {
-  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:
+    # Given:
+    #  - modeswitch is controlled
+    #  - atz is controlled
+    #  - atz => modeswitch
+    #  - ifconfig => atz
+    # Then: if atz is down, ifconfig should not start when modeswitch is started
+    fennelrepl ./test.fnl ${./test-services} modeswitch
+    expect "modeswitch"
+
+    # descendants which depend on a _different_ controlled service, which is up, do start
+    ATZ=up fennelrepl ./test.fnl ${./test-services} modeswitch
+    expect "modeswitch atz ifconfig"
+  '';
+}

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,68 @@
+(local { : opendir : readdir } (require :lualinux))
+
+(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-controlled-services [dir]
+  (let [controlled (controlled-services dir)]
+    (with-popen [h (.. "s6-rc -b -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]
+  (with-popen [h (.. "s6-rc -b -u change " name)]
+    (print (h:read "*a"))))
+
+(fn keys [t]
+  (icollect [_ v (pairs t)] v))
+
+(fn run [dir]
+  (let [service (. arg 1)
+        blocks (doto
+                   (stopped-controlled-services (or dir "/run/services/controlled"))
+                 (tset service nil))
+        rdepends (reverse-dependencies service)
+        starts
+        (icollect [_ s (ipairs rdepends)]
+          (when
+              (accumulate [start true
+                           _ dep (ipairs (dependencies s))]
+                (and start (not (. blocks dep))))
+            s))]
+    (print "s6-rc-up-tree"
+           service
+           "blocks (" (table.concat (keys blocks) ", ") ")"
+           ;; "rdepends (" (table.concat rdepends ", ") ")"
+           "start (" (table.concat  starts ", ") ")")
+    (if (> (# starts) 0)
+        (each [_ s (ipairs starts)]
+          (start-service s))
+        (os.exit 1))))
+
+
+{ : run }

pkgs/s6-rc-up-tree/scripts/s6-rc

@@ -0,0 +1,18 @@
+#!/usr/bin/env sh
+
+echo s6-rc $@
+[ "$1" = "-b" ] && shift
+
+if [ "$1" = "-da" ]; then
+    if [ "$2" = "list" ]; then
+	echo wattle # controlled
+	echo wombat # controlled
+	echo turmeric # uncontrolled
+	test -n "$ATZ" || echo atz # 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,41 @@
+#!/usr/bin/env sh
+
+reverse_deps(){
+    echo $1
+    case "$1" in
+	thyme)
+	    echo rosemary
+	    ;;
+	enables-wan)
+	    echo wattle # controlled
+	    ;;
+	modeswitch)
+	    reverse_deps atz
+	    ;;
+	atz)
+	    echo ifconfig
+	    ;;
+    esac
+}
+
+deps(){
+    echo $1
+    case "$1" in
+	rosemary)
+	    echo thyme;;
+	wattle)
+	    echo enables-wan;;
+	atz)
+	    echo modeswitch;;
+	ifconfig)
+	    deps atz;;
+    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

pkgs/write-fennel/default.nix

@@ -28,6 +28,7 @@ stdenv.mkDerivation {
      echo "package.path = ${lib.strings.escapeShellArg (builtins.concatStringsSep "" luapath)} .. package.path"
      echo "package.cpath = ${lib.strings.escapeShellArg (builtins.concatStringsSep "" luacpath)} .. package.cpath"
      echo "local ok, stdlib = pcall(require,'posix.stdlib'); if ok then stdlib.setenv('PATH',${lib.escapeShellArg (lib.makeBinPath packages)} .. \":\" .. os.getenv('PATH')) end"
+     echo "local ok, ll = pcall(require,'lualinux'); if ok then ll.setenv('PATH',${lib.escapeShellArg (lib.makeBinPath packages)} .. \":\" .. os.getenv('PATH')) end"
      fennel ${if correlate then "--correlate" else ""} --compile ${source}
     ) >  ${name}.lua
   '';

pkgs/xl2tpd-exit-on-close.patch

@@ -0,0 +1,55 @@
+diff --git a/xl2tpd.c b/xl2tpd.c
+index 791d5a4..1382b68 100644
+--- a/xl2tpd.c
++++ b/xl2tpd.c
+@@ -814,6 +814,33 @@ static struct call *lac_call (int tid, struct lac *lac, struct lns *lns)
+     return NULL;
+ }
+ 
++void terminate_if_no_active(void * _unused)
++{
++    l2tp_log (LOG_WARNING, "%s : is anything still happening?\n", __FUNCTION__);
++
++    struct lac *lac = (struct lac *) laclist;
++    while(lac) {
++	l2tp_log (LOG_INFO, "%s : lac %s active %s\n", __FUNCTION__,
++		  lac->entname, (lac->active  ? "yes" : "no"));
++	if(lac->active)
++	    return;
++	lac = lac->next;
++    }
++
++    struct lns *lns = (struct lns *) lnslist;
++    while(lns) {
++	l2tp_log (LOG_INFO, "%s : lns %s active %s\n", __FUNCTION__,
++		  lns->entname, (lns->active  ? "yes" : "no"));
++	if(lns->active)
++	    return;
++	lns = lns->next;
++    }
++
++    l2tp_log (LOG_WARNING, "%s : apparently nothing\n", __FUNCTION__);
++
++    death_handler(SIGTERM);
++}
++
+ void magic_lac_dial (void *data)
+ {
+     struct lac *lac;
+@@ -832,7 +859,15 @@ void magic_lac_dial (void *data)
+     lac->rtries++;
+     if (lac->rmax && (lac->rtries > lac->rmax))
+     {
+-        l2tp_log (LOG_INFO, "%s: maximum retries exceeded.\n", __FUNCTION__);
++        struct timeval tv;
++
++        l2tp_log (LOG_INFO, "%s: maximum retries exceeded %d/%d.\n",
++		  __FUNCTION__, lac->rtries , lac->rmax);
++	lac->active = 0;
++        tv.tv_sec = 0;
++        tv.tv_usec = 100;
++	schedule (tv, &terminate_if_no_active, NULL);
++
+         return;
+     }
+     if (!lac->t)