12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091 |
- ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835
- ;; redirect sdterr to stdout workaround used by GNU Guix:
- ;; https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/installer/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n87
- ;; Test scenario for showing the bug from
- ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835:
- (call-with-output-file "/tmp/test.log"
- (λ (port)
- ;; Write both, output and errors to the file output
- ;; port.
- (with-output-to-port port
- (λ ()
- (with-error-to-port port
- (λ ()
- ;; echo "bong" to stderr, which is set to the
- ;; port, which writes to the output file at
- ;; "/tmp/test.log". Afterwards the file at
- ;; "/tmp/test.log" should contain "bong".
- (system* "bash" "-c" "echo bong >&2")))))))
- ;; Now lets see what is in the file:
- (define* (get-string-from-file filename #:key (encoding "UTF-8"))
- (call-with-input-file filename
- (λ (port)
- (set-port-encoding! port encoding)
- (get-string-all port))))
- (display
- (simple-format
- #f "~a\n"
- (get-string-from-file "/tmp/test.log")))
- ;; The file is empty! Something with (system* ...) does not
- ;; seem to handle stdout redirection to stderr correctly.
- ;; Also from the bug report another test case:
- (with-error-to-port (current-output-port)
- (lambda ()
- ;; $$ in GNU Bash is the process id.
- (system* "bash" "-c" "echo $$; sleep 10")))
- ;; "you can actually inspect `/proc/<PID>/fd/` and see that
- ;; the stderr fd, 2, is actually closed. This means that the
- ;; next opened fd will take its place, to which writes to
- ;; stderr may end up."
- ;; -- https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835
- ;; There is a workaround for the bug, used in GNU Guix
- ;; source code at
- ;; https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/installer/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n87
- ;; posted by dev@jpoiret.xyz on the Guile user mailing list:
- (match-let (((input . output) (pipe)))
- ;; Hack to work around Guile bug 52835 -- How does
- ;; duplicating the port help? From the docs: "Returns a
- ;; new port which is opened on a duplicate of the file
- ;; descriptor underlying port, with mode string modes as
- ;; for open-file. The two ports will share a file position
- ;; and file status flags. [...]"
- (define dup-output (duplicate-port output "w"))
- ;; Void pipe, but holds the pid for close-pipe.
- (define dummy-pipe
- ;; Set current-input-port to /dev/null. -- What will be
- ;; read from there? Nothing?
- (with-input-from-file "/dev/null"
- (lambda ()
- ;; Set the current-output-port to the one created
- ;; above using (pipe).
- (with-output-to-port output
- (lambda ()
- ;; Set the error port to the duplicated output
- ;; port. This might be the redirection of stderr
- ;; to stdout.
- (with-error-to-port dup-output
- (lambda ()
- ;; Run open-file*, but why is there an empty
- ;; string prepended to command? Perhaps to
- ;; allow using either a list or a string as
- ;; a command?
- (apply open-pipe* (cons "" command)))))))))
- (close-port output)
- (close-port dup-output)
- (handler input)
- (close-port input)
- (close-pipe dummy-pipe))
|