03/06: substitute: Ensure backtraces go to file descriptor 4.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit ee3226e9d54891c7e696912245e4904435be191c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Feb 24 15:05:06 2021 +0100

    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'.
---
 guix/scripts/substitute.scm | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 832c82e..fcb462b 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