substitutes: Log the failing queries.

* guix/substitutes.scm (%debug?): New variable.
(handle-narinfo-response): Log the failing queries if the %debug? parameter is
set.
This commit is contained in:
Mathieu Othacehe 2022-12-28 15:19:29 +01:00
parent 62f9f34525
commit 8b665a4ff3
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -90,6 +90,16 @@ (define %narinfo-cache-directory
(string-append %state-directory "/substitute/cache")) (string-append %state-directory "/substitute/cache"))
(string-append (cache-directory #:ensure? #f) "/substitute"))) (string-append (cache-directory #:ensure? #f) "/substitute")))
(define %debug?
;; Enable debug mode by setting the GUIX_SUBSTITUTE_DEBUG environmnent
;; variable.
(make-parameter
(getenv "GUIX_SUBSTITUTE_DEBUG")))
(define-syntax-rule (debug fmt args ...)
(when (%debug?)
(format #t fmt args ...)))
(define (narinfo-cache-file cache-url path) (define (narinfo-cache-file cache-url path)
"Return the name of the local file that contains an entry for PATH. The "Return the name of the local file that contains an entry for PATH. The
entry is stored in a sub-directory specific to CACHE-URL." entry is stored in a sub-directory specific to CACHE-URL."
@ -224,6 +234,13 @@ (define (handle-narinfo-response request response port result)
(let* ((path (uri-path (request-uri request))) (let* ((path (uri-path (request-uri request)))
(hash-part (basename (hash-part (basename
(string-drop-right path 8)))) ;drop ".narinfo" (string-drop-right path 8)))) ;drop ".narinfo"
;; Log the failing queries and indicate if it failed because the
;; narinfo is being baked.
(let ((baking?
(assoc-ref (response-headers response) 'x-baking)))
(debug "could not fetch ~a~a ~a~a~%"
url path code
(if baking? " (baking)" "")))
(if len (if len
(get-bytevector-n port len) (get-bytevector-n port len)
(read-to-eof port)) (read-to-eof port))