system-asterisk-stdout-to-stderr-redirection-bug.scm 3.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091
  1. ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835
  2. ;; redirect sdterr to stdout workaround used by GNU Guix:
  3. ;; https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/installer/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n87
  4. ;; Test scenario for showing the bug from
  5. ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835:
  6. (call-with-output-file "/tmp/test.log"
  7. (λ (port)
  8. ;; Write both, output and errors to the file output
  9. ;; port.
  10. (with-output-to-port port
  11. (λ ()
  12. (with-error-to-port port
  13. (λ ()
  14. ;; echo "bong" to stderr, which is set to the
  15. ;; port, which writes to the output file at
  16. ;; "/tmp/test.log". Afterwards the file at
  17. ;; "/tmp/test.log" should contain "bong".
  18. (system* "bash" "-c" "echo bong >&2")))))))
  19. ;; Now lets see what is in the file:
  20. (define* (get-string-from-file filename #:key (encoding "UTF-8"))
  21. (call-with-input-file filename
  22. (λ (port)
  23. (set-port-encoding! port encoding)
  24. (get-string-all port))))
  25. (display
  26. (simple-format
  27. #f "~a\n"
  28. (get-string-from-file "/tmp/test.log")))
  29. ;; The file is empty! Something with (system* ...) does not
  30. ;; seem to handle stdout redirection to stderr correctly.
  31. ;; Also from the bug report another test case:
  32. (with-error-to-port (current-output-port)
  33. (lambda ()
  34. ;; $$ in GNU Bash is the process id.
  35. (system* "bash" "-c" "echo $$; sleep 10")))
  36. ;; "you can actually inspect `/proc/<PID>/fd/` and see that
  37. ;; the stderr fd, 2, is actually closed. This means that the
  38. ;; next opened fd will take its place, to which writes to
  39. ;; stderr may end up."
  40. ;; -- https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835
  41. ;; There is a workaround for the bug, used in GNU Guix
  42. ;; source code at
  43. ;; https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/installer/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n87
  44. ;; posted by dev@jpoiret.xyz on the Guile user mailing list:
  45. (match-let (((input . output) (pipe)))
  46. ;; Hack to work around Guile bug 52835 -- How does
  47. ;; duplicating the port help? From the docs: "Returns a
  48. ;; new port which is opened on a duplicate of the file
  49. ;; descriptor underlying port, with mode string modes as
  50. ;; for open-file. The two ports will share a file position
  51. ;; and file status flags. [...]"
  52. (define dup-output (duplicate-port output "w"))
  53. ;; Void pipe, but holds the pid for close-pipe.
  54. (define dummy-pipe
  55. ;; Set current-input-port to /dev/null. -- What will be
  56. ;; read from there? Nothing?
  57. (with-input-from-file "/dev/null"
  58. (lambda ()
  59. ;; Set the current-output-port to the one created
  60. ;; above using (pipe).
  61. (with-output-to-port output
  62. (lambda ()
  63. ;; Set the error port to the duplicated output
  64. ;; port. This might be the redirection of stderr
  65. ;; to stdout.
  66. (with-error-to-port dup-output
  67. (lambda ()
  68. ;; Run open-file*, but why is there an empty
  69. ;; string prepended to command? Perhaps to
  70. ;; allow using either a list or a string as
  71. ;; a command?
  72. (apply open-pipe* (cons "" command)))))))))
  73. (close-port output)
  74. (close-port dup-output)
  75. (handler input)
  76. (close-port input)
  77. (close-pipe dummy-pipe))