diff options
| -rw-r--r-- | doc/guix.texi | 14 | ||||
| -rw-r--r-- | guix/scripts/build.scm | 49 |
2 files changed, 61 insertions, 2 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index f943540ac8..9ae91a8d1e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index d593b5a8a7..ab2a39b1f8 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -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'~%") |