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:
		
							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
 | 
					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.
 | 
					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
 | 
					@end table
 | 
				
			||||||
 | 
					
 | 
				
			||||||
Behind the scenes, @command{guix build} is essentially an interface to
 | 
					Behind the scenes, @command{guix build} is essentially an interface to
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -95,6 +95,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
 | 
				
			||||||
                         as a garbage collector root"))
 | 
					                         as a garbage collector root"))
 | 
				
			||||||
  (display (_ "
 | 
					  (display (_ "
 | 
				
			||||||
      --verbosity=LEVEL  use the given verbosity LEVEL"))
 | 
					      --verbosity=LEVEL  use the given verbosity LEVEL"))
 | 
				
			||||||
 | 
					  (display (_ "
 | 
				
			||||||
 | 
					      --log-file         return the log file names for the given derivations"))
 | 
				
			||||||
  (newline)
 | 
					  (newline)
 | 
				
			||||||
  (display (_ "
 | 
					  (display (_ "
 | 
				
			||||||
  -h, --help             display this help and exit"))
 | 
					  -h, --help             display this help and exit"))
 | 
				
			||||||
| 
						 | 
					@ -161,7 +163,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
 | 
				
			||||||
                (lambda (opt name arg result)
 | 
					                (lambda (opt name arg result)
 | 
				
			||||||
                  (let ((level (string->number arg)))
 | 
					                  (let ((level (string->number arg)))
 | 
				
			||||||
                    (alist-cons 'verbosity level
 | 
					                    (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 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
 | 
				
			||||||
             (leave (_ "~A: unknown package~%") name))))))
 | 
					             (leave (_ "~A: unknown package~%") name))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (with-error-handling
 | 
					  (with-error-handling
 | 
				
			||||||
    (let ((opts (parse-options)))
 | 
					    ;; Ask for absolute file names so that .drv file names passed from the
 | 
				
			||||||
      (define package->derivation
 | 
					    ;; user to 'read-derivation' are absolute when it returns.
 | 
				
			||||||
        (match (assoc-ref opts 'target)
 | 
					    (with-fluids ((%file-port-name-canonicalization 'absolute))
 | 
				
			||||||
          (#f package-derivation)
 | 
					      (let ((opts (parse-options)))
 | 
				
			||||||
          (triplet
 | 
					        (define package->derivation
 | 
				
			||||||
           (cut package-cross-derivation <> <> triplet <>))))
 | 
					          (match (assoc-ref opts 'target)
 | 
				
			||||||
 | 
					            (#f package-derivation)
 | 
				
			||||||
 | 
					            (triplet
 | 
				
			||||||
 | 
					             (cut package-cross-derivation <> <> triplet <>))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
      (parameterize ((%store (open-connection)))
 | 
					        (parameterize ((%store (open-connection)))
 | 
				
			||||||
        (let* ((src? (assoc-ref opts 'source?))
 | 
					          (let* ((src? (assoc-ref opts 'source?))
 | 
				
			||||||
               (sys  (assoc-ref opts 'system))
 | 
					                 (sys  (assoc-ref opts 'system))
 | 
				
			||||||
               (drv  (filter-map (match-lambda
 | 
					                 (drv  (filter-map (match-lambda
 | 
				
			||||||
                                  (('expression . str)
 | 
					                                    (('expression . str)
 | 
				
			||||||
                                   (derivations-from-package-expressions
 | 
					                                     (derivations-from-package-expressions
 | 
				
			||||||
                                    str package->derivation sys src?))
 | 
					                                      str package->derivation sys src?))
 | 
				
			||||||
                                  (('argument . (? derivation-path? drv))
 | 
					                                    (('argument . (? derivation-path? drv))
 | 
				
			||||||
                                   (call-with-input-file drv read-derivation))
 | 
					                                     (call-with-input-file drv read-derivation))
 | 
				
			||||||
                                  (('argument . (? string? x))
 | 
					                                    (('argument . (? store-path?))
 | 
				
			||||||
                                   (let ((p (find-package x)))
 | 
					                                     ;; Nothing to do; maybe for --log-file.
 | 
				
			||||||
                                     (if src?
 | 
					                                     #f)
 | 
				
			||||||
                                         (let ((s (package-source p)))
 | 
					                                    (('argument . (? string? x))
 | 
				
			||||||
                                           (package-source-derivation
 | 
					                                     (let ((p (find-package x)))
 | 
				
			||||||
                                            (%store) s))
 | 
					                                       (if src?
 | 
				
			||||||
                                         (package->derivation (%store) p sys))))
 | 
					                                           (let ((s (package-source p)))
 | 
				
			||||||
                                  (_ #f))
 | 
					                                             (package-source-derivation
 | 
				
			||||||
                                 opts))
 | 
					                                              (%store) s))
 | 
				
			||||||
               (roots (filter-map (match-lambda
 | 
					                                           (package->derivation (%store) p sys))))
 | 
				
			||||||
                                   (('gc-root . root) root)
 | 
					                                    (_ #f))
 | 
				
			||||||
                                   (_ #f))
 | 
					                                   opts))
 | 
				
			||||||
                                  opts)))
 | 
					                 (roots (filter-map (match-lambda
 | 
				
			||||||
 | 
					                                     (('gc-root . root) root)
 | 
				
			||||||
 | 
					                                     (_ #f))
 | 
				
			||||||
 | 
					                                    opts)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
          (show-what-to-build (%store) drv
 | 
					            (unless (assoc-ref opts 'log-file?)
 | 
				
			||||||
                              #:use-substitutes? (assoc-ref opts 'substitutes?)
 | 
					              (show-what-to-build (%store) drv
 | 
				
			||||||
                              #:dry-run? (assoc-ref opts 'dry-run?))
 | 
					                                  #:use-substitutes? (assoc-ref opts 'substitutes?)
 | 
				
			||||||
 | 
					                                  #:dry-run? (assoc-ref opts 'dry-run?)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
          ;; TODO: Add more options.
 | 
					            ;; TODO: Add more options.
 | 
				
			||||||
          (set-build-options (%store)
 | 
					            (set-build-options (%store)
 | 
				
			||||||
                             #:keep-failed? (assoc-ref opts 'keep-failed?)
 | 
					                               #:keep-failed? (assoc-ref opts 'keep-failed?)
 | 
				
			||||||
                             #:build-cores (or (assoc-ref opts 'cores) 0)
 | 
					                               #:build-cores (or (assoc-ref opts 'cores) 0)
 | 
				
			||||||
                             #:fallback? (assoc-ref opts 'fallback?)
 | 
					                               #:fallback? (assoc-ref opts 'fallback?)
 | 
				
			||||||
                             #:use-substitutes? (assoc-ref opts 'substitutes?)
 | 
					                               #:use-substitutes? (assoc-ref opts 'substitutes?)
 | 
				
			||||||
                             #:max-silent-time (assoc-ref opts 'max-silent-time)
 | 
					                               #:max-silent-time (assoc-ref opts 'max-silent-time)
 | 
				
			||||||
                             #:verbosity (assoc-ref opts 'verbosity))
 | 
					                               #:verbosity (assoc-ref opts 'verbosity))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
          (if (assoc-ref opts 'derivations-only?)
 | 
					            (cond ((assoc-ref opts 'log-file?)
 | 
				
			||||||
              (begin
 | 
					                   (for-each (lambda (file)
 | 
				
			||||||
                (format #t "~{~a~%~}" (map derivation-file-name drv))
 | 
					                               (let ((log (log-file (%store) file)))
 | 
				
			||||||
                (for-each (cut register-root <> <>)
 | 
					                                 (if log
 | 
				
			||||||
                          (map (compose list derivation-file-name) drv)
 | 
					                                     (format #t "~a~%" log)
 | 
				
			||||||
                          roots))
 | 
					                                     (leave (_ "no build log for '~a'~%")
 | 
				
			||||||
              (or (assoc-ref opts 'dry-run?)
 | 
					                                            file))))
 | 
				
			||||||
                  (and (build-derivations (%store) drv)
 | 
					                             (delete-duplicates
 | 
				
			||||||
                       (for-each (lambda (d)
 | 
					                              (append (map derivation-file-name drv)
 | 
				
			||||||
                                   (format #t "~{~a~%~}"
 | 
					                                      (filter-map (match-lambda
 | 
				
			||||||
                                           (map (match-lambda
 | 
					                                                   (('argument
 | 
				
			||||||
                                                 ((out-name . out)
 | 
					                                                     . (? store-path? file))
 | 
				
			||||||
                                                  (derivation->output-path
 | 
					                                                    file)
 | 
				
			||||||
                                                   d out-name)))
 | 
					                                                   (_ #f))
 | 
				
			||||||
                                                (derivation-outputs d))))
 | 
					                                                  opts)))))
 | 
				
			||||||
                                 drv)
 | 
					                  ((assoc-ref opts 'derivations-only?)
 | 
				
			||||||
                       (for-each (cut register-root <> <>)
 | 
					                   (format #t "~{~a~%~}" (map derivation-file-name drv))
 | 
				
			||||||
                                 (map (lambda (drv)
 | 
					                   (for-each (cut register-root <> <>)
 | 
				
			||||||
                                        (map cdr
 | 
					                             (map (compose list derivation-file-name) drv)
 | 
				
			||||||
                                             (derivation->output-paths drv)))
 | 
					                             roots))
 | 
				
			||||||
                                      drv)
 | 
					                  ((not (assoc-ref opts 'dry-run?))
 | 
				
			||||||
                                 roots)))))))))
 | 
					                   (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 |				\
 | 
					guix build hello -d |				\
 | 
				
			||||||
    grep -e '-hello-[0-9\.]\+\.drv$'
 | 
					    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.
 | 
					# Should fail because the name/version combination could not be found.
 | 
				
			||||||
if guix build hello-0.0.1 -n; then false; else true; fi
 | 
					if guix build hello-0.0.1 -n; then false; else true; fi
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue