guile-examples/shell/example-02-using-popen-write-log-file.scm

;;; 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).

;; 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 for write output to file.
(define get-string-from-file
  (lambda* (file-path #:key (encoding "UTF-8"))
    (call-with-input-file file-path
      (λ (port)
        (set-port-encoding! port encoding)
        (get-string-all port)))))


(define make-output-to-file-processor
  (lambda* (filename #:key (encoding "UTF-8") (mode 'replace))
    ;; Return a lambda, which takes the input port to work
    ;; with the input port, from which is can read a
    ;; command's output.
    (λ (in-port)
      ;; Get the output from the input port, which will
      ;; later be written to a file.
      (let ([output (get-string-all in-port)])
        ;; Write output to a file specified by filename.
        (call-with-output-file filename
          (λ (output-port)
            (set-port-encoding! output-port encoding)
            ;; Depending on the mode of file writing, write
            ;; the output or previous file content and
            ;; output.
            (cond
             [(eq? mode 'append)
              (let* ([current-file-content
                      (get-string-from-file filename #:encoding encoding)]
                     [complete-content
                      (string-append current-file-content "\n" output)])
                (put-string output-port complete-content))]
             [(eq? mode 'replace)
              (put-string output-port output)]
             [else
              (raise-exception
               (make-exception
                (make-non-continuable-error)
                (make-exception-with-message "unrecognized file writing mode")
                (make-exception-with-irritants (list mode))
                (make-exception-with-origin 'make-output-to-file-processor)))])))))))


(define log-file-writer
  (make-output-to-file-processor "command.log" #:mode 'replace))


(receive (exit-code output)
    (process-output log-file-writer "echo 'my file content'")
  (display (simple-format #f "exit code: ~a\n" exit-code))
  (display (simple-format #f "output: ~a\n" output)))


(receive (exit-code output)
    (let ([command
           (string-join
            ;; Construct a command, which
            ;; redirects stdout to stderr.
            (list "bash" "-c" "echo bong 1>&2")
            " ")])
    (process-output log-file-writer command))
  (display (simple-format #f "exit code: ~a\n" exit-code))
  (display (simple-format #f "output: ~a\n" output)))