From eddd4077a5292052d95443078ee4db9f34f2f0e2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 12 Nov 2013 00:10:10 +0100
Subject: [PATCH] store: Add 'log-file' procedure.

* guix/store.scm (log-file): New procedure.
* tests/store.scm ("log-file, derivation", "log-file, output file
  name"): New tests.
---
 guix/store.scm  | 23 ++++++++++++++++++++++-
 tests/store.scm | 27 +++++++++++++++++++++++++++
 2 files changed, 49 insertions(+), 1 deletion(-)

diff --git a/guix/store.scm b/guix/store.scm
index 0f1e2f9466..290118d74b 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -87,7 +87,8 @@
             store-path?
             derivation-path?
             store-path-package-name
-            store-path-hash-part))
+            store-path-hash-part
+            log-file))
 
 (define %protocol-version #x10c)
 
@@ -660,3 +661,23 @@ syntactically valid store path."
                                 "/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
     (and=> (regexp-exec path-rx path)
            (cut match:substring <> 1))))
+
+(define (log-file store file)
+  "Return the build log file for FILE, or #f if none could be found.  FILE
+must be an absolute store file name, or a derivation file name."
+  (define state-dir                               ; XXX: factorize
+    (or (getenv "NIX_STATE_DIR") %state-directory))
+
+  (cond ((derivation-path? file)
+         (let* ((base (basename file))
+                (log  (string-append (dirname state-dir) ; XXX: ditto
+                                     "/log/nix/drvs/"
+                                     (string-take base 2) "/"
+                                     (string-drop base 2) ".bz2")))
+           (and (file-exists? log) log)))
+        (else
+         (match (valid-derivers store file)
+           ((derivers ...)
+            ;; Return the first that works.
+            (any (cut log-file store <>) derivers))
+           (_ #f)))))
diff --git a/tests/store.scm b/tests/store.scm
index b5e0cb0eab..430027c33b 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -140,6 +140,33 @@
          (equal? (valid-derivers %store o)
                  (list (derivation-file-name d))))))
 
+(test-assert "log-file, derivation"
+  (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s (add-to-store %store "bash" #t "sha256"
+                          (search-bootstrap-binary "bash"
+                                                   (%current-system))))
+         (d (derivation %store "the-thing"
+                        s `("-e" ,b)
+                        #:env-vars `(("foo" . ,(random-text)))
+                        #:inputs `((,b) (,s)))))
+    (and (build-derivations %store (list d))
+         (file-exists? (pk (log-file %store (derivation-file-name d)))))))
+
+(test-assert "log-file, output file name"
+  (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s (add-to-store %store "bash" #t "sha256"
+                          (search-bootstrap-binary "bash"
+                                                   (%current-system))))
+         (d (derivation %store "the-thing"
+                        s `("-e" ,b)
+                        #:env-vars `(("foo" . ,(random-text)))
+                        #:inputs `((,b) (,s))))
+         (o (derivation->output-path d)))
+    (and (build-derivations %store (list d))
+         (file-exists? (pk (log-file %store o)))
+         (string=? (log-file %store (derivation-file-name d))
+                   (log-file %store o)))))
+
 (test-assert "no substitutes"
   (let* ((s  (open-connection))
          (d1 (package-derivation s %bootstrap-guile (%current-system)))