substitute: Ensure backtraces go to file descriptor 4.

Fixes <https://bugs.gnu.org/46362>.
Reported by Zhu Zihao <all_but_last@163.com>.

Previously, backtraces due to uncaught exceptions would always to go
file descriptor 2; the daemon would read it and error out with something
like:

  error: got unexpected path `Backtrace:' from substituter

This patch fixes that by ensuring backtraces are properly displayed on
file descriptor 4.

* guix/scripts/substitute.scm (with-redirected-error-port): New macro.
(guix-substitute): Use 'with-redirected-error-port' instead of 'parameterize'.

1 files changed, 20 insertions, 8 deletions

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 832c82e4fa..fcb462b47b 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -896,6 +896,24 @@ default value."
   ;; 'guix-daemon' expects.
   (make-parameter #t))
 
+;; The daemon's agent code opens file descriptor 4 for us and this is where
+;; stderr should go.
+(define-syntax-rule (with-redirected-error-port exp ...)
+  "Evaluate EXP... with the current error port redirected to file descriptor 4
+if needed, as expected by the daemon's agent."
+  (let ((thunk (lambda () exp ...)))
+    (if (%error-to-file-descriptor-4?)
+        (parameterize ((current-error-port (fdopen 4 "wl")))
+          ;; Redirect diagnostics to file descriptor 4 as well.
+          (guix-warning-port (current-error-port))
+
+          ;; 'with-continuation-barrier' captures the initial value of
+          ;; 'current-error-port' to report backtraces in case of uncaught
+          ;; exceptions.  Without it, backtraces would be printed to FD 2,
+          ;; thereby confusing the daemon.
+          (with-continuation-barrier thunk))
+        (thunk))))
+
 (define-command (guix-substitute . args)
   (category internal)
   (synopsis "implement the build daemon's substituter protocol")
@@ -910,14 +928,7 @@ default value."
   (define deduplicate?
     (find-daemon-option "deduplicate"))
 
-  ;; The daemon's agent code opens file descriptor 4 for us and this is where
-  ;; stderr should go.
-  (parameterize ((current-error-port (if (%error-to-file-descriptor-4?)
-                                         (fdopen 4 "wl")
-                                         (current-error-port))))
-    ;; Redirect diagnostics to file descriptor 4 as well.
-    (guix-warning-port (current-error-port))
-
+  (with-redirected-error-port
     (mkdir-p %narinfo-cache-directory)
     (maybe-remove-expired-cache-entries %narinfo-cache-directory
                                         cached-narinfo-files
@@ -982,6 +993,7 @@ default value."
 
 ;;; Local Variables:
 ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
+;;; eval: (put 'with-redirected-error-port 'scheme-indent-function 0)
 ;;; End:
 
 ;;; substitute.scm ends here