convert devout from minisock to lualinux

This commit is contained in:
Daniel Barlow 2024-04-23 23:33:11 +01:00
parent ff2604ca5d
commit b8ac9e5279
2 changed files with 39 additions and 30 deletions

View file

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

View file

@ -1,8 +1,8 @@
(local sock (require :minisock)) (local ll (require :lualinux))
(local { : view } (require :fennel)) (local { : view } (require :fennel))
(fn trace [expr] (fn trace [expr]
(doto expr (print :TRACE (view expr)))) (do (print :TRACE (view expr)) expr))
(fn parse-uevent [s] (fn parse-uevent [s]
(let [at (string.find s "@" 1 true) (let [at (string.find s "@" 1 true)
@ -50,29 +50,39 @@
:unsubscribe (fn [_ id] (tset subscribers id nil)) :unsubscribe (fn [_ id] (tset subscribers id nil))
})) }))
;; #define POLLIN 0x0001 ;; grepped from kernel headers
;; #define POLLPRI 0x0002
;; #define POLLOUT 0x0004 (local POLLIN 0x0001)
;; #define POLLERR 0x0008 (local POLLPRI 0x0002)
;; #define POLLHUP 0x0010 (local POLLOUT 0x0004)
;; #define POLLNVAL 0x0020 (local POLLERR 0x0008)
(local POLLHUP 0x0010)
(local POLLNVAL 0x0020)
(local AF_LOCAL 1)
(local AF_NETLINK 16)
(local SOCK_STREAM 1)
(local SOCK_DGRAM 2)
(local SOCK_RAW 3)
(local NETLINK_KOBJECT_UEVENT 15)
(fn unix-socket [name] (fn unix-socket [name]
(let [addr (.. "\1\0" name "\0\0\0\0\0") (let [addr (.. "\1\0" name "\0\0\0\0\0")]
(sock err) (sock.bind addr)] (match (ll.socket AF_LOCAL SOCK_STREAM 0)
(assert sock err))) fd (match (ll.bind fd addr)
0 (doto fd (ll.listen 32))
(nil err) (values nil err))
(nil err) (values nil err))))
(fn pollfds-for [fds] (fn pollfds-for [fds]
(table.concat (icollect [_ v (ipairs fds)] (string.pack "iHH" v 1 0)))) (icollect [_ v (ipairs fds)]
(bor (lshift v 32) (lshift 1 16))))
(fn unpack-pollfds [pollfds] (fn unpack-pollfds [pollfds]
(var i 1) (collect [_ v (ipairs pollfds)]
(let [fds {}] (let [fd (band (rshift v 32) 0xffffffff)
(while (< i (# pollfds)) revent (band v 0xffff)]
(let [(fd _ revents i_) (string.unpack "iHH" pollfds i)] (values fd revent))))
(if (> revents 0) (tset fds fd revents))
(set i i_)))
fds))
(fn parse-terms [str] (fn parse-terms [str]
(print :terms str) (print :terms str)
@ -80,7 +90,7 @@
(string.match n "(.-)=(.+)"))) (string.match n "(.-)=(.+)")))
(fn handle-client [db client] (fn handle-client [db client]
(match (trace (sock.read client)) (match (ll.read client)
"" (do "" (do
(db:unsubscribe client) (db:unsubscribe client)
false) false)
@ -88,7 +98,7 @@
(db:subscribe (db:subscribe
client client
(fn [e] (fn [e]
(sock.write client (view e))) (ll.write client (view e)))
(parse-terms s)) (parse-terms s))
true) true)
(nil err) (do (print err) false))) (nil err) (do (print err) false)))
@ -101,7 +111,7 @@
(each [fd revent (pairs revents)] (each [fd revent (pairs revents)]
(when (not ((. fds fd) fd)) (when (not ((. fds fd) fd))
(tset fds fd nil) (tset fds fd nil)
(sock.close fd)))) (ll.close fd))))
:fds #(icollect [fd _ (pairs fds)] fd) :fds #(icollect [fd _ (pairs fds)] fd)
:_tbl #(do fds) ;exposed for tests :_tbl #(do fds) ;exposed for tests
})) }))
@ -113,15 +123,14 @@
loop (event-loop)] loop (event-loop)]
(loop:register (loop:register
s s
#(match (sock.accept s) #(match (ll.accept s)
(client addr) (client addr)
(do (do
(loop:register client (partial handle-client db)) (loop:register client (partial handle-client db))
true))) true)))
(while true (while true
(let [pollfds (pollfds-for (loop:fds)) (let [pollfds (pollfds-for (loop:fds))]
(rpollfds numfds) (sock.poll pollfds 1000)] (ll.poll pollfds 5000)
(when (> numfds 0) (loop:feed (unpack-pollfds pollfds))))))
(loop:feed (unpack-pollfds rpollfds)))))))
{ : database : run : event-loop } { : database : run : event-loop }