liminix

commit e604d628e31e0b31e236fadcc0b007bc3bce2788
parent e2a597589b80958442e7945e46c3f8704a16cedd
Author: Daniel Barlow <dan@telent.net>
Date:   Fri,  6 Sep 2024 00:11:33 +0100

fennel anoia.process.spawn

runs a subprocess and invokes a callback whenever its io
descriptors are ready

Diffstat:
M
pkgs/anoia/Makefile
 | 
6
+++---
M
pkgs/anoia/default.nix
 | 
3
++-
M
pkgs/anoia/fs.fnl
 | 
24
------------------------
A
pkgs/anoia/process.fnl
 | 
84
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

4 files changed, 89 insertions(+), 28 deletions(-)
diff --git a/pkgs/anoia/Makefile b/pkgs/anoia/Makefile
@@ -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 $< > $@
diff --git a/pkgs/anoia/default.nix b/pkgs/anoia/default.nix
@@ -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" ];
 
diff --git a/pkgs/anoia/fs.fnl b/pkgs/anoia/fs.fnl
@@ -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))
  }
diff --git a/pkgs/anoia/process.fnl b/pkgs/anoia/process.fnl
@@ -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
+ }