123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180 |
- ;;; ABOUT
- ;; The examples in this document were posted on the Guile
- ;; user mailing list and are not originally written by me
- ;; zelphirkaltstahl@posteo.de.
- ;; Comments, some formatting and editing by me
- ;; (zelphirkaltstahl@posteo.de).
- ;;; PIPES
- ;; For process communication pipes are useful. A pipe is a
- ;; pair of 2 ports. An input port and an output port. With
- ;; such ports it is possible for a process to output
- ;; messages to the output port, which in turn enables the
- ;; parent process (or anyone else with a handle on the input
- ;; port) to read those messages from the input port of the
- ;; pair of ports. The ports are coupled together as such,
- ;; making a pipe.
- ;; The official docs are at:
- ;; https://www.gnu.org/software/guile/manual/html_node/Ports-and-File-Descriptors.html#index-pipe-2
- ;; Some of the used procedures are for dealing with
- ;; ports. Official documentation about ports is at:
- ;; https://www.gnu.org/software/guile/manual/html_node/Ports-and-File-Descriptors.html
- ;; There are also procedures for dealing with textual IO and ports,
- ;; documented at:
- ;; https://www.gnu.org/software/guile/manual/html_node/Textual-I_002fO.html
- ;; The following code is adapted from a post on the Guile
- ;; user mailing list, posted by post@thomasdanckaert.be and
- ;; is part of
- ;; https://github.com/tdanckaert/jobview/blob/master/jobtools.scm#L38.
- (import (ice-9 popen)
- (ice-9 textual-ports)
- (ice-9 exceptions)
- (ice-9 receive)
- (ice-9 match))
- (define process-output
- (λ (proc cmd)
- "Runs CMD as an external process, with an input port from which
- the process' stdout may be read, and runs the procedure PROC. PROC
- takes as input the input port, from which is can read the output of
- the command, as a single argument and processes it in any way.
- Throws an exception 'cmd-failed if CMD's exit-code is non-zero."
- ;; Bind some ports for error messaging and handling.
- (match-let (;; Create a pipe, which consists of 2 ports,
- ;; an input and an output port. These are
- ;; meant for error messages. Extract input
- ;; port and output port via pattern matching
- ;; from the pair which (pipe)
- ;; returns. err-read is an input port
- ;; err-write is an output port.
- [(err-read . err-write) (pipe)]
- ;; Alias the current error port to use
- ;; later.
- [stderr (current-error-port)])
- ;; Create a context or scope, in which the error port
- ;; is set to the output port of the pipe. This will
- ;; enable to read the errors from the input port, once
- ;; they have been written to the output port.
- (with-error-to-port err-write
- (λ ()
- (let* (;; open-input-pipe is the same as open-pipe
- ;; with mode OPEN_READ. open-pipe runs a
- ;; command in a child process. More
- ;; precisely it runs the command as
- ;; argument to '/bin/sh -c'. The OPEN_READ
- ;; mode makes it so that the return value
- ;; is an input port, from which one can
- ;; read the output of the command. The call
- ;; to open-input-pipe is the actual call
- ;; running the command.
- [port (open-input-pipe cmd)]
- ;; Set the buffer behavior of the port to
- ;; block buffered. For more detail read:
- ;; https://www.gnu.org/software/guile/manual/html_node/Buffering.html. Line
- ;; buffered might also make sense for
- ;; running commands and getting their
- ;; output. However, a line can also be very
- ;; long, so maybe block buffered is more
- ;; generally applicable.
- [_ignored (setvbuf port 'block)]
- ;; Apply the given procedure PROC to the
- ;; port. The procedure must expect an input
- ;; port as an argument, from which it
- ;; reads.
- [processed-output
- ;; Error handling using Guile's catch
- ;; procedure. catch is given 2 lambda
- ;; expressions. One to evaluate in any
- ;; case, and a second one to handle
- ;; errors, if any happen, during the
- ;; evaluation of the first lambda
- ;; expression.
- ;; The argument #t specifies, that
- ;; whatever the key of any raised
- ;; exception is, it will be handled by the
- ;; second lambda expression.
- ;; This exception handling deals with
- ;; errors, that originate from applying
- ;; the output processor, not with
- ;; exceptions from running the command
- ;; itself.
- (catch #t
- ;; Catch any exception thrown by applying PROC to
- ;; the output of CMD: if CMD fails, we check the
- ;; exit-code below; if CMD succeeds, PROC must be
- ;; able to deal with its output.
- (λ () (proc port))
- ;; Exception handling procedure. It
- ;; takes the key of the exception, which
- ;; is a symbol, and an arbitrary number
- ;; of other arguments.
- (λ (key . args)
- ;; To handle any error, output to the
- ;; stderr of the outer context, as
- ;; stderr was bound earlier. This
- ;; might not be actually handling an
- ;; exception at all, but at least
- ;; tells us, that something has gone
- ;; wrong.
- (format stderr "Caught exception ~a from ~y~%" key proc)))]
- ;; Finally, close the port and retrieve the
- ;; exit-code, which is the exit code of the
- ;; command, which was run with '/bin/sh
- ;; -c'.
- [exit-code (close-pipe port)])
- ;; Close the port, to which the child process
- ;; was to write errors, as the child process has
- ;; finished (either successfully or
- ;; unsuccessfully, but definitely finished).
- (close-port err-write)
- ;; If the exit code was non-zero, get the output
- ;; by reading from the err-read port, which is
- ;; the corresponding input port of the initially
- ;; created pipe.
- (display (simple-format #f "~a\n" "checking the exit code"))
- (cond
- [(zero? exit-code)
- (values exit-code processed-output)]
- [else
- (let ([error-message (get-string-all err-read)])
- (values exit-code error-message))])))))))
- ;; Example output processor
- (define output-processor
- (λ (in-port)
- (display
- (simple-format
- #f "~a\n"
- (get-string-all in-port)))))
- (define output-identity
- (λ (in-port)
- (get-string-all in-port)))
- ;; Example usage:
- (receive (exit-code output)
- (process-output output-identity "ls -al")
- (display (simple-format #f "exit code: ~a\n" exit-code))
- (display (simple-format #f "output: ~a\n" output)))
- (receive (exit-code output)
- (process-output output-identity "lsaas -alasdasd")
- (display (simple-format #f "exit code: ~a\n" exit-code))
- (display (simple-format #f "output: ~a\n" output)))
|