summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-10 23:10:50 +0200
committerLudovic Courtès <ludo@gnu.org>2015-09-10 23:14:16 +0200
commit3f208ad7585583bf897999ef4038a803c529d7f8 (patch)
treeaae7dcd6d473b01e3438acd36f140d95473fe48f
parent6b02a448d2d87e043e45905567a7504c7926c2a9 (diff)
downloadguix-3f208ad7585583bf897999ef4038a803c529d7f8.tar.gz
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.
-rw-r--r--doc/guix.texi14
-rw-r--r--guix/scripts/build.scm49
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'~%")