Compare commits
15 Commits
771585546d
...
90d9d0e811
Author | SHA1 | Date |
---|---|---|
Daniel Barlow | 90d9d0e811 | |
Daniel Barlow | 97a8ae1c84 | |
Daniel Barlow | 52eb283a26 | |
Daniel Barlow | cbb1de804e | |
Daniel Barlow | f9c03998b8 | |
Daniel Barlow | 50de1b090f | |
Daniel Barlow | 648382f64a | |
Daniel Barlow | e9370358ae | |
Daniel Barlow | 762ce7b6b8 | |
Daniel Barlow | b1c0560f4f | |
Daniel Barlow | e34135c41a | |
Daniel Barlow | 712c9b266f | |
Daniel Barlow | 4df963996c | |
Daniel Barlow | 349bfecbb8 | |
Daniel Barlow | 450d3820b2 |
|
@ -56,6 +56,7 @@ in {
|
||||||
# please keep the rest of this list alphabetised :-)
|
# please keep the rest of this list alphabetised :-)
|
||||||
|
|
||||||
anoia = callPackage ./anoia {};
|
anoia = callPackage ./anoia {};
|
||||||
|
devout = callPackage ./devout {};
|
||||||
fennel = callPackage ./fennel {};
|
fennel = callPackage ./fennel {};
|
||||||
fennelrepl = callPackage ./fennelrepl {};
|
fennelrepl = callPackage ./fennelrepl {};
|
||||||
firewallgen = callPackage ./firewallgen {};
|
firewallgen = callPackage ./firewallgen {};
|
||||||
|
|
|
@ -0,0 +1,27 @@
|
||||||
|
{
|
||||||
|
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;
|
||||||
|
}
|
|
@ -0,0 +1,127 @@
|
||||||
|
(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 }
|
|
@ -0,0 +1,185 @@
|
||||||
|
(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"))
|
|
@ -1,16 +1,17 @@
|
||||||
{ lua, lib, fetchFromGitHub }:
|
{ lua, lib, fetchFromGitHub }:
|
||||||
let pname = "minisock";
|
let
|
||||||
|
pname = "minisock";
|
||||||
|
src = fetchFromGitHub {
|
||||||
|
repo = "minisock";
|
||||||
|
owner = "telent";
|
||||||
|
rev = "46e0470ff88c68f3a873dedbcf1dc351f4916b1a";
|
||||||
|
hash = "sha256-uTV5gpfEMvHMBgdu41Gy2uizc3K9bXtO5BiCY70cYUs=";
|
||||||
|
};
|
||||||
in lua.pkgs.buildLuaPackage {
|
in lua.pkgs.buildLuaPackage {
|
||||||
inherit pname;
|
inherit pname;
|
||||||
version = "0.1"; # :shrug:
|
version = "0.1"; # :shrug:
|
||||||
|
|
||||||
src = fetchFromGitHub {
|
inherit src;
|
||||||
repo = "minisock";
|
|
||||||
owner = "philanc";
|
|
||||||
rev = "a20db2aaa871653c61045019633279167cf1b458";
|
|
||||||
hash = "sha256-zB9KSt0WEGCSYTLA6W9QrsVRFEZYaoBBeXx9VEXmsGY=";
|
|
||||||
};
|
|
||||||
|
|
||||||
makeFlags = [ "LUADIR=." "minisock.so" ];
|
makeFlags = [ "LUADIR=." "minisock.so" ];
|
||||||
|
|
||||||
installPhase = ''
|
installPhase = ''
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
{
|
{
|
||||||
lua
|
lua
|
||||||
, nellie
|
, nellie
|
||||||
, writeFennelScript
|
, writeFennel
|
||||||
, runCommand
|
, runCommand
|
||||||
, anoia
|
, anoia
|
||||||
, fennel
|
, fennel
|
||||||
|
@ -14,7 +14,10 @@ stdenv.mkDerivation {
|
||||||
nativeBuildInputs = [ fennelrepl ];
|
nativeBuildInputs = [ fennelrepl ];
|
||||||
installPhase = ''
|
installPhase = ''
|
||||||
mkdir -p $out/bin
|
mkdir -p $out/bin
|
||||||
cp -p ${writeFennelScript "uevent-watch" [fennel anoia nellie lua.pkgs.luafilesystem] ./watch.fnl} $out/bin/uevent-watch
|
cp -p ${writeFennel "uevent-watch" {
|
||||||
|
packages = [fennel anoia nellie lua.pkgs.luafilesystem];
|
||||||
|
mainFunction = "run";
|
||||||
|
} ./watch.fnl} $out/bin/uevent-watch
|
||||||
'';
|
'';
|
||||||
checkPhase = ''
|
checkPhase = ''
|
||||||
fennelrepl ./test.fnl
|
fennelrepl ./test.fnl
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
(local { : view} (require :fennel))
|
(local { : view} (require :fennel))
|
||||||
(import-macros { : expect= } :anoia.assert)
|
(import-macros { : expect= } :anoia.assert)
|
||||||
|
|
||||||
(set _G.arg (doto [] (tset 0 "test")))
|
|
||||||
(local subject (require :watch))
|
(local subject (require :watch))
|
||||||
|
|
||||||
(let [params
|
(let [params
|
||||||
|
@ -35,7 +34,9 @@
|
||||||
|
|
||||||
;; this tests event parsing but not whether anything
|
;; this tests event parsing but not whether anything
|
||||||
;; happens as a result of processing them
|
;; happens as a result of processing them
|
||||||
(subject.run
|
(subject.run-with-fh
|
||||||
["-s" "foo" "-n" (os.getenv "TMPDIR") "partname=backup-disk" ]
|
|
||||||
{ :read (next-event) }
|
{ :read (next-event) }
|
||||||
|
["-s" "foo" "-n" (os.getenv "TMPDIR") "partname=backup-disk" ]
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(print "OK")
|
||||||
|
|
|
@ -47,7 +47,7 @@
|
||||||
"(%g-)=(%g+)")]
|
"(%g-)=(%g+)")]
|
||||||
(k:lower) v))))
|
(k:lower) v))))
|
||||||
|
|
||||||
(fn run [args fh]
|
(fn run-with-fh [fh args]
|
||||||
(set up :unknown)
|
(set up :unknown)
|
||||||
(let [parameters
|
(let [parameters
|
||||||
(assert (parse-args args) (.. "can't parse args: " (table.concat args " ")))]
|
(assert (parse-args args) (.. "can't parse args: " (table.concat args " ")))]
|
||||||
|
@ -62,9 +62,9 @@
|
||||||
(set finished? (= e nil))
|
(set finished? (= e nil))
|
||||||
))))
|
))))
|
||||||
|
|
||||||
(when (not (= (. arg 0) "test"))
|
(fn run [args]
|
||||||
(let [nellie (require :nellie)
|
(let [nellie (require :nellie)
|
||||||
netlink (nellie.open 4)]
|
netlink (nellie.open 4)]
|
||||||
(run arg netlink)))
|
(run-with-fh netlink arg)))
|
||||||
|
|
||||||
{ : run : event-matches? }
|
{ : run : run-with-fh : event-matches? }
|
||||||
|
|
Loading…
Reference in New Issue