From c04ffadbed7412545555b8be6b78f23eed150d26 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 5 Jan 2018 00:19:35 +0100
Subject: publish: Publish build logs.

* guix/scripts/publish.scm (render-log-file): New procedure.
(make-request-handler): Add "log" case.
* tests/publish.scm ("/log/NAME")
("/log/NAME not found"): New tests.
* doc/guix.texi (Invoking guix publish): Document /log URLs.
---
 doc/guix.texi            | 17 +++++++++++++++++
 guix/scripts/publish.scm | 29 +++++++++++++++++++++++++++++
 tests/publish.scm        | 28 ++++++++++++++++++++++++++++
 3 files changed, 74 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 90d6f7665c..f51593ada1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5676,6 +5676,7 @@ collection as soon as the build completes.  @xref{Invoking guix gc}, for
 more on GC roots.
 
 @item --log-file
+@cindex build logs, access
 Return the build log file names or URLs for the given
 @var{package-or-derivation}, or raise an error if build logs are
 missing.
@@ -7238,6 +7239,22 @@ http://example.org/file/hello-2.10.tar.gz/sha256/0ssi1@dots{}ndq1i
 Obviously, these URLs only work for files that are in the store; in
 other cases, they return 404 (``Not Found'').
 
+@cindex build logs, publication
+Build logs are available from @code{/log} URLs like:
+
+@example
+http://example.org/log/gwspk@dots{}-guile-2.2.3
+@end example
+
+@noindent
+When @command{guix-daemon} is configured to save compressed build logs,
+as is the case by default (@pxref{Invoking guix-daemon}), @code{/log}
+URLs return the compressed log as-is, with an appropriate
+@code{Content-Type} and/or @code{Content-Encoding} header.  We recommend
+running @command{guix-daemon} with @code{--log-compression=gzip} since
+Web browsers can automatically decompress it, which is not the case with
+bzip2 compression.
+
 The following options are available:
 
 @table @code
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 3f73197239..6eb5397c8d 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -572,6 +572,31 @@ has the given HASH of type ALGO."
             (not-found request)))
       (not-found request)))
 
+(define (render-log-file store request name)
+  "Render the log file for NAME, the base name of a store item.  Don't attempt
+to compress or decompress the log file; just return it as-is."
+  (define (response-headers file)
+    ;; XXX: We're not returning the actual contents, deferring instead to
+    ;; 'http-write'.  This is a hack to work around
+    ;; <http://bugs.gnu.org/21093>.
+    (cond ((string-suffix? ".gz" file)
+           `((content-type . (text/plain (charset . "UTF-8")))
+             (content-encoding . (gzip))
+             (x-raw-file . ,file)))
+          ((string-suffix? ".bz2" file)
+           `((content-type . (application/x-bzip2
+                              (charset . "ISO-8859-1")))
+             (x-raw-file . ,file)))
+          (else                                   ;uncompressed
+           `((content-type . (text/plain (charset . "UTF-8")))
+             (x-raw-file . ,file)))))
+
+  (let ((log (log-file store
+                       (string-append (%store-prefix) "/" name))))
+    (if log
+        (values (response-headers log) log)
+        (not-found request))))
+
 (define (render-home-page request)
   "Render the home page."
   (values `((content-type . (text/html (charset . "UTF-8"))))
@@ -772,6 +797,10 @@ blocking."
                (render-content-addressed-file store request
                                               name 'sha256 hash))))
 
+          ;; /log/OUTPUT
+          (("log" name)
+           (render-log-file store request name))
+
           ;; Use different URLs depending on the compression type.  This
           ;; guarantees that /nar URLs remain valid even when 'guix publish'
           ;; is restarted with different compression parameters.
diff --git a/tests/publish.scm b/tests/publish.scm
index 352caf5325..bd1a75cf00 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -439,4 +440,31 @@ FileSize: ~a~%"
                          (assoc-ref narinfo "FileSize"))
                         (response-code compressed))))))))))
 
+(test-equal "/log/NAME"
+  `(200 #t application/x-bzip2)
+  (let ((drv (run-with-store %store
+               (gexp->derivation "with-log"
+                                 #~(call-with-output-file #$output
+                                     (lambda (port)
+                                       (display "Hello, build log!"
+                                                (current-error-port))
+                                       (display "" port)))))))
+    (build-derivations %store (list drv))
+    (let* ((response (http-get
+                      (publish-uri (string-append "/log/"
+                                                  (basename (derivation->output-path drv))))
+                      #:decode-body? #f))
+           (base     (basename (derivation-file-name drv)))
+           (log      (string-append (dirname %state-directory)
+                                    "/log/guix/drvs/" (string-take base 2)
+                                    "/" (string-drop base 2) ".bz2")))
+      (list (response-code response)
+            (= (response-content-length response) (stat:size (stat log)))
+            (first (response-content-type response))))))
+
+(test-equal "/log/NAME not found"
+  404
+  (let ((uri (publish-uri "/log/does-not-exist")))
+    (response-code (http-get uri))))
+
 (test-end "publish")
-- 
cgit v1.2.3