diff options
Diffstat (limited to 'guix/scripts/substitute.scm')
| -rwxr-xr-x | guix/scripts/substitute.scm | 28 |
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 |