Package: guix-patches;
Reported by: Mathieu Othacehe <m.othacehe <at> gmail.com>
Date: Fri, 1 May 2020 08:56:02 UTC
Severity: normal
Done: Mathieu Othacehe <mathieu <at> meru.i-did-not-set--mail-host-address--so-tickle-me>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 40993 in the body.
You can then email your comments to 40993 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Fri, 01 May 2020 08:56:02 GMT) Full text and rfc822 format available.Mathieu Othacehe <m.othacehe <at> gmail.com>:guix-patches <at> gnu.org.
(Fri, 01 May 2020 08:56:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <m.othacehe <at> gmail.com> To: guix-patches <at> gnu.org Subject: cuirass: Add build products download support. Date: Fri, 01 May 2020 10:54:56 +0200
[Message part 1 (text/plain, inline)]
Hello,
Here's a patch adding support for build products downloading in
Cuirass. It is inspired by a similar mechanism in Hydra.
Attached a screenshot of what I obtained with the following
specification:
--8<---------------cut here---------------start------------->8---
(define hello-master
'((#:name . "guix-master")
(#:load-path-inputs . ())
(#:package-path-inputs . ())
(#:proc-input . "guix")
(#:proc-file . "build-aux/cuirass/gnu-system.scm")
(#:proc . cuirass-jobs)
(#:proc-args (subset . "all"))
(#:inputs . (((#:name . "guix")
(#:url . "https://gitlab.com/mothacehe/guix")
(#:load-path . ".")
(#:branch . "master")
(#:no-compile? . #t))))
(#:build-outputs . (((#:job . "iso9660-image*")
(#:type . "iso")
(#:output . "out")
(#:path . ""))))))
(list hello-master)
--8<---------------cut here---------------end--------------->8---
Thanks,
Mathieu
[0001-Add-support-for-build-products-downloading.patch (text/x-diff, inline)]
From dbb78929d7c8aa3b9007660795f55232ab47dbfb Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe <at> gmail.com>
Date: Fri, 1 May 2020 10:32:18 +0200
Subject: [PATCH] Add support for build products downloading.
* src/sql/upgrade-7.sql: New file.
* Makefile.am: Add it.
* src/cuirass/base.scm (create-build-outputs): New procedure,
(build-packages): call it,
(process-spec): add the new spec argument and pass it to create-build-outputs.
* src/cuirass/database.scm (db-add-build-product, db-get-build-product-path,
db-get-build-products): New exported procedures.
* src/cuirass/http.scm (respond-static-file): Move file sending to ...
(respond-file): ... this new procedure,
(url-handler): add a new "download/<id>" route, serving the requested file
with the new respond-file procedure. Also gather build products and pass them
to "build-details" for "build/<id>/details" route.
* src/cuirass/templates.scm (build-details): Honor the new "products" argument
to display all the build products associated to the given build.
* src/schema.sql (BuildProducts): New table,
(Specifications)[build_outputs]: new field.
* tests/database.scm: Add empty build-outputs spec.
* tests/http.scm: Ditto.
* examples/guix-jobs.scm: Ditto.
* examples/hello-git.scm: Ditto.
* examples/hello-singleton.scm: Ditto.
* examples/hello-subset.scm: Ditto.
* examples/random.scm: Ditto.
* doc/cuirass.texi (overview): Document it.
---
Makefile.am | 4 ++-
doc/cuirass.texi | 14 +++++++--
examples/guix-jobs.scm | 4 ++-
examples/hello-git.scm | 4 ++-
examples/hello-singleton.scm | 4 ++-
examples/hello-subset.scm | 4 ++-
examples/random.scm | 4 ++-
src/cuirass/base.scm | 44 ++++++++++++++++++++++++++--
src/cuirass/database.scm | 57 ++++++++++++++++++++++++++++++++----
src/cuirass/http.scm | 36 +++++++++++++++++------
src/cuirass/templates.scm | 37 +++++++++++++++++++++--
src/schema.sql | 13 +++++++-
src/sql/upgrade-7.sql | 15 ++++++++++
tests/database.scm | 4 ++-
tests/http.scm | 5 ++--
15 files changed, 218 insertions(+), 31 deletions(-)
create mode 100644 src/sql/upgrade-7.sql
diff --git a/Makefile.am b/Makefile.am
index 65c9a29..f4a3663 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -5,6 +5,7 @@
# Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
# Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
# Copyright © 2018 Tatiana Sholokhova <tanja201396 <at> gmail.com>
+# Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
#
# This file is part of Cuirass.
#
@@ -71,7 +72,8 @@ dist_sql_DATA = \
src/sql/upgrade-3.sql \
src/sql/upgrade-4.sql \
src/sql/upgrade-5.sql \
- src/sql/upgrade-6.sql
+ src/sql/upgrade-6.sql \
+ src/sql/upgrade-7.sql
dist_css_DATA = \
src/static/css/cuirass.css \
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index e652e8d..c6f64c9 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -11,7 +11,7 @@ This manual is for Cuirass version @value{VERSION}, a build automation
server.
Copyright @copyright{} 2016, 2017 Mathieu Lirzin@*
-Copyright @copyright{} 2017 Mathieu Othacehe@*
+Copyright @copyright{} 2017, 2020 Mathieu Othacehe@*
Copyright @copyright{} 2018 Ludovic Courtès@*
Copyright @copyright{} 2018 Clément Lassieur
@@ -137,7 +137,12 @@ a specification might look like:
(#:url . "git://my-custom-packages.git")
(#:load-path . ".")
(#:branch . "master")
- (#:no-compile? . #t)))))
+ (#:no-compile? . #t))))
+ (#:build-outputs .
+ (((#:job . "hello*")
+ (#:type . "license")
+ (#:output . "out")
+ (#:path . "share/doc/hello-2.10/COPYING")))))
@end lisp
In this specification the keys are Scheme keywords which have the nice
@@ -150,6 +155,11 @@ containing the custom packages (see @code{GUIX_PACKAGE_PATH}).
@code{#:load-path-inputs}, @code{#:package-path-inputs} and
@code{#:proc-input} refer to these inputs by their name.
+The @code{#:build-outputs} list specifies the files that will be made
+available for download, through the Web interface. Here, the
+@code{COPYING} file, in the @code{"out"} output, for all jobs whose name
+matches @code{"hello*"} regex.
+
@quotation Note
@c This refers to
@c <https://github.com/libgit2/libgit2sharp/issues/1094#issuecomment-112306072>.
diff --git a/examples/guix-jobs.scm b/examples/guix-jobs.scm
index 963c7ff..2f1f1a2 100644
--- a/examples/guix-jobs.scm
+++ b/examples/guix-jobs.scm
@@ -1,6 +1,7 @@
;;; guix-jobs.scm -- job specification test for Guix
;;; Copyright © 2016 Mathieu Lirzin <mthl <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -34,7 +35,8 @@
(#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
(#:load-path . ".")
(#:branch . "master")
- (#:no-compile? . #t))))))
+ (#:no-compile? . #t))))
+ (#:build-outputs . ())))
(define guix-master
(job-base #:branch "master"))
diff --git a/examples/hello-git.scm b/examples/hello-git.scm
index 6468452..c5e2ca2 100644
--- a/examples/hello-git.scm
+++ b/examples/hello-git.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016 Mathieu Lirzin <mthl <at> gnu.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -43,4 +44,5 @@
(#:url . ,(string-append "file://" top-srcdir))
(#:load-path . ".")
(#:branch . "master")
- (#:no-compile? . #t)))))))
+ (#:no-compile? . #t))))
+ (#:build-outputs . ()))))
diff --git a/examples/hello-singleton.scm b/examples/hello-singleton.scm
index a39191f..2d2d746 100644
--- a/examples/hello-singleton.scm
+++ b/examples/hello-singleton.scm
@@ -1,6 +1,7 @@
;;; hello-singleton.scm -- job specification test for hello in master
;;; Copyright © 2016 Mathieu Lirzin <mthl <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -34,6 +35,7 @@
(#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
(#:load-path . ".")
(#:branch . "master")
- (#:no-compile? . #t))))))
+ (#:no-compile? . #t))))
+ (#:build-outputs . ())))
(list hello-master)
diff --git a/examples/hello-subset.scm b/examples/hello-subset.scm
index 8c0d990..e86668e 100644
--- a/examples/hello-subset.scm
+++ b/examples/hello-subset.scm
@@ -1,6 +1,7 @@
;;; hello-subset.scm -- job specification test for hello subset
;;; Copyright © 2016 Mathieu Lirzin <mthl <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -34,7 +35,8 @@
(#:url . "https://git.savannah.gnu.org/git/guix/guix-cuirass.git")
(#:load-path . ".")
(#:branch . "master")
- (#:no-compile? . #t))))))
+ (#:no-compile? . #t))))
+ (#:build-outputs . ())))
(define guix-master
(job-base #:branch "master"))
diff --git a/examples/random.scm b/examples/random.scm
index 37b97a2..f15e158 100644
--- a/examples/random.scm
+++ b/examples/random.scm
@@ -1,6 +1,7 @@
;;; random.scm -- Job specification that creates random build jobs
;;; Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -31,4 +32,5 @@
(#:url . ,(string-append "file://" top-srcdir))
(#:load-path . ".")
(#:branch . "master")
- (#:no-compile? . #t)))))))
+ (#:no-compile? . #t))))
+ (#:build-outputs . ()))))
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 2b18dc6..b745058 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -1,7 +1,7 @@
;;; base.scm -- Cuirass base module
;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl <at> gnu.org>
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2017 Ricardo Wurmus <rekado <at> elephly.net>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
;;;
@@ -41,6 +41,7 @@
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
+ #:use-module (ice-9 regex)
#:use-module (ice-9 atomic)
#:use-module (ice-9 ftw)
#:use-module (ice-9 threads)
@@ -638,7 +639,42 @@ started)."
(spawn-builds store valid)
(log-message "done with restarted builds"))))
-(define (build-packages store jobs eval-id)
+(define (create-build-outputs builds product-specs)
+ "Given BUILDS a list of built derivations, save the build products described
+by PRODUCT-SPECS."
+ (define (find-build job-regex)
+ (find (lambda (build)
+ (let ((job-name (assq-ref build #:job-name)))
+ (string-match job-regex job-name)))
+ builds))
+
+ (define* (find-product build spec)
+ (let* ((outputs (assq-ref build #:outputs))
+ (output (assq-ref spec #:output))
+ (path (assq-ref spec #:path))
+ (root (and=> (assoc-ref outputs output)
+ (cut assq-ref <> #:path))))
+ (and root
+ (if (string=? path "")
+ root
+ (string-append root "/" path)))))
+
+ (define (file-size file)
+ (stat:size (stat file)))
+
+ (map (lambda (spec)
+ (let* ((build (find-build (assq-ref spec #:job)))
+ (product (find-product build spec)))
+ (when (and product (file-exists? product))
+ (db-add-build-product `((#:build . ,(assq-ref build #:id))
+ (#:type . (assq-ref spec #:type))
+ (#:file-size . ,(file-size product))
+ ;; TODO: Implement it.
+ (#:sha256-hash . "")
+ (#:path . ,product))))))
+ product-specs))
+
+(define (build-packages store spec jobs eval-id)
"Build JOBS and return a list of Build results."
(define (register job)
(let* ((name (assq-ref job #:job-name))
@@ -692,6 +728,8 @@ started)."
outputs))
outputs))
(fail (- (length derivations) success)))
+
+ (create-build-outputs results (assq-ref spec #:build-outputs))
(log-message "outputs:\n~a" (string-join outs "\n"))
(log-message "success: ~a, fail: ~a" success fail)
results))
@@ -777,7 +815,7 @@ started)."
(let ((jobs (evaluate store spec eval-id checkouts)))
(log-message "building ~a jobs for '~a'"
(length jobs) name)
- (build-packages store jobs eval-id))))))
+ (build-packages store spec jobs eval-id))))))
;; 'spawn-fiber' returns zero values but we need one.
*unspecified*))))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index f80585e..0ed0720 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -1,6 +1,6 @@
;;; database.scm -- store evaluation and build results
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl <at> gnu.org>
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2018, 2020 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
;;; Copyright © 2018 Tatiana Sholokhova <tanja201396 <at> gmail.com>
@@ -47,6 +47,7 @@
db-get-pending-derivations
build-status
db-add-build
+ db-add-build-product
db-update-build-status!
db-get-output
db-get-inputs
@@ -65,6 +66,8 @@
db-get-evaluations-id-min
db-get-evaluations-id-max
db-get-evaluation-specification
+ db-get-build-product-path
+ db-get-build-products
db-get-evaluation-summary
db-get-checkouts
read-sql-file
@@ -334,7 +337,8 @@ table."
(with-db-worker-thread db
(sqlite-exec db "\
INSERT OR IGNORE INTO Specifications (name, load_path_inputs, \
-package_path_inputs, proc_input, proc_file, proc, proc_args) \
+package_path_inputs, proc_input, proc_file, proc, proc_args, \
+build_outputs) \
VALUES ("
(assq-ref spec #:name) ", "
(assq-ref spec #:load-path-inputs) ", "
@@ -342,7 +346,8 @@ package_path_inputs, proc_input, proc_file, proc, proc_args) \
(assq-ref spec #:proc-input) ", "
(assq-ref spec #:proc-file) ", "
(symbol->string (assq-ref spec #:proc)) ", "
- (assq-ref spec #:proc-args) ");")
+ (assq-ref spec #:proc-args) ", "
+ (assq-ref spec #:build-outputs) ");")
(let ((spec-id (last-insert-rowid db)))
(for-each (lambda (input)
(db-add-input (assq-ref spec #:name) input))
@@ -386,7 +391,7 @@ DELETE FROM Specifications WHERE name=" name ";")
(match rows
(() specs)
((#(name load-path-inputs package-path-inputs proc-input proc-file proc
- proc-args)
+ proc-args build-outputs)
. rest)
(loop rest
(cons `((#:name . ,name)
@@ -398,7 +403,9 @@ DELETE FROM Specifications WHERE name=" name ";")
(#:proc-file . ,proc-file)
(#:proc . ,(with-input-from-string proc read))
(#:proc-args . ,(with-input-from-string proc-args read))
- (#:inputs . ,(db-get-inputs name)))
+ (#:inputs . ,(db-get-inputs name))
+ (#:build-outputs .
+ ,(with-input-from-string build-outputs read)))
specs)))))))
(define (db-add-evaluation spec-name checkouts)
@@ -538,6 +545,19 @@ VALUES ("
=>
(sqlite-exec db "ROLLBACK;") #f))))
+(define (db-add-build-product product)
+ "Insert PRODUCT into BuildProducts table."
+ (with-db-worker-thread db
+ (sqlite-exec db "\
+INSERT INTO BuildProducts (build, type, file_size, sha256_hash,
+path) VALUES ("
+ (assq-ref product #:build) ", "
+ (assq-ref product #:type) ", "
+ (assq-ref product #:file-size) ", "
+ (assq-ref product #:sha256-hash) ", "
+ (assq-ref product #:path) ");")
+ (last-insert-rowid db)))
+
(define* (db-update-build-status! drv status #:key log-file)
"Update the database so that DRV's status is STATUS. This also updates the
'starttime' or 'stoptime' fields. If LOG-FILE is true, record it as the build
@@ -1066,3 +1086,30 @@ AND (" status " IS NULL OR (" status " = 'pending'
SELECT specification FROM Evaluations
WHERE id = " eval)))
(and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+
+(define (db-get-build-product-path id)
+ "Return the build product with the given ID."
+ (with-db-worker-thread db
+ (let ((rows (sqlite-exec db "
+SELECT path FROM BuildProducts
+WHERE rowid = " id)))
+ (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+
+(define (db-get-build-products build-id)
+ "Return the build products associated to the given BUILD-ID."
+ (with-db-worker-thread db
+ (let loop ((rows (sqlite-exec db "
+SELECT rowid, type, file_size, sha256_hash, path from BuildProducts
+WHERE build = " build-id))
+ (products '()))
+ (match rows
+ (() (reverse products))
+ ((#(id type file-size sha256-hash path)
+ . rest)
+ (loop rest
+ (cons `((#:id . ,id)
+ (#:type . ,type)
+ (#:file-size . ,file-size)
+ (#:sha256-hash . ,sha256-hash)
+ (#:path . ,path))
+ products)))))))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index c5901f0..79fa246 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -1,6 +1,6 @@
;;;; http.scm -- HTTP API
;;; Copyright © 2016 Mathieu Lirzin <mthl <at> gnu.org>
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
;;; Copyright © 2018 Tatiana Sholokhova <tanja201396 <at> gmail.com>
@@ -246,17 +246,29 @@ Hydra format."
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
(sxml->xml body port))))
+ (define* (respond-file file
+ #:key name)
+ (let ((content-type (or (assoc-ref %file-mime-types
+ (file-extension file))
+ '(application/octet-stream))))
+ (respond `((content-type . ,content-type)
+ ,@(if name
+ `((content-disposition
+ . (form-data (filename . ,name))))
+ '()))
+ ;; FIXME: FILE is potentially big so it'd be better to not load
+ ;; it in memory and instead 'sendfile' it.
+ #:body (call-with-input-file file get-bytevector-all))))
+
(define (respond-static-file path)
;; PATH is a list of path components
(let ((file-name (string-join path "/"))
(file-path (string-join (cons* (%static-directory) path) "/")))
- (if (and (member file-name %file-white-list)
+ (if (and (member file-name %file-white-list)
(file-exists? file-path)
(not (file-is-directory? file-path)))
- (respond `((content-type . ,(assoc-ref %file-mime-types
- (file-extension file-path))))
- #:body (call-with-input-file file-path get-bytevector-all))
- (respond-not-found file-name))))
+ (respond-file file-path)
+ (respond-not-found file-name))))
(define (respond-gzipped-file file)
;; Return FILE with 'gzip' content-encoding.
@@ -318,7 +330,8 @@ Hydra format."
(#:url . "https://git.savannah.gnu.org/git/guix.git")
(#:load-path . ".")
(#:branch . ,name)
- (#:no-compile? . #t)))))
+ (#:no-compile? . #t)))
+ (#:build-outputs . ())))
(respond (build-response #:code 302
#:headers `((location . ,(string->uri-reference
"/admin/specifications"))))
@@ -352,11 +365,12 @@ Hydra format."
(respond-json (object->json-string hydra-build))
(respond-build-not-found id))))
(('GET "build" build-id "details")
- (let ((build (db-get-build (string->number build-id))))
+ (let ((build (db-get-build (string->number build-id)))
+ (products (db-get-build-products build-id)))
(if build
(respond-html
(html-page (string-append "Build " build-id)
- (build-details build)
+ (build-details build products)
`(((#:name . ,(assq-ref build #:specification))
(#:link . ,(string-append "/jobset/" (assq-ref build #:specification)))))))
(respond-build-not-found build-id))))
@@ -505,6 +519,10 @@ Hydra format."
query))
(respond-json-with-error 500 "Query parameter not provided!"))))
+ (('GET "download" id)
+ (let ((path (db-get-build-product-path id)))
+ (respond-file path #:name (basename path))))
+
(('GET "static" path ...)
(respond-static-file path))
(_
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 4104c7b..600d9d8 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018 Tatiana Sholokhova <tanja201396 <at> gmail.com>
;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2019, 2020 Ricardo Wurmus <rekado <at> elephly.net>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -27,6 +28,7 @@
#:use-module (srfi srfi-26)
#:use-module (web uri)
#:use-module (guix derivations)
+ #:use-module (guix progress)
#:use-module (guix store)
#:use-module ((guix utils) #:select (string-replace-substring))
#:use-module ((cuirass database) #:select (build-status))
@@ -212,7 +214,7 @@ system whose names start with " (code "guile-") ":" (br)
"Add")))))
'()))))
-(define (build-details build)
+(define (build-details build products)
"Return HTML showing details for the BUILD."
(define status (assq-ref build #:status))
(define blocking-outputs
@@ -282,7 +284,38 @@ system whose names start with " (code "guile-") ":" (br)
(tr (th "Outputs")
(td ,(map (match-lambda ((out (#:path . path))
`(pre ,path)))
- (assq-ref build #:outputs))))))))
+ (assq-ref build #:outputs))))
+ ,@(if (null? products)
+ '()
+ (let ((product-items
+ (map
+ (lambda (product)
+ (let* ((id (assq-ref product #:id))
+ (size (assq-ref product #:file-size))
+ (type (assq-ref product #:type))
+ (path (assq-ref product #:path))
+ (href (format #f "/download/~a" id)))
+ `(a (@ (href ,href))
+ (li (@ (class "list-group-item"))
+ (div
+ (@ (class "container"))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-md-auto"))
+ (span
+ (@ (class "oi oi-data-transfer-download")
+ (title "Download")
+ (aria-hidden "true"))))
+ (div (@ (class "col-md-auto"))
+ ,path)
+ (div (@ (class "col-md-auto"))
+ "(" ,(byte-count->string size) ")")))))))
+ products)))
+ `((tr (th "Build outputs")
+ (td
+ (ul (@ (class "list-group d-flex flex-row"))
+ ,product-items))))))))))
(define (pagination first-link prev-link next-link last-link)
"Return html page navigation buttons with LINKS."
diff --git a/src/schema.sql b/src/schema.sql
index 1104551..3838f75 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -7,7 +7,8 @@ CREATE TABLE Specifications (
proc_input TEXT NOT NULL, -- name of the input containing the proc that does the evaluation
proc_file TEXT NOT NULL, -- file containing the procedure that does the evaluation, relative to proc_input
proc TEXT NOT NULL, -- defined in proc_file
- proc_args TEXT NOT NULL -- passed to proc
+ proc_args TEXT NOT NULL, -- passed to proc
+ build_outputs TEXT NOT NULL --specify what build outputs should be made available for download
);
CREATE TABLE Inputs (
@@ -65,6 +66,16 @@ CREATE TABLE Builds (
FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
);
+CREATE TABLE BuildProducts (
+ build INTEGER NOT NULL,
+ type TEXT NOT NULL,
+ file_size BIGINT NOT NULL,
+ sha256_hash TEXT NOT NULL,
+ path TEXT NOT NULL,
+ PRIMARY KEY (build, path)
+ FOREIGN KEY (build) REFERENCES Builds (id) ON DELETE CASCADE
+);
+
CREATE TABLE Events (
id INTEGER PRIMARY KEY,
type TEXT NOT NULL,
diff --git a/src/sql/upgrade-7.sql b/src/sql/upgrade-7.sql
new file mode 100644
index 0000000..02e9c41
--- /dev/null
+++ b/src/sql/upgrade-7.sql
@@ -0,0 +1,15 @@
+BEGIN TRANSACTION;
+
+CREATE TABLE BuildProducts (
+ build INTEGER NOT NULL,
+ type TEXT NOT NULL,
+ file_size BIGINT NOT NULL,
+ sha256_hash TEXT NOT NULL,
+ path TEXT NOT NULL,
+ PRIMARY KEY (build, path)
+ FOREIGN KEY (build) REFERENCES Builds (id) ON DELETE CASCADE
+);
+
+ALTER TABLE Specifications ADD build_outputs TEXT NOT NULL DEFAULT "()";
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index 6098465..98b5012 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2016 Mathieu Lirzin <mthl <at> gnu.org>
;;; Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -45,7 +46,8 @@
(#:branch . "master")
(#:tag . #f)
(#:commit . #f)
- (#:no-compile? . #f))))))
+ (#:no-compile? . #f))))
+ (#:build-outputs . ())))
(define (make-dummy-checkouts fakesha1 fakesha2)
`(((#:commit . ,fakesha1)
diff --git a/tests/http.scm b/tests/http.scm
index d20a3c3..d69c25c 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -1,7 +1,7 @@
;;; http.scm -- tests for (cuirass http) module
;;; Copyright © 2016 Mathieu Lirzin <mthl <at> gnu.org>
;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
;;;
;;; This file is part of Cuirass.
@@ -170,7 +170,8 @@
(#:branch . "master")
(#:tag . #f)
(#:commit . #f)
- (#:no-compile? . #f))))))
+ (#:no-compile? . #f))))
+ (#:build-outputs . ())))
(checkouts1
'(((#:commit . "fakesha1")
(#:input . "savannah")
--
2.26.0
[download.png (image/png, attachment)]
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Fri, 01 May 2020 10:10:02 GMT) Full text and rfc822 format available.Message #8 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Mathieu Othacehe <m.othacehe <at> gmail.com> Cc: ludo <at> gnu.org, 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Fri, 1 May 2020 12:09:14 +0200
[Message part 1 (text/plain, inline)]
Hi Mathieu,
very cool!
Though I agree using sendfile would be much better, especially since the user
can download 800 MB image files there.
The guile (web server) module allows passing a procedure as the #:body, but
then it makes a bytevector out of the result and hard-codes the content-type :P.
Eventually (web server http) http-write is reached, which only supports encoding
bytevectors and #f, that's it. No files.
So we'd have to overwrite http-write.
But we are using our own (web server fiberized) impl already.
So our impl chould be extended to be able to get and process FDs.
client-loop there has
(lambda (response body)
(write-response response client)
(when body
(put-bytevector client body))
which means the "when body" part should be extended to also handle files, not just bytevectors.
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Fri, 01 May 2020 13:37:01 GMT) Full text and rfc822 format available.Message #11 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <m.othacehe <at> gmail.com> To: Danny Milosavljevic <dannym <at> scratchpost.org> Cc: ludo <at> gnu.org, 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Fri, 01 May 2020 15:35:50 +0200
[Message part 1 (text/plain, inline)]
Hey Danny, > very cool! Thanks :) > Though I agree using sendfile would be much better, especially since the user > can download 800 MB image files there. > > The guile (web server) module allows passing a procedure as the #:body, but > then it makes a bytevector out of the result and hard-codes the content-type :P. > > Eventually (web server http) http-write is reached, which only supports encoding > bytevectors and #f, that's it. No files. > > So we'd have to overwrite http-write. > > But we are using our own (web server fiberized) impl already. > > So our impl chould be extended to be able to get and process FDs. > > client-loop there has > > (lambda (response body) > (write-response response client) > (when body > (put-bytevector client body)) > > which means the "when body" part should be extended to also handle files, not just bytevectors. The problem is that even with our fiberized implementation, what we pass as "body" is checked in "sanitize-response" procedure of Guile's (web server) module. With the (very) hacky patch attached, I fool sanitize-response, by sending the file name as a bytevector. This allows me to save gigabytes of RAM when downloading disk images. WDYT? Thanks, Mathieu
[0001-cuirass-Use-sendfiles-instead-of-raw-copies.patch (text/x-diff, inline)]
From 0c5e91c170639d50d1cc339fa0b0e68ea4fba68c Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe <at> gmail.com>
Date: Fri, 1 May 2020 15:03:12 +0200
Subject: [PATCH] cuirass: Use sendfiles instead of raw copies.
* src/cuirass/http.scm (respond-file): Send the file name as an UTF8
bytevector, instead of the raw file content,
(respond-gzipped-file): ditto. Also set 'content-disposition header.
* src/web/server/fiberized.scm (client-loop): Check if 'content-disposition is
set. If it's the case, assume that the bytevector is the file name, and use
sendfiles to send it. Otherwise, keep the existing behaviour and send directly
the received bytevector.
---
src/cuirass/http.scm | 25 ++++++++++---------------
src/web/server/fiberized.scm | 21 +++++++++++++++++++--
2 files changed, 29 insertions(+), 17 deletions(-)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 79fa246..bdc780c 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -40,7 +40,8 @@
#:use-module (web uri)
#:use-module (fibers)
#:use-module (fibers channels)
- #:use-module ((rnrs bytevectors) #:select (utf8->string))
+ #:use-module ((rnrs bytevectors) #:select (utf8->string
+ string->utf8))
#:use-module (sxml simple)
#:use-module (cuirass templates)
#:use-module (guix utils)
@@ -246,19 +247,14 @@ Hydra format."
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
(sxml->xml body port))))
- (define* (respond-file file
- #:key name)
+ (define* (respond-file file)
(let ((content-type (or (assoc-ref %file-mime-types
(file-extension file))
'(application/octet-stream))))
(respond `((content-type . ,content-type)
- ,@(if name
- `((content-disposition
- . (form-data (filename . ,name))))
- '()))
- ;; FIXME: FILE is potentially big so it'd be better to not load
- ;; it in memory and instead 'sendfile' it.
- #:body (call-with-input-file file get-bytevector-all))))
+ (content-disposition
+ . (form-data (filename . ,(basename file)))))
+ #:body (string->utf8 file))))
(define (respond-static-file path)
;; PATH is a list of path components
@@ -273,10 +269,9 @@ Hydra format."
(define (respond-gzipped-file file)
;; Return FILE with 'gzip' content-encoding.
(respond `((content-type . (text/plain (charset . "UTF-8")))
- (content-encoding . (gzip)))
- ;; FIXME: FILE is potentially big so it'd be better to not load
- ;; it in memory and instead 'sendfile' it.
- #:body (call-with-input-file file get-bytevector-all)))
+ (content-encoding . (gzip))
+ (content-disposition . (form-data (filename . ,file))))
+ #:body (string->utf8 file)))
(define (respond-build-not-found build-id)
(respond-json-with-error
@@ -521,7 +516,7 @@ Hydra format."
(('GET "download" id)
(let ((path (db-get-build-product-path id)))
- (respond-file path #:name (basename path))))
+ (respond-file path)))
(('GET "static" path ...)
(respond-static-file path))
diff --git a/src/web/server/fiberized.scm b/src/web/server/fiberized.scm
index 308b642..68ae132 100644
--- a/src/web/server/fiberized.scm
+++ b/src/web/server/fiberized.scm
@@ -37,6 +37,7 @@
#:use-module (web request)
#:use-module (web response)
#:use-module (web server)
+ #:use-module ((rnrs bytevectors) #:select (utf8->string))
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 match)
#:use-module (fibers)
@@ -92,6 +93,8 @@
((0) (memq 'keep-alive (response-connection response)))))
(else #f)))))
+(define extend-response (@@ (web server) extend-response))
+
(define (client-loop client have-request)
;; Always disable Nagle's algorithm, as we handle buffering
;; ourselves.
@@ -119,9 +122,23 @@
#:headers '((content-length . 0)))
#vu8()))))
(lambda (response body)
- (write-response response client)
(when body
- (put-bytevector client body))
+ (let* ((headers (response-headers response))
+ (file? (assq-ref headers 'content-disposition))
+ (file (and file? (utf8->string body)))
+ (file-size (and file? (stat:size (stat file)))))
+ (cond
+ (file?
+ (call-with-input-file file
+ (lambda (port)
+ (write-response
+ (extend-response response 'content-length
+ file-size)
+ client)
+ (sendfile client port file-size))))
+ (else
+ (write-response response client)
+ (put-bytevector client body)))))
(force-output client)
(if (and (keep-alive? response)
(not (eof-object? (peek-char client))))
--
2.26.0
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Fri, 01 May 2020 21:13:02 GMT) Full text and rfc822 format available.Message #14 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Danny Milosavljevic <dannym <at> scratchpost.org> Cc: Mathieu Othacehe <m.othacehe <at> gmail.com>, 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Fri, 01 May 2020 23:11:38 +0200
Hi, Danny Milosavljevic <dannym <at> scratchpost.org> skribis: > Though I agree using sendfile would be much better, especially since the user > can download 800 MB image files there. > > The guile (web server) module allows passing a procedure as the #:body, but > then it makes a bytevector out of the result and hard-codes the content-type :P. > > Eventually (web server http) http-write is reached, which only supports encoding > bytevectors and #f, that's it. No files. > > So we'd have to overwrite http-write. See how ‘guix publish’ uses ‘sendfile’ for nars. It’s hacky because it works around <https://issues.guix.gnu.org/issue/21093>. Ludo’.
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Fri, 01 May 2020 21:18:01 GMT) Full text and rfc822 format available.Message #17 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Mathieu Othacehe <m.othacehe <at> gmail.com> Cc: Danny Milosavljevic <dannym <at> scratchpost.org>, 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Fri, 01 May 2020 23:17:09 +0200
Hello!
Mathieu Othacehe <m.othacehe <at> gmail.com> skribis:
> With the (very) hacky patch attached, I fool sanitize-response, by
> sending the file name as a bytevector. This allows me to save gigabytes
> of RAM when downloading disk images.
Yay! This is similar to what ‘guix publish’ does. :-)
> From 0c5e91c170639d50d1cc339fa0b0e68ea4fba68c Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe <at> gmail.com>
> Date: Fri, 1 May 2020 15:03:12 +0200
> Subject: [PATCH] cuirass: Use sendfiles instead of raw copies.
>
> * src/cuirass/http.scm (respond-file): Send the file name as an UTF8
> bytevector, instead of the raw file content,
> (respond-gzipped-file): ditto. Also set 'content-disposition header.
> * src/web/server/fiberized.scm (client-loop): Check if 'content-disposition is
> set. If it's the case, assume that the bytevector is the file name, and use
> sendfiles to send it. Otherwise, keep the existing behaviour and send directly
> the received bytevector.
> +(define extend-response (@@ (web server) extend-response))
@@ is evil and it’s not guaranteed to work with Guile 3: the procedure
might be inlined.
But you can use these ‘guix publish’ helper procedures, which rely on
(srfi srfi-9 gnu):
(define (strip-headers response)
"Return RESPONSE's headers minus 'Content-Length' and our internal headers."
(fold alist-delete
(response-headers response)
'(content-length x-raw-file x-nar-compression)))
(define (with-content-length response length)
"Return RESPONSE with a 'content-length' header set to LENGTH."
(set-field response (response-headers)
(alist-cons 'content-length length
(strip-headers response))))
> + (call-with-input-file file
> + (lambda (port)
> + (write-response
> + (extend-response response 'content-length
> + file-size)
> + client)
> + (sendfile client port file-size))))
I didn’t look at the other patches, but note that ‘sendfile’ blocks.
Since Cuirass is fiberized, you shouldn’t block a fiber.
‘guix publish’ doesn’t use Fibers but it shouldn’t block either while
sending a nar, so what it does is spawn a new thread for the ‘sendfile’
call.
HTH!
Ludo’.
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Wed, 03 Jun 2020 11:55:01 GMT) Full text and rfc822 format available.Message #20 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: Danny Milosavljevic <dannym <at> scratchpost.org>, 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Wed, 03 Jun 2020 13:54:30 +0200
[Message part 1 (text/plain, inline)]
Hello Ludo, > I didn’t look at the other patches, but note that ‘sendfile’ blocks. > Since Cuirass is fiberized, you shouldn’t block a fiber. > > ‘guix publish’ doesn’t use Fibers but it shouldn’t block either while > sending a nar, so what it does is spawn a new thread for the ‘sendfile’ > call. Thanks for your help! I copied what's done in (guix scripts publish), except that I used "non-blocking" instead of using a plain "call-with-new-thread". If you could have a short look to the first patch (introducing build products) and tell me if the concept is ok for you, that would be great :) Thanks, Mathieu
[0001-cuirass-Use-sendfiles-instead-of-raw-copies.patch (text/x-diff, inline)]
From c99cc0314b98e349a577f38870d1271a3f1c3a54 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe <at> gmail.com>
Date: Wed, 3 Jun 2020 13:41:30 +0200
Subject: [PATCH] cuirass: Use sendfiles instead of raw copies.
* src/cuirass/http.scm (respond-file): Send the file name as 'x-raw-file
header argument, instead of the raw file content,
(respond-gzipped-file): ditto. Also set 'content-disposition header.
* src/web/server/fiberized.scm (strip-headers, with-content-length): New procedures,
(client-loop): Check if 'x-raw-file is set. If it's the case, use sendfiles to
send the given file. Otherwise, keep the existing behaviour and send directly
the received bytevector.
---
src/cuirass/http.scm | 22 ++++++--------
src/web/server/fiberized.scm | 56 +++++++++++++++++++++++++++++-------
2 files changed, 54 insertions(+), 24 deletions(-)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 79fa246..0b2f056 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -246,19 +246,14 @@ Hydra format."
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
(sxml->xml body port))))
- (define* (respond-file file
- #:key name)
+ (define* (respond-file file)
(let ((content-type (or (assoc-ref %file-mime-types
(file-extension file))
'(application/octet-stream))))
(respond `((content-type . ,content-type)
- ,@(if name
- `((content-disposition
- . (form-data (filename . ,name))))
- '()))
- ;; FIXME: FILE is potentially big so it'd be better to not load
- ;; it in memory and instead 'sendfile' it.
- #:body (call-with-input-file file get-bytevector-all))))
+ (content-disposition
+ . (form-data (filename . ,(basename file))))
+ (x-raw-file . ,file)))))
(define (respond-static-file path)
;; PATH is a list of path components
@@ -273,10 +268,9 @@ Hydra format."
(define (respond-gzipped-file file)
;; Return FILE with 'gzip' content-encoding.
(respond `((content-type . (text/plain (charset . "UTF-8")))
- (content-encoding . (gzip)))
- ;; FIXME: FILE is potentially big so it'd be better to not load
- ;; it in memory and instead 'sendfile' it.
- #:body (call-with-input-file file get-bytevector-all)))
+ (content-encoding . (gzip))
+ (content-disposition . (form-data (filename . ,file)))
+ (x-raw-file . ,file))))
(define (respond-build-not-found build-id)
(respond-json-with-error
@@ -521,7 +515,7 @@ Hydra format."
(('GET "download" id)
(let ((path (db-get-build-product-path id)))
- (respond-file path #:name (basename path))))
+ (respond-file path)))
(('GET "static" path ...)
(respond-static-file path))
diff --git a/src/web/server/fiberized.scm b/src/web/server/fiberized.scm
index 308b642..7769202 100644
--- a/src/web/server/fiberized.scm
+++ b/src/web/server/fiberized.scm
@@ -31,8 +31,12 @@
;;; Code:
(define-module (web server fiberized)
- #:use-module ((srfi srfi-1) #:select (fold))
+ #:use-module (guix build utils)
+ #:use-module ((srfi srfi-1) #:select (fold
+ alist-delete
+ alist-cons))
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
#:use-module (web http)
#:use-module (web request)
#:use-module (web response)
@@ -41,7 +45,8 @@
#:use-module (ice-9 match)
#:use-module (fibers)
#:use-module (fibers channels)
- #:use-module (cuirass logging))
+ #:use-module (cuirass logging)
+ #:use-module (cuirass utils))
(define (make-default-socket family addr port)
(let ((sock (socket PF_INET SOCK_STREAM 0)))
@@ -92,6 +97,19 @@
((0) (memq 'keep-alive (response-connection response)))))
(else #f)))))
+;; This procedure and the next one are copied from (guix scripts publish).
+(define (strip-headers response)
+ "Return RESPONSE's headers minus 'Content-Length' and our internal headers."
+ (fold alist-delete
+ (response-headers response)
+ '(content-length x-raw-file x-nar-compression)))
+
+(define (with-content-length response length)
+ "Return RESPONSE with a 'content-length' header set to LENGTH."
+ (set-field response (response-headers)
+ (alist-cons 'content-length length
+ (strip-headers response))))
+
(define (client-loop client have-request)
;; Always disable Nagle's algorithm, as we handle buffering
;; ourselves.
@@ -119,14 +137,32 @@
#:headers '((content-length . 0)))
#vu8()))))
(lambda (response body)
- (write-response response client)
- (when body
- (put-bytevector client body))
- (force-output client)
- (if (and (keep-alive? response)
- (not (eof-object? (peek-char client))))
- (loop)
- (close-port client)))))))))
+ (match (assoc-ref (response-headers response) 'x-raw-file)
+ ((? string? file)
+ (non-blocking
+ (call-with-input-file file
+ (lambda (input)
+ (let* ((size (stat:size (stat input)))
+ (response (write-response
+ (with-content-length response size)
+ client))
+ (output (response-port response)))
+ (setsockopt client SOL_SOCKET SO_SNDBUF
+ (* 128 1024))
+ (if (file-port? output)
+ (sendfile output input size)
+ (dump-port input output))
+ (close-port output)
+ (values))))))
+ (#f (begin
+ (write-response response client)
+ (when body
+ (put-bytevector client body))
+ (force-output client))
+ (if (and (keep-alive? response)
+ (not (eof-object? (peek-char client))))
+ (loop)
+ (close-port client)))))))))))
(lambda (k . args)
(catch #t
(lambda () (close-port client))
--
2.26.2
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Wed, 03 Jun 2020 20:15:02 GMT) Full text and rfc822 format available.Message #23 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Mathieu Othacehe <othacehe <at> gnu.org> Cc: Danny Milosavljevic <dannym <at> scratchpost.org>, 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Wed, 03 Jun 2020 22:14:16 +0200
Hi! Mathieu Othacehe <othacehe <at> gnu.org> skribis: > From c99cc0314b98e349a577f38870d1271a3f1c3a54 Mon Sep 17 00:00:00 2001 > From: Mathieu Othacehe <m.othacehe <at> gmail.com> > Date: Wed, 3 Jun 2020 13:41:30 +0200 > Subject: [PATCH] cuirass: Use sendfiles instead of raw copies. > > * src/cuirass/http.scm (respond-file): Send the file name as 'x-raw-file > header argument, instead of the raw file content, > (respond-gzipped-file): ditto. Also set 'content-disposition header. > * src/web/server/fiberized.scm (strip-headers, with-content-length): New procedures, > (client-loop): Check if 'x-raw-file is set. If it's the case, use sendfiles to > send the given file. Otherwise, keep the existing behaviour and send directly > the received bytevector. If it works for you, LGTM! Ludo’.
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Wed, 03 Jun 2020 20:28:01 GMT) Full text and rfc822 format available.Message #26 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Mathieu Othacehe <m.othacehe <at> gmail.com> Cc: 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Wed, 03 Jun 2020 22:26:51 +0200
Hello! Mathieu Othacehe <m.othacehe <at> gmail.com> skribis: > Here's a patch adding support for build products downloading in > Cuirass. It is inspired by a similar mechanism in Hydra. Neat! > Attached a screenshot of what I obtained with the following > specification: > > (define hello-master > '((#:name . "guix-master") > (#:load-path-inputs . ()) > (#:package-path-inputs . ()) > (#:proc-input . "guix") > (#:proc-file . "build-aux/cuirass/gnu-system.scm") > (#:proc . cuirass-jobs) > (#:proc-args (subset . "all")) > (#:inputs . (((#:name . "guix") > (#:url . "https://gitlab.com/mothacehe/guix") > (#:load-path . ".") > (#:branch . "master") > (#:no-compile? . #t)))) > (#:build-outputs . (((#:job . "iso9660-image*") > (#:type . "iso") > (#:output . "out") > (#:path . "")))))) For the record, in Hydra, build products would be found if there’s a special ‘nix-support/hydra-build-products’ file in the output. The advantage is that it’s more flexible, but the downside is that you’d have to adjust your derivations specifically for that. >>From dbb78929d7c8aa3b9007660795f55232ab47dbfb Mon Sep 17 00:00:00 2001 > From: Mathieu Othacehe <m.othacehe <at> gmail.com> > Date: Fri, 1 May 2020 10:32:18 +0200 > Subject: [PATCH] Add support for build products downloading. > > * src/sql/upgrade-7.sql: New file. > * Makefile.am: Add it. > * src/cuirass/base.scm (create-build-outputs): New procedure, > (build-packages): call it, > (process-spec): add the new spec argument and pass it to create-build-outputs. > * src/cuirass/database.scm (db-add-build-product, db-get-build-product-path, > db-get-build-products): New exported procedures. > * src/cuirass/http.scm (respond-static-file): Move file sending to ... > (respond-file): ... this new procedure, > (url-handler): add a new "download/<id>" route, serving the requested file > with the new respond-file procedure. Also gather build products and pass them > to "build-details" for "build/<id>/details" route. > * src/cuirass/templates.scm (build-details): Honor the new "products" argument > to display all the build products associated to the given build. > * src/schema.sql (BuildProducts): New table, > (Specifications)[build_outputs]: new field. > * tests/database.scm: Add empty build-outputs spec. > * tests/http.scm: Ditto. > * examples/guix-jobs.scm: Ditto. > * examples/hello-git.scm: Ditto. > * examples/hello-singleton.scm: Ditto. > * examples/hello-subset.scm: Ditto. > * examples/random.scm: Ditto. > * doc/cuirass.texi (overview): Document it. [...] > + (map (lambda (spec) > + (let* ((build (find-build (assq-ref spec #:job))) > + (product (find-product build spec))) > + (when (and product (file-exists? product)) > + (db-add-build-product `((#:build . ,(assq-ref build #:id)) > + (#:type . (assq-ref spec #:type)) > + (#:file-size . ,(file-size product)) > + ;; TODO: Implement it. > + (#:sha256-hash . "") > + (#:path . ,product)))))) > + product-specs)) Use ‘for-each’ if it’s for effects, as seems to be the case. Regarding #:sha256-hash: there’s a somewhat standard format to represent hashes and their algorithms as strings, but I forgot the name. Like, you’d write “sha256-” followed by a base64 string, something like that. Perhaps it’d be wiser to use it rather than hard-code sha256? Also, we don’t really have tests for the web UI, I don’t know how much work it’d be to add tests. Apart from that, I have little to say, other than the fact that it’s really cool. :-) Thank you! Ludo’.
guix-patches <at> gnu.org:bug#40993; Package guix-patches.
(Wed, 10 Jun 2020 15:45:01 GMT) Full text and rfc822 format available.Message #29 received at 40993 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <m.othacehe <at> gmail.com> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 40993 <at> debbugs.gnu.org Subject: Re: [bug#40993] cuirass: Add build products download support. Date: Wed, 10 Jun 2020 17:44:29 +0200
Hola! > For the record, in Hydra, build products would be found if there’s a > special ‘nix-support/hydra-build-products’ file in the output. The > advantage is that it’s more flexible, but the downside is that you’d > have to adjust your derivations specifically for that. Yes, I first hesitated to replicate this mechanism but finally opted for the implemented one. I didn't like so much the idea of adding and extra, CI-specific file, to the output of some jobs. > Use ‘for-each’ if it’s for effects, as seems to be the case. Oh you keep repeating that to me, and I keep doing the same mistake! > Regarding #:sha256-hash: there’s a somewhat standard format to represent > hashes and their algorithms as strings, but I forgot the name. Like, > you’d write “sha256-” followed by a base64 string, something like that. > > Perhaps it’d be wiser to use it rather than hard-code sha256? Yes sure, I changed the database field to "checksum" so that we can use the string representation you're talking about. > Also, we don’t really have tests for the web UI, I don’t know how much > work it’d be to add tests. If a more web-aware hacker could propose something, it would be great indeed :) > Apart from that, I have little to say, other than the fact that it’s > really cool. :-) Thanks for reviewing! I just pushed those two commits and updated the Cuirass package. Now I'll see with Marius or Ricardo how to update Berlin, I guess. Thanks, Mathieu
Mathieu Othacehe <mathieu <at> meru.i-did-not-set--mail-host-address--so-tickle-me>
to control <at> debbugs.gnu.org.
(Wed, 10 Jun 2020 15:54:01 GMT) Full text and rfc822 format available.Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Thu, 09 Jul 2020 11:24:07 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.