128 lines
3.4 KiB
Fennel
128 lines
3.4 KiB
Fennel
(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 }
|