123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102 |
- (import (ice-9 popen)
- (ice-9 textual-ports)
- (ice-9 binary-ports)
- (ice-9 exceptions)
- (ice-9 receive)
- (ice-9 match)
- (srfi srfi-11))
- (define read-from-write-to
- (lambda* (in-port out-port #:key (bytes-count 1024))
- "Read from an IN-PORT and write to OUT-PORT, BYTES-COUNT
- bytes at a time."
- (let loop ([bv (get-bytevector-n in-port bytes-count)])
- (unless (eof-object? bv)
- (put-bytevector out-port bv)
- (loop (get-bytevector-n in-port bytes-count))))))
- (define run-command
- (lambda* (cmd
- #:key
- (cmd-out-port (current-output-port))
- (err-out-port (current-error-port)))
- "Allow the user to give output port and error port to the
- function."
- (with-output-to-port cmd-out-port
- (λ ()
- (with-error-to-port err-out-port
- (λ ()
- (let* (;; Run the actual command. If an error
- ;; happens, it should write to the
- ;; err-write port. Output of the command
- ;; should be written to an output port,
- ;; which corresponds to the input-port,
- ;; which is returned by open-input-pipe.
- [in-port (open-input-pipe cmd)]
- ;; Read in block mode.
- [_ignored (setvbuf in-port 'block)])
- ;; Write to caller given command output port.
- (read-from-write-to in-port cmd-out-port)
- ;; Get the exit code of the command.
- (close-pipe in-port))))))))
- (define shell
- (lambda* (command)
- "Run a shell COMMAND. Return 3 values: (1) exit code, (2)
- command output, (3) error output."
- ;; Construct pairs of input and outout ports using
- ;; `pipe'. Whatever is written to the output port can
- ;; be read from the input port.
- (match-let ([(cmd-in . cmd-out) (pipe)]
- [(err-in . err-out) (pipe)])
- (let ([exit-code
- (run-command command
- ;; Write command output to the
- ;; out port, so that it can be
- ;; read from in port.
- #:cmd-out-port cmd-out
- ;; Write error output to the
- ;; error out port, so that it
- ;; can be read from the error in
- ;; port.
- #:err-out-port err-out)])
- ;; Do not forget to close the out port and error
- ;; out port.
- (close-port cmd-out)
- (close-port err-out)
- ;; Read the (error) output of the command and
- ;; return it.
- (let ([output-message (get-string-all cmd-in)]
- [error-message (get-string-all err-in)])
- (values exit-code
- output-message
- error-message))))))
- (let-values ([(code out err)
- (shell "echo 'bong' 1>&2")])
- (simple-format #t "code: ~a\n" code)
- (simple-format #t "out: ~a\n" out)
- (simple-format #t "err: ~a\n" err))
- (let-values ([(code out err)
- (shell "ls -al")])
- (simple-format #t "code: ~a\n" code)
- (simple-format #t "out: ~a\n" out)
- (simple-format #t "err: ~a\n" err))
- (let-values ([(code out err)
- (shell "ls -al 2>&1 && echo 'bong' 1>&2")])
- (simple-format #t "code: ~a\n" code)
- (simple-format #t "out: ~a\n" out)
- (simple-format #t "err: ~a\n" err))
- (let-values ([(code out err)
- (shell "lsasdasd -al")])
- (simple-format #t "code: ~a\n" code)
- (simple-format #t "out: ~a\n" out)
- (simple-format #t "err: ~a\n" err))
|