ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix build: Add '--log-file'.

Browse source 
* 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 2013-11-12 01:06:25 +01:00
parent eddd4077a5
commit bf4211523b
3 changed files with 115 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
doc/guix.texi
View file

@ -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

150
guix/scripts/build.scm
View file

@ -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))))))))))

11
tests/guix-build.sh
View file

@ -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