pkgs/anoia/Makefile

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

pkgs/anoia/default.nix

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

pkgs/anoia/fs.fnl

@@ -1,5 +1,4 @@
 (local ll (require :lualinux))
-(import-macros { :  define-tests : expect : expect= } :anoia.assert)
 
 (local S_IFMT   0xf000)
 (local S_IFSOCK 0xc000)
@@ -66,22 +65,29 @@
     unknown
     (error (.. "can't remove " pathname " of mode \"" unknown "\""))))
 
-;; lualinux doesn't publish access(2), this is not exactly
+(fn popen2 [pname argv envp]
-;; the same but will suffice until we can add it
+  (case (ll.pipe2)
-(fn executable? [f]
+    (cin-s cin-d)
-  (let [statbuf {}
+    (match (ll.pipe2)
-        stat (ll.lstat f statbuf 1)]
+      (cout-s cout-d)
-    (and stat (> (band (. stat 3) 73) 0)))) ; \0111
+      (let [(pid err) (ll.fork)]
-
+        (if (not pid) (error (.. "error: " err))
-(fn find-executable [exe search-path]
+            (= pid 0)
-  (accumulate [full-path nil
+            (do
-               p (string.gmatch search-path "(.-):")]
+              (ll.close cin-d)
-    (or full-path (let [f (.. p "/" exe)] (and (executable? f) f)))))
+              (ll.close cout-s)
-
+              (ll.dup2 cin-s 0)
-(define-tests
+              (ll.dup2 cout-d 1)
-  (let [p (find-executable "yes" (os.getenv "PATH"))]
+              (ll.dup2 cout-d 2)
-    (expect (string.match p "coreutils.+bin/yes$"))))
+              (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))))
 
 {
  : mktree
@@ -89,6 +95,6 @@
  : directory?
  : dir
  : file-type
- : find-executable
+ : popen2
  :symlink (fn [from to] (ll.symlink from to))
  }

pkgs/anoia/process.fnl

@@ -1,84 +0,0 @@
-(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
- }

pkgs/tangc/tangc.fnl

@@ -1,32 +1,41 @@
 (local json (require :json))
 (local http (require :fetch))
 (local { : base64  : %%} (require :anoia))
-(local { : spawn } (require :anoia.process))
+(local { : popen2 } (require :anoia.fs))
-(local { : find-executable } (require :anoia.fs))
 (local ll (require :lualinux))
 
 (local CLEVIS_DEFAULT_THP_LEN 43)        ;  Length of SHA-256 thumbprint.
 (local thumbprint-algs ["S256" "S1"])
 
+(fn exited [pid]
+  (match (ll.waitpid pid)
+    (0 status) false
+    (pid status) (rshift (band status 0xff00) 8)
+    (nil errno) (error (.. "waitpid: " errno))))
+
+(fn write-all [fd str]
+  (let [written (ll.write fd str)]
+    (if (< written (# str))
+        (write-all fd (string.sub str (+ written 1) -1)))))
+
+(fn read-all [fd]
+  (let [buf (ll.read fd)]
+    (if (> (# buf) 0) (.. buf (read-all fd)) buf)))
+
 (fn jose [params inputstr]
-  (var buf inputstr)
   (let [env (ll.environ)
         argv (doto params (table.insert 1 "jose"))
-        output []
+        (pid in out) (popen2 (os.getenv "JOSE_BIN") argv env)]
-        exitstatus
+    ;; be careful if using this code for commands othert than jose: it
-        (spawn
+    ;; may deadlock if we write more than 8k and the command doesn't
-         (find-executable "jose" (os.getenv "PATH")) argv envp
+    ;; read it.
-         (fn [stream fd]
+    (when inputstr (write-all in inputstr))
-           (match stream
+    (ll.close in)
-             :out (let [b (ll.read fd)]
+    (let [output
-                    (if (> (# b) 0)
+          (accumulate [o ""
-                        (do (table.insert output b) true)
+                       buf #(match (read-all out) "" nil s s)]
-                        (do (ll.close fd) false)))
+            (.. o buf))]
-             :in (let [b (string.sub buf (+ 1 (ll.write fd buf)) -1)]
+      (values (exited pid) output))))
-                   (if (> (# b) 0)
-                       (do (set buf b) true)
-                       (do (ll.close fd) false))))))]
-    (values exitstatus (table.concat output))))
 
 (fn jose! [params inputstr]
   (let [(exitcode out) (jose params inputstr)]

pkgs/watch-outputs/watch-outputs.fnl

@@ -1,5 +1,6 @@
 (local { : %% : system : assoc : split : table= : dig } (require :anoia))
 (local svc (require :anoia.svc))
+(local { : view } (require :fennel))
 (local { : kill } (require :lualinux))
 
 (fn split-paths [paths]
@@ -44,6 +45,7 @@
     (accumulate [tree (service:output ".")
                  v (service:events)]
       (let [new-tree (service:output ".")]
+        (print :was (view tree) :now (view new-tree))
         (when (changed? paths tree new-tree)
           (print "watched path event:"  action controlled-service)
           (do-action action controlled-service))