Display a backtrace for errors in channel->derivation-file-name

To help with debugging.
This commit is contained in:
Christopher Baines 2019-06-13 23:13:34 +01:00
parent 11144a5fe9
commit 0bd1fc7e87

View file

@ -293,61 +293,64 @@
(catch (catch
#t #t
(lambda () (lambda ()
;; /etc is only missing if open-inferior/container has been used (with-throw-handler #t
(when use-container? (lambda ()
(inferior-eval ;; /etc is only missing if open-inferior/container has been used
'(begin (when use-container?
;; Create /etc/pass, as %known-shorthand-profiles in (guix (inferior-eval
;; profiles) tries to read from this file. Because the environment '(begin
;; is cleaned in build-self.scm, xdg-directory in (guix utils) ;; Create /etc/pass, as %known-shorthand-profiles in (guix
;; falls back to accessing /etc/passwd. ;; profiles) tries to read from this file. Because the environment
(mkdir "/etc") ;; is cleaned in build-self.scm, xdg-directory in (guix utils)
(call-with-output-file "/etc/passwd" ;; falls back to accessing /etc/passwd.
(lambda (port) (mkdir "/etc")
(display "root:x:0:0::/root:/bin/bash" port)))) (call-with-output-file "/etc/passwd"
inferior)) (lambda (port)
(display "root:x:0:0::/root:/bin/bash" port))))
inferior))
(let ((channel-instance (let ((channel-instance
(first (first
(latest-channel-instances store (latest-channel-instances store
(list channel))))) (list channel)))))
(inferior-eval '(use-modules (guix channels) (inferior-eval '(use-modules (guix channels)
(guix profiles)) (guix profiles))
inferior) inferior)
(inferior-eval '(define channel-instance (inferior-eval '(define channel-instance
(@@ (guix channels) channel-instance)) (@@ (guix channels) channel-instance))
inferior) inferior)
(let ((file-name (let ((file-name
(inferior-eval-with-store (inferior-eval-with-store
inferior inferior
store store
`(lambda (store) `(lambda (store)
(let ((instances (let ((instances
(list (list
(channel-instance (channel-instance
(channel (name ',(channel-name channel)) (channel (name ',(channel-name channel))
(url ,(channel-url channel)) (url ,(channel-url channel))
(branch ,(channel-branch channel)) (branch ,(channel-branch channel))
(commit ,(channel-commit channel))) (commit ,(channel-commit channel)))
,(channel-instance-commit channel-instance) ,(channel-instance-commit channel-instance)
,(channel-instance-checkout channel-instance))))) ,(channel-instance-checkout channel-instance)))))
(run-with-store store (run-with-store store
(mlet* %store-monad ((manifest (channel-instances->manifest instances)) (mlet* %store-monad ((manifest (channel-instances->manifest instances))
(derv (profile-derivation manifest))) (derv (profile-derivation manifest)))
(mbegin %store-monad (mbegin %store-monad
(return (derivation-file-name derv)))))))))) (return (derivation-file-name derv))))))))))
(close-inferior inferior) (close-inferior inferior)
file-name))) file-name)))
(lambda (key . parameters)
(display (backtrace) (current-error-port))
(display "\n" (current-error-port))
(simple-format (current-error-port)
"error: channel->derivation-file-name: ~A: ~A\n"
key parameters))))
(lambda args (lambda args
(simple-format (current-error-port)
"error: channel->derivation-file-name: ~A\n"
args)
(close-inferior inferior) (close-inferior inferior)
#f)))) #f))))
(define (channel->manifest-store-item store channel) (define (channel->manifest-store-item store channel)