status: Be more defensive when looking for a log file.

* guix/store.scm (derivation-log-file): New procedure.o
(log-file): Use it.
* guix/status.scm (print-build-event): Use 'derivation-log-file' instead
of 'log-file'.  Check wheter the return value is #f.
This commit is contained in:
Ludovic Courtès 2018-09-28 23:19:13 +02:00
parent 258a6d944e
commit fb94d82bc2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 25 additions and 17 deletions

View file

@ -24,10 +24,7 @@ (define-module (guix status)
#:autoload (guix build syscalls) (terminal-columns)
#:use-module ((guix build download)
#:select (nar-uri-abbreviation))
#:use-module ((guix store)
#:select (current-build-output-port
current-store-protocol-version
log-file))
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
@ -334,8 +331,13 @@ (define print-log-line
(('build-failed drv . _)
(format port (failure (G_ "build of ~a failed")) drv)
(newline port)
(format port (info (G_ "View build log at '~a'.~%"))
(log-file #f drv)))
(match (derivation-log-file drv)
(#f
(format port (failure (G_ "Could not find build log for '~a'."))
drv))
(log
(format port (info (G_ "View build log at '~a'.")) log)))
(newline port))
(('substituter-started item _ ...)
(when (or print-log? (not (extended-build-trace-supported?)))
(format port (info (G_ "substituting ~a...")) item)

View file

@ -152,6 +152,7 @@ (define-module (guix store)
store-path-package-name
store-path-hash-part
direct-store-path
derivation-log-file
log-file))
(define %protocol-version #x162)
@ -1706,21 +1707,26 @@ (define (store-path-hash-part path)
(and (string-every %nix-base32-charset hash)
hash))))))
(define (derivation-log-file drv)
"Return the build log file for DRV, a derivation file name, or #f if it
could not be found."
(let* ((base (basename drv))
(log (string-append (dirname %state-directory) ; XXX
"/log/guix/drvs/"
(string-take base 2) "/"
(string-drop base 2)))
(log.gz (string-append log ".gz"))
(log.bz2 (string-append log ".bz2")))
(cond ((file-exists? log.gz) log.gz)
((file-exists? log.bz2) log.bz2)
((file-exists? log) log)
(else #f))))
(define (log-file store file)
"Return the build log file for FILE, or #f if none could be found. FILE
must be an absolute store file name, or a derivation file name."
(cond ((derivation-path? file)
(let* ((base (basename file))
(log (string-append (dirname %state-directory) ; XXX
"/log/guix/drvs/"
(string-take base 2) "/"
(string-drop base 2)))
(log.gz (string-append log ".gz"))
(log.bz2 (string-append log ".bz2")))
(cond ((file-exists? log.gz) log.gz)
((file-exists? log.bz2) log.bz2)
((file-exists? log) log)
(else #f))))
(derivation-log-file file))
(else
(match (valid-derivers store file)
((derivers ...)