liminix

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

process.fnl (2537B)

      1 (local ll (require :lualinux))
      2 (local { : find-executable } (require :anoia.fs))
      3 (import-macros { : define-tests : expect : expect= } :anoia.assert)
      4 
      5 (macro errno-check [x]
      6   `(match ,x
      7      val# val#
      8      (nil errno#) (assert nil (.. "system call failed, errno=" errno#))
      9      ))
     10 
     11 (fn popen2 [pname argv envp]
     12   (case (ll.pipe2)
     13     (cin-s cin-d)
     14     (match (ll.pipe2)
     15       (cout-s cout-d)
     16       (let [(pid err) (ll.fork)]
     17         (if (not pid) (error (.. "error: " err))
     18             (= pid 0)
     19             (do
     20               (ll.close cin-d)
     21               (ll.close cout-s)
     22               (ll.dup2 cin-s 0)
     23               (ll.dup2 cout-d 1)
     24               (ll.dup2 cout-d 2)
     25               (ll.execve pname argv envp)
     26               (error "execve failed"))
     27             (> pid 0)
     28             (do
     29               (ll.close cin-s)
     30               (ll.close cout-d)))
     31         (values pid cin-d cout-s))
     32       (nil err) (error (.. "popen pipe out: " err)))
     33     (nil err) (error (.. "popen pipe in: " err))))
     34 
     35 (fn spawn [pname argv envp callback]
     36   (let [(pid in out) (popen2 pname argv envp)
     37         pollfds [
     38                  (bor (lshift in 32) (lshift 4 16))
     39                  (bor (lshift out 32) (lshift 1 16))
     40                  ]]
     41     (while (or (> (. pollfds 1) 0) (> (. pollfds 2) 0))
     42       (ll.poll pollfds)
     43       (if
     44        (> (band (. pollfds 2) 0x11) 0)  ; POLLIN | POLLHUP
     45        (if (not (callback :out out)) (tset pollfds 2 (lshift -1 32)))
     46 
     47        (> (band (. pollfds 1) 4) 0)     ; POLLOUT
     48        (if (not (callback :in in)) (tset pollfds 1 (lshift -1 32)))
     49        ))
     50 
     51     (match (ll.waitpid pid)
     52       (0 status) false
     53       (pid status) (rshift (band status 0xff00) 8)
     54       (nil errno) (error (.. "waitpid: " errno)))))
     55 
     56 
     57 (define-tests
     58   (var buf "4 * 6\n")                   ;; spawn bc to multiply two numbers
     59   (let [out []
     60         p (spawn
     61            (assert (find-executable "bc" (os.getenv "PATH")))
     62            ["bc"]
     63            (ll.environ)
     64            (fn [stream fd]
     65              (match stream
     66                :out (let [b (ll.read fd)]
     67                       (table.insert out b)
     68                       (> (# b) 0))
     69                :in (if (> (# buf) 0)
     70                        (let [bytes (ll.write fd buf)]
     71                          (set buf (string.sub buf (+ bytes 1) -1))
     72                          true)
     73                        (do
     74                          (ll.close fd)
     75                          false))
     76                :err (assert nil (ll.read fd)))))]
     77     (expect= (table.concat out) "24\n"))
     78   )
     79 
     80 
     81 {
     82  : popen2
     83  : spawn
     84  }