dan
/
liminix
1
0
Fork 5
Code Issues 2 Pull Requests 1 Projects Releases Wiki Activity

fennel anoia.process.spawn 

runs a subprocess and invokes a callback whenever its io
descriptors are ready
This commit is contained in:
Daniel Barlow 2024-09-06 00:11:33 +01:00
parent e2a597589b
commit e604d628e3
4 changed files with 89 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/anoia/Makefile
View File

@ -1,8 +1,8 @@
servicedir:=$(shell mktemp -d)
default: fs.lua init.lua nl.lua svc.lua net/constants.lua
default: fs.lua init.lua nl.lua svc.lua process.lua net/constants.lua
CHECK=fs.fnl init.fnl svc.fnl
CHECK=fs.fnl init.fnl svc.fnl process.fnl
check:
ln -s . anoia
@ -22,4 +22,4 @@ net/constants.lua: net/constants.c
%.lua: %.fnl
fennel --compile $< > $@
fennel --add-macro-path './assert.fnl' --compile $< > $@

3
pkgs/anoia/default.nix
View File

@ -1,4 +1,5 @@
{
bc, # for tests
fennel,
stdenv,
linotify,
@ -11,7 +12,7 @@ in stdenv.mkDerivation {
inherit pname;
version = "0.1";
src = ./.;
nativeBuildInputs = [ fennel cpio ];
nativeBuildInputs = [ fennel cpio bc ];
buildInputs = with lua.pkgs; [ linotify lualinux ];
outputs = [ "out" "dev" ];

24
pkgs/anoia/fs.fnl
View File

@ -66,29 +66,6 @@
unknown
(error (.. "can't remove " pathname " of mode \"" unknown "\""))))
(fn popen2 [pname argv envp]
(case (ll.pipe2)
(cin-s cin-d)
(match (ll.pipe2)
(cout-s cout-d)
(let [(pid err) (ll.fork)]
(if (not pid) (error (.. "error: " err))
(= pid 0)
(do
(ll.close cin-d)
(ll.close cout-s)
(ll.dup2 cin-s 0)
(ll.dup2 cout-d 1)
(ll.dup2 cout-d 2)
(ll.execve pname argv envp)
(error "execve failed"))
(> pid 0)
(do
(ll.close cin-s)
(ll.close cout-d)))
(values pid cin-d cout-s))
(nil err) (error (.. "popen pipe out: " err)))
(nil err) (error (.. "popen pipe in: " err))))
;; lualinux doesn't publish access(2), this is not exactly
;; the same but will suffice until we can add it
(fn executable? [f]
@ -112,7 +89,6 @@
: directory?
: dir
: file-type
: popen2
: find-executable
:symlink (fn [from to] (ll.symlink from to))
}

84
pkgs/anoia/process.fnl Normal file
View File

@ -0,0 +1,84 @@
(local ll (require :lualinux))
(local { : find-executable } (require :anoia.fs))
(import-macros { : define-tests : expect : expect= } :anoia.assert)
(macro errno-check [x]
`(match ,x
val# val#
(nil errno#) (assert nil (.. "system call failed, errno=" errno#))
))
(fn popen2 [pname argv envp]
(case (ll.pipe2)
(cin-s cin-d)
(match (ll.pipe2)
(cout-s cout-d)
(let [(pid err) (ll.fork)]
(if (not pid) (error (.. "error: " err))
(= pid 0)
(do
(ll.close cin-d)
(ll.close cout-s)
(ll.dup2 cin-s 0)
(ll.dup2 cout-d 1)
(ll.dup2 cout-d 2)
(ll.execve pname argv envp)
(error "execve failed"))
(> pid 0)
(do
(ll.close cin-s)
(ll.close cout-d)))
(values pid cin-d cout-s))
(nil err) (error (.. "popen pipe out: " err)))
(nil err) (error (.. "popen pipe in: " err))))
(fn spawn [pname argv envp callback]
(let [(pid in out) (popen2 pname argv envp)
pollfds [
(bor (lshift in 32) (lshift 4 16))
(bor (lshift out 32) (lshift 1 16))
]]
(while (or (> (. pollfds 1) 0) (> (. pollfds 2) 0))
(ll.poll pollfds)
(if
(> (band (. pollfds 2) 0x11) 0) ; POLLIN | POLLHUP
(if (not (callback :out out)) (tset pollfds 2 (lshift -1 32)))
(> (band (. pollfds 1) 4) 0) ; POLLOUT
(if (not (callback :in in)) (tset pollfds 1 (lshift -1 32)))
))
(match (ll.waitpid pid)
(0 status) false
(pid status) (rshift (band status 0xff00) 8)
(nil errno) (error (.. "waitpid: " errno)))))
(define-tests
(var buf "4 * 6\n") ;; spawn bc to multiply two numbers
(let [out []
p (spawn
(assert (find-executable "bc" (os.getenv "PATH")))
["bc"]
(ll.environ)
(fn [stream fd]
(match stream
:out (let [b (ll.read fd)]
(table.insert out b)
(> (# b) 0))
:in (if (> (# buf) 0)
(let [bytes (ll.write fd buf)]
(set buf (string.sub buf (+ bytes 1) -1))
true)
(do
(ll.close fd)
false))
:err (assert nil (ll.read fd)))))]
(expect= (table.concat out) "24\n"))
)
{
: popen2
: spawn
}