branch master updated: http: Add the "/log" route replicating the publish interface.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 6019040  http: Add the "/log" route replicating the publish interface.
6019040 is described below

commit 60190401ce4ccc890629ec3cb22a84a8ab8c2645
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Sep 13 16:41:45 2021 +0200

    http: Add the "/log" route replicating the publish interface.
    
    * src/cuirass/database.scm (db-get-log-from-output): New procedure.
    * src/cuirass/http.scm (url-handler): Add a "/log" route.
---
 src/cuirass/database.scm | 12 ++++++++++++
 src/cuirass/http.scm     | 10 +++++++++-
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 2aa99a1..9042544 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -121,6 +121,7 @@
             db-remove-unresponsive-workers
             db-clear-workers
             db-clear-build-queue
+            db-get-log-from-output
             ;; Parameters.
             %create-database?
             %package-database
@@ -1837,6 +1838,17 @@ WHERE status = -1 AND
   (with-db-worker-thread db
     (exec-query db "UPDATE Builds SET status = -2 WHERE status < 0;")))
 
+(define (db-get-log-from-output output)
+  "Return the log file corresponding to the OUTPUT build."
+  (with-db-worker-thread db
+    (match (expect-one-row
+            (exec-query/bind db "
+SELECT log FROM Outputs
+LEFT JOIN Builds ON outputs.derivation = builds.derivation
+WHERE Outputs.path = " output ";"))
+      ((log) log)
+      (else #f))))
+
 ;;; Local Variables:
 ;;; eval: (put 'with-db-worker-thread 'scheme-indent-function 1)
 ;;; End:
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 03a6b80..b8009e3 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -1,6 +1,6 @@
 ;;;; http.scm -- HTTP API
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
-;;; Copyright © 2017, 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;; Copyright © 2017, 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Tatiana Sholokhova <tanja201396@gmail.com>
@@ -979,6 +979,14 @@ passed, only display JOBS targeting this SYSTEM."
           (dashboard-page evaluation-id
                           #:dashboard-id dashboard-id))))))
 
+    ;; Replicate the Guix publish log interface for compatibility purposes.
+    (('GET "log" output)
+     (let* ((output (string-append (%store-prefix) "/" output))
+            (log (pk (db-get-log-from-output (pk output)))))
+       (if (and log (file-exists? log))
+           (respond-compressed-file log)
+           (respond-not-found (uri->string (request-uri request))))))
+
     (('GET "search")
      (let* ((params (request-parameters request))
             (query (and=> (assq-ref params 'query) uri-decode))