pkgs/default.nix

@@ -56,7 +56,6 @@ in {
   # please keep the rest of this list alphabetised :-)
 
   anoia = callPackage ./anoia {};
-  devout = callPackage ./devout {};
   fennel = callPackage ./fennel {};
   fennelrepl = callPackage ./fennelrepl {};
   firewallgen = callPackage ./firewallgen {};

pkgs/devout/default.nix

@@ -1,27 +0,0 @@
-{
-  lua
-, nellie
-, writeFennel
-, anoia
-, fennel
-, stdenv
-, fennelrepl
-, minisock
-}:
-stdenv.mkDerivation {
-  name = "devout";
-  src = ./.;
-  checkInputs = [ fennelrepl ];
-  installPhase = ''
-    mkdir -p $out/bin
-    cp -p ${writeFennel "devout" {
-      packages = [fennel anoia nellie lua.pkgs.luafilesystem minisock];
-      mainFunction = "run";
-    } ./devout.fnl} $out/bin/devout
-  '';
-  checkPhase = ''
-    LUA_CPATH=${minisock}/lib/lua/5.3/?.so\;$LUA_CPATH \
-    fennelrepl ./test.fnl
-  '';
-  doCheck = true;
-}

pkgs/devout/devout.fnl

@@ -1,127 +0,0 @@
-(local sock (require :minisock))
-(local { : view } (require :fennel))
-
-(fn trace [expr]
-  (doto expr (print :TRACE (view expr))))
-
-(fn parse-uevent [s]
-  (let [at (string.find s "@" 1 true)
-        (nl nxt) (string.find s "\0" 1 true)]
-    (doto
-        (collect [k v (string.gmatch
-                       (string.sub s (+ 1 nxt))
-                       "(%g-)=(%g+)")]
-          (k:lower) v)
-      (tset :path (string.sub s (+ at 1) (- nl 1))))))
-
-(fn event-matches? [e terms]
-  (accumulate [match? true
-               name value (pairs terms)]
-    (and match? (= value (. e name)))))
-
-(fn find-in-database [db terms]
-  (accumulate [found []
-               _ e (pairs db)]
-    (if (event-matches? e terms)
-        (doto found (table.insert e))
-        found)))
-
-(fn record-event [db subscribers str]
-  (let [e (parse-uevent str)]
-    (match e.action
-      :add (tset db e.path e)
-      :change (tset db e.path e)
-      ;; should we do something for bind?
-      :remove (tset db e.path nil)
-      )
-    (each [_ { : terms : callback } (pairs subscribers)]
-      (if (event-matches? e terms) (callback e)))
-    e))
-
-(fn database []
-  (let [db {}
-        subscribers []]
-    {
-     :find (fn [_ terms] (find-in-database db terms))
-     :add (fn [_ event-string] (record-event db subscribers event-string))
-     :at-path (fn [_ path] (. db path))
-     :subscribe (fn [_ id callback terms]
-                  (tset subscribers id {: callback : terms }))
-     :unsubscribe (fn [_ id] (tset subscribers id nil))
-     }))
-
-;; #define POLLIN          0x0001
-;; #define POLLPRI         0x0002
-;; #define POLLOUT         0x0004
-;; #define POLLERR         0x0008
-;; #define POLLHUP         0x0010
-;; #define POLLNVAL        0x0020
-
-(fn unix-socket [name]
-  (let [addr (.. "\1\0"  name  "\0\0\0\0\0")
-        (sock err) (sock.bind addr)]
-    (assert sock err)))
-
-(fn pollfds-for [fds]
-  (table.concat (icollect [_ v (ipairs fds)] (string.pack "iHH" v 1 0))))
-
-(fn unpack-pollfds [pollfds]
-  (var i 1)
-  (let [fds {}]
-    (while (< i (# pollfds))
-      (let [(fd _ revents i_) (string.unpack "iHH" pollfds i)]
-        (if (> revents 0) (tset fds fd revents))
-        (set i i_)))
-    fds))
-
-(fn parse-terms [str]
-  (print :terms str)
-  (collect [n (string.gmatch str "([^ ]+)")]
-    (string.match n "(.-)=(.+)")))
-
-(fn handle-client [db client]
-  (match (trace (sock.read client))
-    "" (do
-         (db:unsubscribe client)
-         false)
-    s (do
-        (db:subscribe
-         client
-         (fn [e]
-           (sock.write client (view e)))
-         (parse-terms s))
-        true)
-    (nil err) (do (print err) false)))
-
-(fn event-loop []
-  (let [fds {}]
-    {
-     :register #(tset fds $2 $3)
-     :feed (fn [_ revents]
-             (each [fd revent (pairs revents)]
-               (when (not ((. fds fd) fd))
-                 (tset fds fd nil)
-                 (sock.close fd))))
-     :fds #(icollect [fd _ (pairs fds)] fd)
-    :_tbl #(do fds)                    ;exposed for tests
-     }))
-
-(fn run []
-  (let [[sockname] arg
-        s (unix-socket sockname)
-        db (database)
-        loop (event-loop)]
-    (loop:register
-     s
-     #(match (sock.accept s)
-        (client addr)
-        (do
-          (loop:register client (partial handle-client db))
-          true)))
-    (while true
-      (let [pollfds (pollfds-for (loop:fds))
-            (rpollfds numfds) (sock.poll pollfds 1000)]
-        (when (> numfds 0)
-          (loop:feed (unpack-pollfds rpollfds)))))))
-
-{ : database : run : event-loop  }

pkgs/devout/test.fnl

@@ -1,185 +0,0 @@
-(local { : database : event-loop } (require :devout))
-(local { : view } (require :fennel))
-(local sock (require :minisock))
-(import-macros { : expect : expect= } :anoia.assert)
-
-(var failed false)
-(fn fail [d msg] (set failed true) (print :FAIL d (.. "\n" msg)))
-
-(macro example [description & body]
-  (if (. body 1)
-      `(let [(ok?# err#) (xpcall (fn [] ,body) debug.traceback)]
-         (if ok?#
-             (print :PASS ,description)
-             (fail ,description err#)))
-      `(print :PENDING ,description)))
-
-(example
- "given an empty database, searching it finds no entries"
- (let [db (database)]
-   (expect= (db:find {:partname "boot"}) [])))
-
-(local sda-uevent
-       "add@/devices/pci0000:00/0000:00:13.0/usb1/1-1/1-1:1.0/host0/target0:0:0/0:0:0:0/block/sda\0ACTION=add
-DEVPATH=/devices/pci0000:00/0000:00:13.0/usb1/1-1/1-1:1.0/host0/target0:0:0/0:0:0:0/block/sda
-SUBSYSTEM=block
-MAJOR=8
-MINOR=0
-DEVNAME=sda
-DEVTYPE=disk
-DISKSEQ=2
-SEQNUM=1527")
-
-(local sdb1-insert
-       "add@/devices/pci0000:00/0000:00:14.0/usb1/1-3/1-3:1.0/host1/target1:0:0/1:0:0:0/block/sdb/sdb1\0ACTION=add
-DEVPATH=/devices/pci0000:00/0000:00:14.0/usb1/1-3/1-3:1.0/host1/target1:0:0/1:0:0:0/block/sdb/sdb1
-SUBSYSTEM=block
-DEVNAME=/dev/sdb1
-DEVTYPE=partition
-DISKSEQ=33
-PARTN=1
-SEQNUM=82381
-MAJOR=8
-MINOR=17")
-
-(local sdb1-remove
-       "remove@/devices/pci0000:00/0000:00:14.0/usb1/1-3/1-3:1.0/host1/target1:0:0/1:0:0:0/block/sdb/sdb1\0ACTION=remove
-DEVPATH=/devices/pci0000:00/0000:00:14.0/usb1/1-3/1-3:1.0/host1/target1:0:0/1:0:0:0/block/sdb/sdb1
-SUBSYSTEM=block
-DEVNAME=/dev/sdb1
-DEVTYPE=partition
-DISKSEQ=33
-PARTN=1
-SEQNUM=82386
-MAJOR=8
-MINOR=17")
-
-
-(example
- "when I add a device, I can find it"
- (let [db (database)]
-   (db:add sda-uevent)
-   (let [[m & more] (db:find {:devname "sda"})]
-     (expect= m.devname "sda")
-     (expect= m.major "8")
-     (expect= more []))))
-
-(example
- "when I add a device, I cannot find it with wrong terms"
- (let [db (database)]
-   (db:add sda-uevent)
-   (expect= (db:find {:devname "sdb"}) [])))
-
-(example
- "when I add a device, I can retrieve it by path"
- (let [db (database)]
-   (db:add sda-uevent)
-   (let [m (db:at-path "/devices/pci0000:00/0000:00:13.0/usb1/1-1/1-1:1.0/host0/target0:0:0/0:0:0:0/block/sda")]
-     (expect= m.devname "sda")
-     (expect= m.major "8"))))
-
-(example
- "when I add and then remove a device, I cannot retrieve it by path"
- (let [db (database)]
-   (db:add sdb1-insert)
-   (db:add sdb1-remove)
-   (expect= (db:at-path "/devices/pci0000:00/0000:00:14.0/usb1/1-3/1-3:1.0/host1/target1:0:0/1:0:0:0/block/sdb/sdb1") nil)))
-
-(example
- "when I add and then remove a device, I cannot find it"
- (let [db (database)]
-   (db:add sdb1-insert)
-   (db:add sda-uevent)
-   (db:add sdb1-remove)
-   (expect= (db:find {:devname "/dev/sdb1"}) [])))
-
-(example
- "when I search on multiple terms it uses all of them"
- (let [db (database)]
-   (db:add sda-uevent)
-   (expect= (# (db:find {:devname "sda" :devtype "disk"})) 1)
-   (expect= (# (db:find {:devname "sda" :devtype "dosk"})) 0)))
-
-
-;;; tests for indices
-
-(example "when I add a device with $attributes major minor foo bar baz,
- it is added to indices for foo bar baz but not major minor")
-
-(example "a removed device can no longer be found by looking in any index")
-
-(example "when I query with multiple attributes, the search is performed using the most specific attribute"
-         ;; (= the attribute whose
-         ;;   value at this key has fewest elements)
-         )
-
-;;; tests for subscriptions
-
-(example
- "I can subscribe to some search terms and be notified of matching events"
- (var received [])
- (let [db (database)
-       subscriber (fn [e] (table.insert received e))]
-   (db:subscribe :me subscriber {:devname "/dev/sdb1"})
-   (db:add sdb1-insert)
-   (db:add sda-uevent)
-   (db:add sdb1-remove)
-   (expect= (# received) 2)))
-
-(example
- "I can unsubscribe after subscribing"
- (var received [])
- (let [db (database)
-       subscriber (fn [e] (table.insert received e))]
-   (db:subscribe :me subscriber {:devname "/dev/sdb1"})
-   (db:unsubscribe :me)
-   (db:add sdb1-insert)
-   (db:add sda-uevent)
-   (db:add sdb1-remove)
-   (expect= (# received) 0)))
-
-
-;;; test for event loop
-
-(example
- "I can register a fd with a callback"
- (let [loop (event-loop)
-       cb #(print $1)]
-   (loop:register 3 cb)
-   (expect= (. (loop:_tbl) 3) cb)))
-
-(example
- "when the fd is ready, my callback is called"
- (let [loop (event-loop)]
-   (var ran? false)
-   (loop:register 3 #(set ran? true))
-   (loop:feed {3 1})
-   (expect= ran? true)
-   ))
-
-(example
- "when the callback returns true it remains registered"
- (let [loop (event-loop)]
-   (loop:register 3 #true)
-   (loop:feed {3 1})
-   (expect (. (loop:_tbl) 3))
-   ))
-
-(fn new-fd []
-  (let [fd (sock.bind (.. "\1\0"  "/tmp/test-socket"  "\0\0\0\0\0"))]
-    (os.remove "/tmp/test-socket")
-    fd))
-
-(example
- "when the callback returns false it is unregistered and the fd is closed"
- (let [loop (event-loop)
-       fd (new-fd)]
-   (expect (> fd 2))
-   (loop:register 3 #false)
-   (loop:feed {3 1})
-   (expect (not (. (loop:_tbl) 3)))
-   (assert (not (os.execute (string.format "test -e /dev/fd/%d" fd))))
-   ))
-
-
-(if failed (os.exit 1) (print "OK"))

pkgs/minisock/default.nix

@@ -1,17 +1,16 @@
 { lua, lib, fetchFromGitHub }:
-let
+let pname = "minisock";
-  pname = "minisock";
-  src = fetchFromGitHub {
-    repo = "minisock";
-    owner = "telent";
-    rev = "46e0470ff88c68f3a873dedbcf1dc351f4916b1a";
-    hash = "sha256-uTV5gpfEMvHMBgdu41Gy2uizc3K9bXtO5BiCY70cYUs=";
-  };
 in lua.pkgs.buildLuaPackage {
   inherit pname;
   version = "0.1";              # :shrug:
 
-  inherit src;
+  src = fetchFromGitHub {
+    repo = "minisock";
+    owner = "philanc";
+    rev = "a20db2aaa871653c61045019633279167cf1b458";
+    hash = "sha256-zB9KSt0WEGCSYTLA6W9QrsVRFEZYaoBBeXx9VEXmsGY=";
+  };
+
   makeFlags = [ "LUADIR=."  "minisock.so" ];
 
   installPhase = ''

pkgs/uevent-watch/default.nix

@@ -1,7 +1,7 @@
 {
   lua
 , nellie
-, writeFennel
+, writeFennelScript
 , runCommand
 , anoia
 , fennel
@@ -14,10 +14,7 @@ stdenv.mkDerivation {
   nativeBuildInputs = [ fennelrepl ];
   installPhase = ''
     mkdir -p $out/bin
-    cp -p ${writeFennel "uevent-watch" {
+    cp -p ${writeFennelScript "uevent-watch" [fennel anoia nellie lua.pkgs.luafilesystem] ./watch.fnl} $out/bin/uevent-watch
-      packages = [fennel anoia nellie lua.pkgs.luafilesystem];
-      mainFunction = "run";
-    } ./watch.fnl} $out/bin/uevent-watch
   '';
   checkPhase = ''
     fennelrepl ./test.fnl

pkgs/uevent-watch/test.fnl

@@ -1,6 +1,7 @@
 (local { : view} (require :fennel))
 (import-macros { : expect= } :anoia.assert)
 
+(set _G.arg (doto [] (tset 0 "test")))
 (local subject (require :watch))
 
 (let [params
@@ -34,9 +35,7 @@
 
 ;; this tests event parsing but not whether anything
 ;; happens as a result of processing them
-(subject.run-with-fh
+(subject.run
- { :read (next-event) }
  ["-s" "foo" "-n" (os.getenv "TMPDIR") "partname=backup-disk" ]
+ { :read (next-event) }
  )
-
-(print "OK")

pkgs/uevent-watch/watch.fnl

@@ -47,7 +47,7 @@
                      "(%g-)=(%g+)")]
         (k:lower) v))))
 
-(fn run-with-fh [fh args]
+(fn run [args fh]
   (set up :unknown)
   (let [parameters
         (assert (parse-args args) (.. "can't parse args: " (table.concat args " ")))]
@@ -62,9 +62,9 @@
         (set finished? (= e nil))
         ))))
 
-(fn run [args]
+(when (not (= (. arg 0) "test"))
   (let [nellie (require :nellie)
         netlink (nellie.open 4)]
-    (run-with-fh netlink arg)))
+    (run arg netlink)))
 
-{ : run : run-with-fh : event-matches? }
+{ : run  : event-matches? }