3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

guix build: '--log-file' can return URLs.

* guix/scripts/build.scm (%default-log-urls): New variable.
  (log-url): New procedure.
  (guix-build): Use it.
* doc/guix.texi (Invoking guix build): Document it.
This commit is contained in:
Ludovic Courtès 2015-09-10 23:10:50 +02:00
parent 6b02a448d2
commit 3f208ad758
2 changed files with 61 additions and 2 deletions

View file

@ -3629,7 +3629,7 @@ Make @var{file} a symlink to the result, and register it as a garbage
collector root.
@item --log-file
Return the build log file names for the given
Return the build log file names or URLs for the given
@var{package-or-derivation}s, or raise an error if build logs are
missing.
@ -3643,7 +3643,19 @@ guix build --log-file guile
guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)'
@end example
If a log is unavailable locally, and unless @code{--no-substitutes} is
passed, the command looks for a corresponding log on one of the
substitute servers (as specified with @code{--substitute-urls}.)
So for instance, let's say you want to see the build log of GDB on MIPS
but you're actually on an @code{x86_64} machine:
@example
$ guix build --log-file gdb -s mips64el-linux
http://hydra.gnu.org/log/@dots{}-gdb-7.10
@end example
You can freely access a huge library of build logs!
@end table
@cindex common build options

View file

@ -25,6 +25,7 @@
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module (guix gexp)
#:autoload (guix http-client) (http-fetch http-get-error?)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
@ -42,6 +43,45 @@
guix-build))
(define %default-log-urls
;; Default base URLs for build logs.
'("http://hydra.gnu.org/log"))
;; XXX: The following procedure cannot be in (guix store) because of the
;; dependency on (guix derivations).
(define* (log-url store file #:key (base-urls %default-log-urls))
"Return a URL under one of the BASE-URLS where a build log for FILE can be
found. Return #f if no build log was found."
(define (valid-url? url)
;; Probe URL and return #t if it is accessible.
(guard (c ((http-get-error? c) #f))
(close-port (http-fetch url #:buffered? #f))
#t))
(define (find-url file)
(let ((base (basename file)))
(any (lambda (base-url)
(let ((url (string-append base-url "/" base)))
(and (valid-url? url) url)))
base-urls)))
(cond ((derivation-path? file)
(catch 'system-error
(lambda ()
;; Usually we'll have more luck with the output file name since
;; the deriver that was used by the server could be different, so
;; try one of the output file names.
(let ((drv (call-with-input-file file read-derivation)))
(or (find-url (derivation->output-path drv))
(find-url file))))
(lambda args
;; As a last resort, try the .drv.
(if (= ENOENT (system-error-errno args))
(find-url file)
(apply throw args)))))
(else
(find-url file))))
(define (register-root store paths root)
"Register ROOT as an indirect GC root for all of PATHS."
(let* ((root (string-append (canonicalize-path (dirname root))
@ -457,6 +497,11 @@ arguments with packages that use the specified source."
(list %default-options)))
(store (open-connection))
(drv (options->derivations store opts))
(urls (map (cut string-append <> "/log")
(if (assoc-ref opts 'substitutes?)
(or (assoc-ref opts 'substitute-urls)
%default-substitute-urls)
'())))
(roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
@ -470,7 +515,9 @@ arguments with packages that use the specified source."
(cond ((assoc-ref opts 'log-file?)
(for-each (lambda (file)
(let ((log (log-file store file)))
(let ((log (or (log-file store file)
(log-url store file
#:base-urls urls))))
(if log
(format #t "~a~%" log)
(leave (_ "no build log for '~a'~%")