example-03-using-popen-get-out-and-error.scm 3.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. ;;; ABOUT
  2. ;; The examples in this document were posted on the Guile
  3. ;; user mailing list and are not originally written by me
  4. ;; zelphirkaltstahl@posteo.de.
  5. ;; Comments, some formatting and editing by me
  6. ;; (zelphirkaltstahl@posteo.de).
  7. ;; The following code is adapted from a post on the Guile
  8. ;; user mailing list, posted by post@thomasdanckaert.be and
  9. ;; is part of
  10. ;; https://github.com/tdanckaert/jobview/blob/master/jobtools.scm#L38.
  11. (import (ice-9 popen)
  12. (ice-9 textual-ports)
  13. (ice-9 exceptions)
  14. (ice-9 receive)
  15. (ice-9 match))
  16. ;; Removed comments to shorting this example. For more
  17. ;; explanation see the first example.
  18. (define run-command
  19. (λ (cmd)
  20. "Runs CMD as an external process, with an input port
  21. from which the process' stdout may be read."
  22. (match-let ([(err-read . err-write) (pipe)]
  23. [stderr (current-error-port)])
  24. (with-error-to-port err-write
  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. ;; Get command output and error output.
  36. [command-output (get-string-all in-port)]
  37. ;; Get the exit code of the command.
  38. [exit-code (close-pipe in-port)])
  39. ;; Close the port, to which the child process
  40. ;; was to write errors, as the child process has
  41. ;; finished (either successfully or
  42. ;; unsuccessfully, but definitely finished).
  43. (close-port err-write)
  44. (let (;; Get the error message, if there is any.
  45. [error-message (get-string-all err-read)])
  46. (values exit-code
  47. command-output
  48. error-message))))))))
  49. (receive (exit-code command-output error-message)
  50. (let ([command "echo 'bong' 1>&2"])
  51. (run-command command))
  52. (display (simple-format #f "exit code: ~a\n" exit-code))
  53. (unless (string-null? command-output)
  54. (display (simple-format #f "command-output: \n~a" command-output)))
  55. (unless (string-null? error-message)
  56. (display (simple-format #f "error-message: \n~a" error-message))))
  57. (receive (exit-code command-output error-message)
  58. (let ([command "ls -al"])
  59. (run-command command))
  60. (display (simple-format #f "exit code: ~a\n" exit-code))
  61. (unless (string-null? command-output)
  62. (display (simple-format #f "command-output: \n~a" command-output)))
  63. (unless (string-null? error-message)
  64. (display (simple-format #f "error-message: \n~a" error-message))))
  65. ;; Both, output and error:
  66. (receive (exit-code command-output error-message)
  67. (let ([command "ls -al 2>&1 && echo 'bong' 1>&2"])
  68. (run-command command))
  69. (display (simple-format #f "exit code: ~a\n" exit-code))
  70. (unless (string-null? command-output)
  71. (display (simple-format #f "command-output: \n~a" command-output)))
  72. (unless (string-null? error-message)
  73. (display (simple-format #f "error-message: \n~a" error-message))))
  74. ;; With failing command:
  75. (receive (exit-code command-output error-message)
  76. (let ([command "lsasdasd -al"])
  77. (run-command command))
  78. (display (simple-format #f "exit code: ~a\n" exit-code))
  79. (unless (string-null? command-output)
  80. (display (simple-format #f "command-output: \n~a" command-output)))
  81. (unless (string-null? error-message)
  82. (display (simple-format #f "error-message: \n~a" error-message))))