mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-23 21:17:11 -05:00
guix build: Add '--log-file'.
* guix/scripts/build.scm (show-help): Add '--log-file'. (%options): Likewise. (guix-build): Set %FILE-PORT-NAME-CANONICALIZATION. Honor '--log-file'. * tests/guix-build.sh: Add '--log-file' tests. * doc/guix.texi (Invoking guix build): Document '--log-file'.
This commit is contained in:
Ludovic Courtès
parent
eddd4077a5
commit
bf4211523b
3 changed files with 115 additions and 62 deletions
|
|
@ -1546,6 +1546,22 @@ Use the given verbosity level. @var{level} must be an integer between 0
|
|||
and 5; higher means more verbose output. Setting a level of 4 or more
|
||||
may be helpful when debugging setup issues with the build daemon.
|
||||
|
||||
@item --log-file
|
||||
Return the build log file names for the given
|
||||
@var{package-or-derivation}s, or raise an error if build logs are
|
||||
missing.
|
||||
|
||||
This works regardless of how packages or derivations are specified. For
|
||||
instance, the following invocations are equivalent:
|
||||
|
||||
@example
|
||||
guix build --log-file `guix build -d guile`
|
||||
guix build --log-file `guix build guile`
|
||||
guix build --log-file guile
|
||||
guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)'
|
||||
@end example
|
||||
|
||||
|
||||
@end table
|
||||
|
||||
Behind the scenes, @command{guix build} is essentially an interface to
|
||||
|
|
|
|||
|
|
@ -95,6 +95,8 @@ (define (show-help)
|
|||
as a garbage collector root"))
|
||||
(display (_ "
|
||||
--verbosity=LEVEL use the given verbosity LEVEL"))
|
||||
(display (_ "
|
||||
--log-file return the log file names for the given derivations"))
|
||||
(newline)
|
||||
(display (_ "
|
||||
-h, --help display this help and exit"))
|
||||
|
|
@ -161,7 +163,10 @@ (define %options
|
|||
(lambda (opt name arg result)
|
||||
(let ((level (string->number arg)))
|
||||
(alist-cons 'verbosity level
|
||||
(alist-delete 'verbosity result)))))))
|
||||
(alist-delete 'verbosity result)))))
|
||||
(option '("log-file") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'log-file? #t result)))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -235,68 +240,89 @@ (define (find-package request)
|
|||
(leave (_ "~A: unknown package~%") name))))))
|
||||
|
||||
(with-error-handling
|
||||
(let ((opts (parse-options)))
|
||||
(define package->derivation
|
||||
(match (assoc-ref opts 'target)
|
||||
(#f package-derivation)
|
||||
(triplet
|
||||
(cut package-cross-derivation <> <> triplet <>))))
|
||||
;; Ask for absolute file names so that .drv file names passed from the
|
||||
;; user to 'read-derivation' are absolute when it returns.
|
||||
(with-fluids ((%file-port-name-canonicalization 'absolute))
|
||||
(let ((opts (parse-options)))
|
||||
(define package->derivation
|
||||
(match (assoc-ref opts 'target)
|
||||
(#f package-derivation)
|
||||
(triplet
|
||||
(cut package-cross-derivation <> <> triplet <>))))
|
||||
|
||||
(parameterize ((%store (open-connection)))
|
||||
(let* ((src? (assoc-ref opts 'source?))
|
||||
(sys (assoc-ref opts 'system))
|
||||
(drv (filter-map (match-lambda
|
||||
(('expression . str)
|
||||
(derivations-from-package-expressions
|
||||
str package->derivation sys src?))
|
||||
(('argument . (? derivation-path? drv))
|
||||
(call-with-input-file drv read-derivation))
|
||||
(('argument . (? string? x))
|
||||
(let ((p (find-package x)))
|
||||
(if src?
|
||||
(let ((s (package-source p)))
|
||||
(package-source-derivation
|
||||
(%store) s))
|
||||
(package->derivation (%store) p sys))))
|
||||
(_ #f))
|
||||
opts))
|
||||
(roots (filter-map (match-lambda
|
||||
(('gc-root . root) root)
|
||||
(_ #f))
|
||||
opts)))
|
||||
(parameterize ((%store (open-connection)))
|
||||
(let* ((src? (assoc-ref opts 'source?))
|
||||
(sys (assoc-ref opts 'system))
|
||||
(drv (filter-map (match-lambda
|
||||
(('expression . str)
|
||||
(derivations-from-package-expressions
|
||||
str package->derivation sys src?))
|
||||
(('argument . (? derivation-path? drv))
|
||||
(call-with-input-file drv read-derivation))
|
||||
(('argument . (? store-path?))
|
||||
;; Nothing to do; maybe for --log-file.
|
||||
#f)
|
||||
(('argument . (? string? x))
|
||||
(let ((p (find-package x)))
|
||||
(if src?
|
||||
(let ((s (package-source p)))
|
||||
(package-source-derivation
|
||||
(%store) s))
|
||||
(package->derivation (%store) p sys))))
|
||||
(_ #f))
|
||||
opts))
|
||||
(roots (filter-map (match-lambda
|
||||
(('gc-root . root) root)
|
||||
(_ #f))
|
||||
opts)))
|
||||
|
||||
(show-what-to-build (%store) drv
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||
#:dry-run? (assoc-ref opts 'dry-run?))
|
||||
(unless (assoc-ref opts 'log-file?)
|
||||
(show-what-to-build (%store) drv
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||
#:dry-run? (assoc-ref opts 'dry-run?)))
|
||||
|
||||
;; TODO: Add more options.
|
||||
(set-build-options (%store)
|
||||
#:keep-failed? (assoc-ref opts 'keep-failed?)
|
||||
#:build-cores (or (assoc-ref opts 'cores) 0)
|
||||
#:fallback? (assoc-ref opts 'fallback?)
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||
#:max-silent-time (assoc-ref opts 'max-silent-time)
|
||||
#:verbosity (assoc-ref opts 'verbosity))
|
||||
;; TODO: Add more options.
|
||||
(set-build-options (%store)
|
||||
#:keep-failed? (assoc-ref opts 'keep-failed?)
|
||||
#:build-cores (or (assoc-ref opts 'cores) 0)
|
||||
#:fallback? (assoc-ref opts 'fallback?)
|
||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||
#:max-silent-time (assoc-ref opts 'max-silent-time)
|
||||
#:verbosity (assoc-ref opts 'verbosity))
|
||||
|
||||
(if (assoc-ref opts 'derivations-only?)
|
||||
(begin
|
||||
(format #t "~{~a~%~}" (map derivation-file-name drv))
|
||||
(for-each (cut register-root <> <>)
|
||||
(map (compose list derivation-file-name) drv)
|
||||
roots))
|
||||
(or (assoc-ref opts 'dry-run?)
|
||||
(and (build-derivations (%store) drv)
|
||||
(for-each (lambda (d)
|
||||
(format #t "~{~a~%~}"
|
||||
(map (match-lambda
|
||||
((out-name . out)
|
||||
(derivation->output-path
|
||||
d out-name)))
|
||||
(derivation-outputs d))))
|
||||
drv)
|
||||
(for-each (cut register-root <> <>)
|
||||
(map (lambda (drv)
|
||||
(map cdr
|
||||
(derivation->output-paths drv)))
|
||||
drv)
|
||||
roots)))))))))
|
||||
(cond ((assoc-ref opts 'log-file?)
|
||||
(for-each (lambda (file)
|
||||
(let ((log (log-file (%store) file)))
|
||||
(if log
|
||||
(format #t "~a~%" log)
|
||||
(leave (_ "no build log for '~a'~%")
|
||||
file))))
|
||||
(delete-duplicates
|
||||
(append (map derivation-file-name drv)
|
||||
(filter-map (match-lambda
|
||||
(('argument
|
||||
. (? store-path? file))
|
||||
file)
|
||||
(_ #f))
|
||||
opts)))))
|
||||
((assoc-ref opts 'derivations-only?)
|
||||
(format #t "~{~a~%~}" (map derivation-file-name drv))
|
||||
(for-each (cut register-root <> <>)
|
||||
(map (compose list derivation-file-name) drv)
|
||||
roots))
|
||||
((not (assoc-ref opts 'dry-run?))
|
||||
(and (build-derivations (%store) drv)
|
||||
(for-each (lambda (d)
|
||||
(format #t "~{~a~%~}"
|
||||
(map (match-lambda
|
||||
((out-name . out)
|
||||
(derivation->output-path
|
||||
d out-name)))
|
||||
(derivation-outputs d))))
|
||||
drv)
|
||||
(for-each (cut register-root <> <>)
|
||||
(map (lambda (drv)
|
||||
(map cdr
|
||||
(derivation->output-paths drv)))
|
||||
drv)
|
||||
roots))))))))))
|
||||
|
|
|
|||
|
|
@ -36,6 +36,17 @@ guix build -e '(@@ (gnu packages base) %bootstrap-guile)' | \
|
|||
guix build hello -d | \
|
||||
grep -e '-hello-[0-9\.]\+\.drv$'
|
||||
|
||||
# Should all return valid log files.
|
||||
drv="`guix build -d -e '(@@ (gnu packages base) %bootstrap-guile)'`"
|
||||
out="`guix build -e '(@@ (gnu packages base) %bootstrap-guile)'`"
|
||||
log="`guix build --log-file $drv`"
|
||||
echo "$log" | grep log/.*guile.*drv
|
||||
test -f "$log"
|
||||
test "`guix build -e '(@@ (gnu packages base) %bootstrap-guile)' --log-file`" \
|
||||
= "$log"
|
||||
test "`guix build --log-file guile-bootstrap`" = "$log"
|
||||
test "`guix build --log-file $out`" = "$log"
|
||||
|
||||
# Should fail because the name/version combination could not be found.
|
||||
if guix build hello-0.0.1 -n; then false; else true; fi
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue