[no subject]

[Ludovic Courtès]

branch: master
commit 9588e4d4a7c7eed0b3d3729d68f3c8c687c1434e
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jan 7 12:28:13 2018 +0100

    http: /build/N/log/raw redirects to /log.
    
    This moves log handling responsibility to 'guix publish'.
    
    * src/cuirass/http.scm (handle-log-request): Remove.
    (url-handler): Change /log/raw URI handler to return 302 to /log/OUTPUT.
    * tests/http.scm (log-file-name): Remove, and remove code to create and
    delete it.
    ("fill-db"): Change #:log value.
    ("/build/1/log/raw"): Expect 302.
---
 src/cuirass/http.scm | 36 +++++++++++++-----------------------
 tests/http.scm       | 30 ++++++++----------------------
 2 files changed, 21 insertions(+), 45 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 7434429..83ab294 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -1,6 +1,7 @@
 ;;;; http.scm -- HTTP API
 ;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
+;;; Copyright © 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -20,11 +21,7 @@
 (define-module (cuirass http)
   #:use-module (cuirass database)
   #:use-module (cuirass utils)
-  #:use-module (guix config)
-  #:use-module (guix build utils)
-  #:use-module (guix utils)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 popen)
   #:use-module (json)
   #:use-module (web request)
   #:use-module (web response)
@@ -66,21 +63,6 @@
   (let ((builds (db-get-builds db filters)))
     (map build->hydra-build builds)))
 
-(define (handle-log-request db build)
-  "Retrieve the log file of BUILD. Return a lambda which PORT argument is an
-  input port from which the content of the log file can be read or #f if the
-  log file is not readable."
-  (let* ((log (assq-ref build #:log))
-         (access (and (string? log)
-                      (access? log R_OK))))
-    (and access
-         (lambda (out-port)
-           (let ((in-pipe-port
-                  (open-input-pipe
-                   (format #f "~a -dc ~a" %bzip2 log))))
-             (dump-port in-pipe-port out-port)
-             (close-pipe in-pipe-port))))))
-
 (define (request-parameters request)
   "Parse the REQUEST query parameters and return them under the form
   '((parameter value) ...)."
@@ -148,10 +130,18 @@
     (("build" build-id "log" "raw")
      (let ((build (db-get-build db build-id)))
        (if build
-           (let ((log-response (handle-log-request db build)))
-             (if log-response
-                 (respond-text log-response)
-                 (respond-build-log-not-found build)))
+           (match (assq-ref build #:outputs)
+             (((_ (#:path . (? string? output))) _ ...)
+              ;; Redirect to a /log URL, which is assumed to be served
+              ;; by 'guix publish'.
+              (let ((uri (string->uri-reference
+                          (string-append "/log/"
+                                         (basename output)))))
+                (respond (build-response #:code 302
+                                         #:headers `((location . ,uri)))
+                         #:body "")))
+             (#f
+              (respond-build-not-found build-id)))
            (respond-build-not-found build-id))))
     (("api" "latestbuilds")
      (let* ((params (request-parameters request))
diff --git a/tests/http.scm b/tests/http.scm
index 99daf23..2c53fad 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -1,6 +1,6 @@
 ;;; http.scm -- tests for (cuirass http) module
 ;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
-;;; Copyright © 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2017, 2018 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; This file is part of Cuirass.
@@ -21,9 +21,8 @@
 (use-modules (cuirass http)
              (cuirass database)
              (cuirass utils)
-             (guix utils)
-             (guix build utils)
              (json)
+             (web uri)
              (web client)
              (web response)
              (rnrs bytevectors)
@@ -92,19 +91,6 @@
     (#:releasename . #nil)
     (#:buildinputs_builds . #nil)))
 
-(define log-file-name
-  ;; Use a fake temporary log file.
-  (string-append (getcwd) "/" (number->string (getpid)) "-log.txt"))
-
-(call-with-output-file log-file-name
-  ;; Write "build log" string compressed with bzip2 inside LOG-FILE-NAME.
-  (lambda (out)
-    (dump-port
-     (call-with-input-string "build log"
-       (lambda (port)
-         (compressed-port 'bzip2 port)))
-     out)))
-
 (test-group-with-cleanup "http"
   (test-assert "object->json-string"
     ;; Note: We cannot compare the strings directly because field ordering
@@ -145,7 +131,7 @@
     (let ((build
            `((#:derivation . "/gnu/store/fake.drv")
              (#:eval-id . 1)
-             (#:log . ,log-file-name)
+             (#:log . "unused so far")
              (#:status . 0)
              (#:outputs . (("out" . "/gnu/store/fake-1.0")))
              (#:timestamp . 1501347493)
@@ -187,9 +173,10 @@
        json->scm)))
 
   (test-equal "/build/1/log/raw"
-    "build log"
-    (http-get-body
-     (test-cuirass-uri "/build/1/log/raw")))
+    `(302 ,(string->uri-reference "/log/fake-1.0"))
+    (let ((response (http-get (test-cuirass-uri "/build/1/log/raw"))))
+      (list (response-code response)
+            (response-location response))))
 
   (test-equal "/build/2"
     404
@@ -232,5 +219,4 @@
   (test-assert "db-close"
     (db-close (%db)))
 
-  (delete-file database-name)
-  (delete-file log-file-name))
+  (delete-file database-name))