fennel: extract some common functions into a shareable module

Runs fennel using a Lua compiled with the same options as the
host system, and with packages set up so it can find all the local
Lua packages

To shorten the dev feedback loop further, allows FENNEL_PATH to be set
on the command line so you can point directly it at the Fennel sources
for some library you're working against instead of having to run
nix-build and compile them to Lua

default.nix

@@ -58,6 +58,7 @@ in {
       borderVm.build.vm
       go-l2tp
       min-copy-closure
+      fennelrepl
     ];
   };
 }

examples/acquire-delegated-prefix.fnl

@@ -1,5 +1,25 @@
-
 (local inotify (require :inotify))
+(local { : merge : split : file-exists? : system } (require :anoia))
+
+(fn parse-prefix [str]
+  (fn parse-extra [s]
+    (let [out {}]
+      (each [name val (string.gmatch s ",(.-)=([^,]+)")]
+        (tset out name val))
+      out))
+  (let [(prefix len preferred valid extra)
+        (string.match str "(.-)::/(%d+),(%d+),(%d+)(.*)$")]
+    (merge {: prefix : len : preferred : valid} (parse-extra extra))))
+
+
+;; Format: <prefix>/<length>,preferred,valid[,excluded=<excluded-prefix>/<length>][,class=<prefix class #>]
+
+;;(parse-prefix "2001:8b0:de3a:40dc::/64,7198,7198")
+;;(parse-prefix "2001:8b0:de3a:1001::/64,7198,7188,excluded=1/2,thi=10")
+
+(fn read-line [name]
+  (with-open [f (assert (io.open name :r) (.. "can't open file " name))]
+    (f:read "*l")))
 
 (fn watch-fsevents [directory-name]
   (let [handle (inotify.init)]
@@ -13,58 +33,53 @@
                      inotify.IN_CLOSE_WRITE)
     handle))
 
+(fn watch-directory [pathname]
+  (let [watcher (watch-fsevents pathname)]
+    {
+     :has-file? (fn [_ filename] (file-exists? (.. pathname "/" filename)))
+     :wait-events (fn [] (watcher:read))
+     :ready? (fn [self]
+               (and (self:has-file? "state") (not (self:has-file? ".lock"))))
+     :read-line (fn [_ filename] (read-line (.. pathname "/" filename)))
+     :close #(watcher:close)
+     }))
 
-(fn merge [table1 table2]
-  (collect [k v (pairs table2) &into table1]
-    k v))
+(local bound-states
+       { :bound true
+         :rebound true
+         :informed true
+         :updated true
+         :ra-updated true
+         })
 
-(fn parse-extra [s]
-  (let [out {}]
-    (each [name val (string.gmatch s ",(.-)=([^,]+)")]
-      (tset out name val))
-    out))
+; (local { : view } (require :fennel))
 
-(fn parse-prefixes [prefixes]
-  (icollect [val (string.gmatch prefixes "([^ ]+)")]
-    (let [(prefix len preferred valid extra)
-          (string.match val "(.-)::/(%d+),(%d+),(%d+)(.*)$")]
-      (merge {: prefix : len : preferred : valid} (parse-extra extra))
-      )))
-
-;; Format: <prefix>/<length>,preferred,valid[,excluded=<excluded-prefix>/<length>][,class=<prefix class #>]
-
-;; (parse-prefixes "2001:8b0:de3a:40dc::/64,7198,7198 2001:8b0:de3a:1001::/64,7198,7188,excluded=1/2,thi=10")
-
-
-(fn file-exists? [name]
-  (match (io.open name :r)
-    f (do (f:close) true)
-    _ false))
-
-
-(fn read-line [name]
-  (with-open [f (assert (io.open name :r) (.. "can't open file " name))]
-    (f:read "*l")))
-
-(var last-update 0)
-(fn event-time [directory]
-  (if (file-exists? (.. directory "/state"))
-      (tonumber (read-line (.. directory "/last-update")))
-      nil))
-
-(fn wait-for-update [directory fsevents]
-  (while (<= (or (event-time directory) 0) last-update)
-    (fsevents:read))
-  (set last-update (event-time directory))
-  true)
+(fn changes [old-prefixes new-prefixes]
+  (let [added {}
+        deleted {}
+        old-set (collect [_ v (ipairs old-prefixes)] (values v true))
+        new-set (collect [_ v (ipairs new-prefixes)] (values v true))]
+    (each [_ prefix (ipairs new-prefixes)]
+      (if (not (. old-set prefix))
+          (table.insert added (parse-prefix prefix))))
+    (each [_ prefix (ipairs old-prefixes)]
+      (if (not (. new-set prefix))
+          (table.insert deleted (parse-prefix prefix))))
+    (values added deleted)))
 
 (let [[state-directory lan-device] arg
-      fsevents (watch-fsevents state-directory)]
-  (while (wait-for-update state-directory fsevents)
-    (match (read-line (.. state-directory "/state"))
-      (where (or :bound :rebound :informed :updated :ra-updated))
-      (let [[{ : prefix : len : preferred : valid }]
-            (parse-prefixes (read-line (.. state-directory  "/prefixes")))]
-        (os.execute (.. "ip address add " prefix "::1/" len
-    		        " dev " lan-device)))
-      _ (os.exit 1))))
+      dir (watch-directory state-directory)]
+  (var prefixes [])
+  (while true
+    (while (not (dir:ready?)) (dir:wait-events))
+    (if (. bound-states (dir:read-line "state"))
+        (let [new-prefixes (split " " (dir:read-line "/prefixes"))
+              (added deleted) (changes prefixes new-prefixes)]
+          (each [_ p (ipairs added)]
+            (system
+             (.. "ip address add " p.prefix "::1/" p.len " dev " lan-device)))
+          (each [_ p (ipairs deleted)]
+            (system
+             (.. "ip address del " p.prefix "::1/" p.len " dev " lan-device)))
+    	  (set prefixes new-prefixes)))
+    (dir:wait-events)))

examples/acquire-delegated-prefix.nix

@@ -1,10 +1,8 @@
 {
   writeFennelScript
-, luaSmall
 , linotify
+, anoia
 }:
 writeFennelScript "acquire-delegated-prefix"
-  [
-    (linotify.override { lua = luaSmall; })
-  ]
+  [ linotify anoia ]
   ./acquire-delegated-prefix.fnl

examples/rotuer.nix

@@ -220,12 +220,20 @@ in rec {
   };
 
   services.defaultroute4 = route {
-    name = "defaultroute";
+    name = "defaultroute4";
     via = "$(output ${services.wan} address)";
     target = "default";
     dependencies = [ services.wan ];
   };
 
+  services.defaultroute6 = route {
+    name = "defaultroute6";
+    via = "$(output ${services.wan} ipv6-peer-address)";
+    target = "default";
+    dev = "$(output ${services.wan} ifname)";
+    dependencies = [ services.wan ];
+  };
+
   services.firewall =
     let
       script= pkgs.firewallgen "firewall.nft" (import ./rotuer-firewall.nix);
@@ -276,18 +284,26 @@ in rec {
   services.dhcp6 =
     let
       name = "dhcp6c.wan";
-      luafile = writeFennelScript "odhcpc-script" [] ./odhcp6-script.fnl;
     in longrun {
       inherit name;
       notification-fd = 10;
       run = ''
         export SERVICE_STATE=/run/service-state/${name}
-        ${pkgs.odhcp6c}/bin/odhcp6c -s ${luafile} -e -v -p /run/${name}.pid -P 48 $(output ${services.wan} ifname)
+        ${pkgs.odhcp6c}/bin/odhcp6c -s ${pkgs.odhcp-script} -e -v -p /run/${name}.pid -P 48 $(output ${services.wan} ifname)
         )
       '';
       dependencies = [ services.wan ];
     };
 
+  services.set-wan-address =
+    oneshot {
+      name = "set-wan-address";
+      # FIXME nasty bit of hardcoding - should get this from  dhcp6c
+      up = "ip address add 2001:8b0:1111:1111:0:ffff:51bb:4cf2/128 dev ppp0";
+      down = "ip address del 2001:8b0:1111:1111:0:ffff:51bb:4cf2/128 dev ppp0";
+      dependencies = [ services.dhcp6 ];
+    };
+
   services.acquire-lan-prefix =
     let script = pkgs.callPackage ./acquire-delegated-prefix.nix {  };
     in longrun {
@@ -307,6 +323,7 @@ in rec {
       hostap5
       ntp
       defaultroute4
+      defaultroute6
       packet_forwarding
       dns
       resolvconf
@@ -314,6 +331,7 @@ in rec {
       config.services.hostname
       dhcp6
       acquire-lan-prefix
+      set-wan-address
     ];
   };
   defaultProfile.packages = with pkgs; [

modules/busybox.nix

@@ -72,6 +72,7 @@ in {
         FEATURE_EDITING_MAX_LEN = "1024";
         FEATURE_TAB_COMPLETION = "y";
         FEATURE_EDITING_WINCH = "y";
+        FEATURE_IPV6 = "y";
       };
     };
     filesystem = dir {

overlay.nix

@@ -39,6 +39,7 @@ let
         (if o ? patches then o.patches else []) ++
         (if patch_needed then [ patch ] else []);
     });
+  lua = let s = lua_no_readline.override { self = s; }; in s;
 in
 extraPkgs // {
   mtdutils = prev.mtdutils.overrideAttrs(o: {
@@ -97,7 +98,8 @@ extraPkgs // {
     ];
   });
 
-  luaSmall = let s = lua_no_readline.override { self = s; }; in s;
+  luaFull = prev.lua;
+  inherit lua;
 
   inherit s6;
   s6-linux-init = prev.s6-linux-init.override {

pkgs/anoia/README

@@ -0,0 +1,14 @@
+
+In Terry Pratchett's Discworld novels, Anoi is a minor goddess of Things That Stick In Drawers
+
+> Often, but not uniquely, a ladle, but sometimes a metal spatula or,
+> rarely, a mechanical egg-whisk that nobody in the house admits to
+> ever buying. The desperate mad rattling and cries of ‘How can it
+> close on the damn thing but not open with it? Who bought this? Do we
+> ever use it?’ is as praise unto Anoia. She also eats corkscrews.
+
+This is a library of miscellaneous Fennel code used in Liminix that is
+shared between various scripts but doesn't really fit together. It is
+not a public stable interface - while any Liminix code is welcome to
+use it, it's suject to reshuffle, rearrangement, refactor or rejection
+without notice.

pkgs/anoia/default.nix

@@ -0,0 +1,19 @@
+{
+  fennel
+, stdenv
+, lua
+}:
+let pname =  "anoia";
+in stdenv.mkDerivation {
+  inherit pname;
+  version = "0.1";
+  src = ./.;
+  nativeBuildInputs = [ fennel ];
+  buildPhase = ''
+    fennel --compile init.fnl > init.lua
+  '';
+  installPhase = ''
+    mkdir -p "$out/share/lua/${lua.luaversion}/${pname}"
+    cp *.lua "$out/share/lua/${lua.luaversion}/${pname}"
+  '';
+}

pkgs/anoia/init.fnl

@@ -0,0 +1,16 @@
+(fn merge [table1 table2]
+  (collect [k v (pairs table2) &into table1]
+    k v))
+
+(fn split [sep string]
+  (icollect [v (string.gmatch string (.. "([^" sep "]+)"))]
+    v))
+
+(fn file-exists? [name]
+  (match (io.open name :r)
+    f (do (f:close) true)
+    _ false))
+
+(fn system [s] (assert (os.execute s)))
+
+{ : merge : split : file-exists? : system }

pkgs/default.nix

@@ -55,4 +55,8 @@
   hi = callPackage ./hi {};
   firewallgen  = callPackage ./firewallgen {};
   kernel-modules  = callPackage ./kernel-modules {};
+  odhcp-script = callPackage ./odhcp-script {};
+  fennel = callPackage ./fennel {};
+  fennelrepl = callPackage ./fennelrepl {};
+  anoia = callPackage ./anoia {};
 }

pkgs/fennel/default.nix

@@ -0,0 +1,19 @@
+{
+  stdenv
+, lua
+, fetchFromSourcehut
+}:
+let pname =  "fennel";
+in stdenv.mkDerivation {
+  inherit pname;
+  version = "1.3";
+  nativeBuildInputs = [ lua ];  # used in build
+  buildInputs = [ lua ];        # needed for patchShebangs
+  src = fetchFromSourcehut {
+    owner = "~technomancy";
+    repo = pname;
+    rev = "1.3.0";
+    hash = "sha256-DXJOdYzfjTncqL7BsDbdvZcauDMkZV2X0U0FfhfwQrw=";
+  };
+  makeFlags = [ "PREFIX=${placeholder "out"}" ];
+}

pkgs/fennelrepl/default.nix

@@ -0,0 +1,34 @@
+{
+  runCommand
+, runtimeShell
+, fetchurl
+, lib
+, luaPackages
+, lua
+, writeScriptBin
+, linotify
+, anoia
+, fennel
+}:
+let packages = [
+      linotify
+      anoia
+      fennel
+    ];
+    join = ps: builtins.concatStringsSep ";" ps;
+    luapath = join (builtins.map (f: "${f}/share/lua/${lua.luaversion}/?.lua") packages);
+    luacpath = join (builtins.map (f: "${f}/lib/lua/${lua.luaversion}/?.so") packages);
+
+in writeScriptBin "fennelrepl" ''
+    #!${lua}/bin/lua
+    package.path = ${lib.strings.escapeShellArg luapath} .. ";" .. package.path
+    package.cpath = ${lib.strings.escapeShellArg luacpath} .. ";" .. (package.cpath or "")
+    local fennel = require "fennel"
+    fennel.install()
+    local more_fennel = os.getenv("FENNEL_PATH")
+    if more_fennel then
+        fennel.path = more_fennel .. ";" .. fennel.path
+    end
+    print("path", fennel.path)
+    fennel.repl()
+  ''

pkgs/ifwait/default.nix

@@ -1,13 +1,10 @@
 {
-  luaSmall
+  lua
 , netlink-lua
 , writeFennelScript
 , runCommand
 }:
-let
-  lua = luaSmall;
-  netlink = netlink-lua.override {inherit lua;};
-in runCommand "ifwait" {} ''
+runCommand "ifwait" {} ''
   mkdir -p $out/bin
-  cp -p ${writeFennelScript "ifwait" [netlink] ./ifwait.fnl} $out/bin/ifwait
+  cp -p ${writeFennelScript "ifwait" [netlink-lua] ./ifwait.fnl} $out/bin/ifwait
 ''

pkgs/liminix-tools/networking/default.nix

@@ -45,14 +45,15 @@ in {
   pppoe = callPackage ./pppoe.nix {};
   dnsmasq = callPackage ./dnsmasq.nix {};
   hostapd = callPackage ./hostapd.nix {};
-  route = { name, target, via, dependencies }:
-    oneshot {
+  route = { name, target, via, dependencies, dev ? null }:
+    let with_dev = if dev != null then "dev ${dev}" else "";
+    in oneshot {
       inherit name;
       up = ''
-        ip route add ${target} via ${via}
+        ip route add ${target} via ${via} ${with_dev}
       '';
       down = ''
-        ip route del ${target} via ${via}
+        ip route del ${target} via ${via} ${with_dev}
       '';
       inherit dependencies;
     };

pkgs/odhcp-script/default.nix

@@ -0,0 +1,4 @@
+{
+  writeFennelScript
+}:
+writeFennelScript  "odhcpc-script" [] ./odhcp6-script.fnl

pkgs/odhcp-script/odhcp6-script.fnl

@@ -56,8 +56,9 @@
               "unbound" false
               "stopped" false
               _ true)]
-  (write-value "last-update" (tostring (os.time)))
+  (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"))))

pkgs/write-fennel-script/default.nix

@@ -1,31 +1,31 @@
 {
-  runCommand
-, luaSmall
-, runtimeShell
-, fetchurl
+  lua
 , lib
-, lua53Packages
+, fennel
+, stdenv
 }:
-let inherit (lua53Packages) lua;
-in name : packages : source :
+name : packages : source :
   let
-    fennel = fetchurl {
-      url = "https://fennel-lang.org/downloads/fennel-1.3.0";
-      hash = "sha256-hYSD3rBYF8iTjBOA1m+TvUu8BSp8q6uIMUXi0xwo/dU=";
-    };
-
-    luapath = builtins.map (f: "${f}/share/lua/${luaSmall.luaversion}/?.lua;") packages;
-    luacpath = builtins.map (f: "${f}/lib/lua/${luaSmall.luaversion}/?.so;") packages;
-  in runCommand name {
-    nativeBuildInputs =  [ lua ];
-  } ''
-     echo $PATH
-      #!${runtimeShell}
+    luapath = builtins.map
+      (f:
+        "${f}/share/lua/${lua.luaversion}/?.lua;" +
+        "${f}/share/lua/${lua.luaversion}/?/init.lua;")
+      packages;
+    luacpath = builtins.map (f: "${f}/lib/lua/${lua.luaversion}/?.so;") packages;
+  in stdenv.mkDerivation {
+    inherit name;
+    src = ./.;
+    nativeBuildInputs = [ fennel ];
+    buildPhase = ''
       (
-      echo "#!${luaSmall}/bin/lua"
+       echo "#!${lua}/bin/lua"
        echo "package.path = ${lib.strings.escapeShellArg luapath} .. package.path"
        echo "package.cpath = ${lib.strings.escapeShellArg luacpath} .. package.cpath"
-      lua ${fennel} --correlate --compile ${source}
-      ) > $out
-      chmod a+x $out
-    ''
+       fennel --correlate --compile ${source}
+      ) >  ${name}.lua
+    '';
+    installPhase = ''
+      cp ${name}.lua $out
+      chmod +x $out
+    '';
+  }

tests/fennel/test.nix

@@ -6,8 +6,8 @@ let
   overlay = import "${liminix}/overlay.nix";
   pkgs = import <nixpkgs> { overlays = [overlay]; };
   script = pkgs.writeFennelScript "foo" [] ./hello.fnl;
-  inherit (pkgs.luaSmall.pkgs) fifo;
-  netlink = pkgs.netlink-lua.override { lua = pkgs.luaSmall; };
+  inherit (pkgs.lua.pkgs) fifo;
+  netlink = pkgs.netlink-lua;
   script2 = pkgs.writeFennelScript "foo2" [fifo netlink] ./hello.fnl;
 in pkgs.runCommand "check" {
   } ''