example-04-using-popen-get-out-and-error-with-ports.scm 2.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  1. (import (ice-9 popen)
  2. (ice-9 textual-ports)
  3. (ice-9 binary-ports)
  4. (ice-9 exceptions)
  5. (ice-9 receive)
  6. (ice-9 match))
  7. (define read-from-write-to
  8. (lambda* (in-port out-port #:key (bytes-count 1024))
  9. "Read from an IN-PORT and write to OUT-PORT,
  10. BYTES-COUNT bytes at a time."
  11. (let loop ([bv (get-bytevector-n in-port bytes-count)])
  12. (unless (eof-object? bv)
  13. (put-bytevector out-port bv)
  14. (loop (get-bytevector-n in-port bytes-count))))))
  15. ;; Trying to allow the user to give output port and error
  16. ;; port to the function. But how to elegantly call it then?
  17. (define run-command
  18. (lambda* (cmd
  19. #:key
  20. (cmd-out-port (current-output-port))
  21. (err-out-port (current-error-port)))
  22. (with-output-to-port cmd-out-port
  23. (λ ()
  24. (with-error-to-port err-out-port
  25. (λ ()
  26. (let* (;; Run the actual command. If an error
  27. ;; happens, it should write to the
  28. ;; err-write port. Output of the command
  29. ;; should be written to an output port,
  30. ;; which corresponds to the input-port,
  31. ;; which is returned by open-input-pipe.
  32. [in-port (open-input-pipe cmd)]
  33. ;; Read in block mode.
  34. [_ignored (setvbuf in-port 'block)])
  35. ;; Write to caller given command output port.
  36. (read-from-write-to in-port cmd-out-port)
  37. ;; Get the exit code of the command.
  38. (close-pipe in-port))))))))
  39. (match-let ([(cmd-in . cmd-out) (pipe)]
  40. [(err-in . err-out) (pipe)])
  41. (let ([exit-code
  42. (run-command "ls -al"
  43. #:cmd-out-port cmd-out
  44. #:err-out-port err-out)])
  45. (close-port cmd-out)
  46. (close-port err-out)
  47. (let ([output-message (get-string-all cmd-in)]
  48. [error-message (get-string-all err-in)])
  49. (simple-format (current-output-port) "exit code: ~a\n" exit-code)
  50. (simple-format (current-output-port) "output message: \n~a" output-message)
  51. (simple-format (current-output-port) "error message: \n~a" error-message))))
  52. (run-command "echo 'bong' 1>&2")
  53. (run-command "ls -al")
  54. (run-command "ls -al 2>&1 && echo 'bong' 1>&2")
  55. (run-command "lsasdasd -al")