diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-01-07 12:28:13 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-07 23:59:30 +0100 |
commit | 9588e4d4a7c7eed0b3d3729d68f3c8c687c1434e (patch) | |
tree | 232b10d9e8b2a496a17734da73aa84f737dc7b4c | |
parent | 6c163e491617d431149bbe54aa4ba9bef9530c83 (diff) | |
download | cuirass-9588e4d4a7c7eed0b3d3729d68f3c8c687c1434e.tar cuirass-9588e4d4a7c7eed0b3d3729d68f3c8c687c1434e.tar.gz |
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.
-rw-r--r-- | src/cuirass/http.scm | 36 | ||||
-rw-r--r-- | 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 <mthl@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; 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 <mthl@gnu.org> -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; 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)) |