1 ;; Utility module for coprocesses in newlisp
3 ;; This is a convenience implementation for running a sub process with
4 ;; its stdio via pipes. It is somewhat similar to the standard
5 ;; <process> function but the <coproc> utility combines the process
6 ;; PID together with its stdin/stdout into a FOOP object for onwards
7 ;; interactions. The <coproc> command is passed as a command line to
8 ;; /bin/sh and allows passing in environment. Further, the startup
9 ;; includes closing the unused file descriptors.
11 ;; @syntax: (coproc cmd [ env ] )
12 ;; Start a coprocess and returns its representation which is a FOOP
13 ;; object: ([coproc] PID outfd infd)
15 ;; The given <cmd> command is passed to "sh -c 'cmd'" sub process
16 ;; through a fork+execve scheme. The <env> argument should be a
17 ;; pointer to a null-terminated array of pointers to environment
18 ;; NUL-terminated strings of format "NAME=VALUE". (The caller must
19 ;; take care of providing existing pointers.
21 ;; @syntax: (:put0 coproc str )
22 ;; Write <str> to the given <coproc>. Returns the number of bytes
25 ;; @syntax: (:puts coproc str )
26 ;; Write <str> followed by newline to the given <coproc>. Returns the
27 ;; number of bytes written.
29 ;; @syntax: (:gets coproc [ limit [ waitms ]] )
30 ;; Read one line from the given <coproc> or up to <limit> bytes
31 ;; (default 100000) with up to <waitms> millisceonds delay (default
32 ;; 100) before reading.
34 ;; @syntax: (:pug coproc str [ limit [ waitms ]] )
35 ;; Write <str> with :puts, then read once with :gets and return that.
37 ;; @syntax: (:pugs coproc str [ limit [ waitms ]] )
38 ;; Write <str> with :puts, then read repeatedly with :gets collating
39 ;; its returned lines into a list until :gets retuns nil. Returns the
42 ;; @syntax: (:running? coproc [ timeout ])
43 ;; Check if coproc is running, i.e., that its stdin is still open.
47 (constant 'LIBC6 "/lib/x86_64-linux-gnu/libc.so.6")
48 (import LIBC6 "execve" "int"
53 (import LIBC6 "dup2" "int"
57 (import LIBC6 "poll" "int"
58 "void*" ; struct pollfd *fds
65 ; <environ> is a 64-bit char** variable, rather than a function
66 (import LIBC6 "environ")
68 ; Return the 64-bit value of environ
69 (define (environ@) ((unpack "Lu" (address environ)) 0))
71 ; Pack a list of void* pointers into an array with a final null
73 (define (pack-ptrs PTRS)
74 (pack (dup "Lu" (+ 1 (length PTRS))) (append PTRS (list 0))))
76 ; Prepare the binary data setup for calling execve to execute <cmd>
77 ; via "sh -c 'exec <cmd>'" and the given environment <ENV>. If <ENV>
78 ; is <true>, then the current process environment is used, otherwise
79 ; it should be a list of name-value pairs (strings).
80 (define (wrapper cmd IO ENV)
81 (letn ((ARGS (list "/bin/sh" "-c" (string "exec " cmd)))
82 (ARGV (pack-ptrs (find-all nil ARGS (address $it) !=)))
83 (EV (if (list? ENV) (map (curry format "%s=%s") ENV)))
84 (ENVP (if (= true ENV) (environ@)
85 EV (pack-ptrs (find-all nil EV (address $it) !=))))
87 (map dup2 (list (IO 0 0) (IO 1 1) (IO 1 1)) '(0 1 2))
89 (execve "/bin/sh" ARGV (or ENVP 0))
92 ; Create a coproc FOOP object which holds PID and pipe ends.
93 (define (coproc:coproc cmd ENV)
94 (let ((IO (list (pipe) (pipe))))
96 (fork (wrapper cmd IO ENV))
97 (begin (close (IO 0 0)) (close (IO 1 1)) (IO 0 1))
100 ; Wait up to <waitms> for input from the coproc, then read one line of
101 ; up to <limit> bytes and return. The final newline, if any, is
103 (define (gets limit waitms)
105 (delay (if (number? waitms) (* waitms 1000) 100000))
106 (maxsize (if (number? limit) limit 1000000))
108 (and (net-select (self 3) "r" delay)
109 (read (self 3) buffer maxsize "\n")
110 (if (empty? buffer) buffer
111 (!= "\n" (buffer -1)) buffer
115 ; Write <str> to the coproc.
117 (write (self 2) str (length str)))
119 ; Write <str> to the coproc plus a newline.
121 (write-line (self 2) str (length str)))
123 ; First :puts, then :gets
124 (define (pug str limit waitms) (puts str) (gets limit waitms))
126 ; First :puts, then collect :gets until nil
127 (define (pugs str limit waitms) (puts str) (collect (gets limit waitms)))
129 ; Poll the stdin pipe
130 (define (running? (timeout 1))
131 (let ((FDS (pack "Lu" (self 2))))
132 (>= 0 (poll FDS 1 timeout))))