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

View File

@ -152,6 +152,7 @@
store-path-package-name store-path-package-name
store-path-hash-part store-path-hash-part
direct-store-path direct-store-path
derivation-log-file
log-file)) log-file))
(define %protocol-version #x162) (define %protocol-version #x162)
@ -1706,21 +1707,26 @@ syntactically valid store path."
(and (string-every %nix-base32-charset hash) (and (string-every %nix-base32-charset hash)
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) (define (log-file store file)
"Return the build log file for FILE, or #f if none could be found. 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." must be an absolute store file name, or a derivation file name."
(cond ((derivation-path? file) (cond ((derivation-path? file)
(let* ((base (basename file)) (derivation-log-file 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))))
(else (else
(match (valid-derivers store file) (match (valid-derivers store file)
((derivers ...) ((derivers ...)