From 4612a3a70f1e70afa4e0ce00e8cb1a7848dddf58 Mon Sep 17 00:00:00 2001
From: Clément Lassieur <clement@lassieur.org>
Date: Sun, 5 Aug 2018 13:14:44 +0200
Subject: database: Serialize all database accesses in a thread.

Fixes <https://bugs.gnu.org/32234>.

* bin/cuirass.in (main): Keep only one WITH-DATABASE call around all fibers.
Remove all DB arguments.
* src/cuirass/base.scm (evaluate, update-build-statuses!, spawn-builds,
handle-build-event, build-packages): Remove all DB arguments.
(clear-build-queue, cancel-old-builds): Wrap in WITH-DB-CRITICAL-SECTION,
remove all DB arguments.
(restart-builds): Remove the NON-BLOCKING call, remove all DB arguments.
(process-specs): Remove all DB arguments, remove the WITH-DATABASE call.
* src/cuirass/database.scm (%db-channel): New parameter.
(with-db-critical-section): New macro.
(db-add-input, db-add-specification, db-get-inputs, db-get-specifications,
db-add-evaluation, db-add-build, db-update-build-status!, db-get-outputs,
db-get-builds, db-get-build, db-get-pending-derivations, db-get-stamp,
db-add-stamp, db-get-evaluations, db-get-evaluations-build-summary,
db-get-evaluations-id-min, db-get-evaluations-id-max, db-get-builds-min,
db-get-builds-max): Wrap in WITH-DB-CRITICAL-SECTION, remove all DB arguments.
(with-database): Wrap BODY in PARAMETERIZE form that sets %DB-CHANNEL to the
channel returned by MAKE-CRITICAL-SECTION.
* src/cuirass/http.scm (handle-build-request, handle-builds-request): Remove
all DB arguments.
(url-handler): Remove all DB arguments, remove the DB-CHANNEL state, remove
the WITH-CRITICAL-SECTION calls.
(run-cuirass-server): Remove the DB arguments, remove the
MAKE-CRITICAL-SECTION call.
* src/cuirass/utils.scm (make-critical-section): Replace SPAWN-FIBER with
CALL-WITH-NEW-THREAD.  Wrap body in PARAMETERIZE form that clears
CURRENT-FIBER.
* tests/database.scm (with-temporary-database, "db-add-specification",
"db-add-build", "db-update-build-status!", "db-get-builds",
"db-get-pending-derivations"): Remove the DB arguments.
("db-init"): Set the %DB-CHANNEL parameter to the channel returned by
MAKE-CRITICAL-SECTION, and return #t.
("database"): Set %DB-CHANNEL to #f during cleanup.
* tests/http.scm ("db-init"): Set the %DB-CHANNEL parameter to the channel
returned by MAKE-CRITICAL-SECTION, and return #t.
("cuirass-run", "fill-db"): Remove the DB arguments.
("http"): Set %DB-CHANNEL to #f during cleanup.
---
 bin/cuirass.in | 23 ++++++++++-------------
 1 file changed, 10 insertions(+), 13 deletions(-)

(limited to 'bin')

diff --git a/bin/cuirass.in b/bin/cuirass.in
index 11eb975..d30f788 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -115,19 +115,19 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
           (log-message "running Fibers on ~a kernel threads" threads)
           (run-fibers
            (lambda ()
-             (with-database db
+             (with-database
                (and specfile
                     (let ((new-specs (save-module-excursion
                                       (lambda ()
                                         (set-current-module (make-user-module '()))
                                         (primitive-load specfile)))))
-                      (for-each (lambda (spec) (db-add-specification db spec))
+                      (for-each (lambda (spec) (db-add-specification spec))
                                 new-specs)))
                (if one-shot?
-                   (process-specs db (db-get-specifications db))
+                   (process-specs (db-get-specifications))
                    (let ((exit-channel (make-channel)))
 
-                     (clear-build-queue db)
+                     (clear-build-queue)
 
                      ;; First off, restart builds that had not completed or
                      ;; were not even started on a previous run.
@@ -135,25 +135,22 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
                       (essential-task
                        'restart-builds exit-channel
                        (lambda ()
-                         (with-database db
-                           (restart-builds db)))))
+                         (restart-builds))))
 
                      (spawn-fiber
                       (essential-task
                        'build exit-channel
                        (lambda ()
-                         (with-database db
-                           (while #t
-                             (process-specs db (db-get-specifications db))
-                             (log-message "next evaluation in ~a seconds" interval)
-                             (sleep interval))))))
+                         (while #t
+                           (process-specs (db-get-specifications))
+                           (log-message "next evaluation in ~a seconds" interval)
+                           (sleep interval)))))
 
                      (spawn-fiber
                       (essential-task
                        'web-server exit-channel
                        (lambda ()
-                         (with-database db
-                           (run-cuirass-server db #:host host #:port port))))
+                         (run-cuirass-server #:host host #:port port)))
                       #:parallel? #t)
 
                      (spawn-fiber
-- 
cgit v1.2.3