From mboxrd@z Thu Jan 1 00:00:00 1970 From: Christopher Baines Subject: [PATCH 1/4] utils: Change critical section terminology to worker threads. Date: Fri, 24 Jan 2020 19:44:03 +0000 Message-ID: <20200124194406.29638-1-mail@cbaines.net> Mime-Version: 1.0 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:470:142:3::10]:34501) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iv4sH-0001C3-9W for guix-devel@gnu.org; Fri, 24 Jan 2020 14:44:17 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iv4sE-0003iG-BL for guix-devel@gnu.org; Fri, 24 Jan 2020 14:44:13 -0500 Received: from mira.cbaines.net ([212.71.252.8]:57058) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iv4sE-0003fF-13 for guix-devel@gnu.org; Fri, 24 Jan 2020 14:44:10 -0500 Received: from localhost (unknown [46.237.162.0]) by mira.cbaines.net (Postfix) with ESMTPSA id 889F517B3E for ; Fri, 24 Jan 2020 19:44:08 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 8b5fd663 for ; Fri, 24 Jan 2020 19:44:06 +0000 (UTC) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane-mx.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org As far as I'm aware, it's necessary to use a separate thread for interact= ing with SQLite as one of the threads used for fibers will be blocked while t= he SQLite query is running. This doesn't mean all queries have to be executed one at a time though, providing the queries are executed outside the threads used by fibers, an= d a single connection isn't used in multiple threads. These changes start to move in this direction, first by just changing the terminology. * src/cuirass/base.scm (clear-build-queue, cancel-old-builds): Change with-db-critical-section to with-db-worker-thread. * src/cuirass/database.scm (with-db-critical-section): Rename syntax rule= to with-db-worker-thread. (db-add-input, db-add-checkout, db-add-specification, db-remove-specifica= tion, db-get-inputs, db-get-specification, db-add-evaluation, db-set-evaluations-done, db-set-evaluation-done, db-add-derivation-output= , db-add-build, db-update-build-status!, db-get-output, db-get-outputs, db-get-builds-by-search, db-get-builds, db-get-build derivation-or-id, db-add-event, db-get-events, db-delete-events-with-ids-<=3D-to, db-get-pending-derivations, db-get-checkouts, db-get-evaluations, db-get-evaluations-build-summary, db-get-evaluations-id-max, db-get-evaluation-summary, db-get-builds-query-min, db-get-builds-query-m= ax, db-get-builds-min, db-get-builds-max, db-get-evaluation-specification): C= hange from using with-db-critical-section to with-db-worker-thread. (with-database): Change syntax rule to use make-worker-thread-channel, renaming from make-critical-section. * src/cuirass/utils.scm (%critical-section-args): Rename parameter to %worker-thread-args. (make-critical-section): Rename to make-worker-thread-channel, and adjust parameter and docstring. (call-with-critical-section): Rename to call-with-worker-thread and adjus= t parameter. (with-critical-section): Rename to with-worker-thread, and adjust to call call-with-worker-thread. * tests/database.scm (db-init): Use make-worker-thread-channel rather tha= n make-critical-section. * tests/http.scm (db-init): Use make-worker-thread-channel rather than make-critical-section. --- src/cuirass/base.scm | 4 +-- src/cuirass/database.scm | 74 ++++++++++++++++++++-------------------- src/cuirass/utils.scm | 38 +++++++++------------ tests/database.scm | 2 +- tests/http.scm | 2 +- 5 files changed, 58 insertions(+), 62 deletions(-) diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 143bc2e..2b18dc6 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -607,13 +607,13 @@ updating the database accordingly." "Reset the status of builds in the database that are marked as \"start= ed\". This procedure is meant to be called at startup." (log-message "marking stale builds as \"scheduled\"...") - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "UPDATE Builds SET status =3D -2 WHERE status =3D -1= ;"))) =20 (define (cancel-old-builds age) "Cancel builds older than AGE seconds." (log-message "canceling builds older than ~a seconds..." age) - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "UPDATE Builds SET status =3D 4 WHERE status =3D -2 AND timestam= p < " (- (time-second (current-time time-utc)) age) ";"))) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 308b5c3..3e93492 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -73,7 +73,7 @@ %db-channel %record-events? ;; Macros. - with-db-critical-section + with-db-worker-thread with-database)) =20 (define (%sqlite-exec db sql . args) @@ -172,12 +172,12 @@ specified." (define %record-events? (make-parameter #f)) =20 -(define-syntax-rule (with-db-critical-section db exp ...) +(define-syntax-rule (with-db-worker-thread db exp ...) "Evaluate EXP... in the critical section corresponding to %DB-CHANNEL. DB is bound to the argument of that critical section: the database connection." - (call-with-critical-section (%db-channel) - (lambda (db) exp ...))) + (call-with-worker-thread (%db-channel) + (lambda (db) exp ...))) =20 (define (read-sql-file file-name) "Return a list of string containing SQL instructions from FILE-NAME." @@ -292,7 +292,7 @@ of the list, and returns #f when there is no result." (() #f))) =20 (define (db-add-input spec-name input) - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "\ INSERT OR IGNORE INTO Inputs (specification, name, url, load_path, branc= h, \ tag, revision, no_compile_p) VALUES (" @@ -309,7 +309,7 @@ tag, revision, no_compile_p) VALUES (" (define (db-add-checkout spec-name eval-id checkout) "Insert CHECKOUT associated with SPEC-NAME and EVAL-ID. If a checkout= with the same revision already exists for SPEC-NAME, return #f." - (with-db-critical-section db + (with-db-worker-thread db (catch-sqlite-error (sqlite-exec db "\ INSERT INTO Checkouts (specification, revision, evaluation, input, @@ -329,7 +329,7 @@ directory) VALUES (" (define (db-add-specification spec) "Store SPEC in database the database. SPEC inputs are stored in the I= NPUTS table." - (with-db-critical-section db + (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) \ @@ -349,7 +349,7 @@ package_path_inputs, proc_input, proc_file, proc, pro= c_args) \ =20 (define (db-remove-specification name) "Remove the specification matching NAME from the database and its inpu= ts." - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "BEGIN TRANSACTION;") (sqlite-exec db "\ DELETE FROM Inputs WHERE specification=3D" name ";") @@ -358,7 +358,7 @@ DELETE FROM Specifications WHERE name=3D" name ";") (sqlite-exec db "COMMIT;"))) =20 (define (db-get-inputs spec-name) - (with-db-critical-section db + (with-db-worker-thread db (let loop ((rows (sqlite-exec db "SELECT * FROM Inputs WHERE specification=3D" spec-name ";")) @@ -378,7 +378,7 @@ DELETE FROM Specifications WHERE name=3D" name ";") inputs))))))) =20 (define (db-get-specifications) - (with-db-critical-section db + (with-db-worker-thread db (let loop ((rows (sqlite-exec db "SELECT * FROM Specifications ORDE= R BY name DESC;")) (specs '())) (match rows @@ -402,7 +402,7 @@ DELETE FROM Specifications WHERE name=3D" name ";") (define (db-add-evaluation spec-name checkouts) "Add a new evaluation for SPEC-NAME only if one of the CHECKOUTS is ne= w. Otherwise, return #f." - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "BEGIN TRANSACTION;") (sqlite-exec db "INSERT INTO Evaluations (specification, in_progress= ) VALUES (" spec-name ", true);") @@ -422,11 +422,11 @@ VALUES (" spec-name ", true);") eval-id))))) =20 (define (db-set-evaluations-done) - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "UPDATE Evaluations SET in_progress =3D false;"))) =20 (define (db-set-evaluation-done eval-id) - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "UPDATE Evaluations SET in_progress =3D false WHERE id =3D " eval-id ";") (db-add-event 'evaluation @@ -450,7 +450,7 @@ a critical section that allows database operations to= be serialized." ;; access blocks on PUT-MESSAGE, which allows the scheduler to sche= dule ;; another fiber. Also, creating one new handle for each request w= ould ;; be costly and may defeat statement caching. - (parameterize ((%db-channel (make-critical-section db))) + (parameterize ((%db-channel (make-worker-thread-channel db))) body ...) (db-close db)))) =20 @@ -485,7 +485,7 @@ string." (define (db-add-output derivation output) "Insert OUTPUT associated with DERIVATION. If an output with the same= path already exists, return #f." - (with-db-critical-section db + (with-db-worker-thread db (catch-sqlite-error (match output ((name . path) @@ -502,7 +502,7 @@ INSERT INTO Outputs (derivation, name, path) VALUES (= " (define (db-add-build build) "Store BUILD in database the database only if one of its outputs is ne= w. Return #f otherwise. BUILD outputs are stored in the OUTPUTS table." - (with-db-critical-section db + (with-db-worker-thread db (catch-sqlite-error (sqlite-exec db "BEGIN TRANSACTION;") (sqlite-exec db " @@ -559,7 +559,7 @@ log file for DRV." (,(build-status failed-other) . "failed (other)") (,(build-status canceled) . "canceled"))) =20 - (with-db-critical-section db + (with-db-worker-thread db (if (=3D status (build-status started)) (begin (sqlite-exec db "UPDATE Builds SET starttime=3D" now ", status= =3D" @@ -591,7 +591,7 @@ log file for DRV." =20 (define (db-get-output path) "Retrieve the OUTPUT for PATH." - (with-db-critical-section db + (with-db-worker-thread db ;; There isn't a unique index on path, but because Cuirass avoids ad= ding ;; derivations which introduce the same outputs, there should only b= e one ;; result. @@ -606,7 +606,7 @@ LIMIT 1;") (define (db-get-outputs derivation) "Retrieve the OUTPUTS of the build identified by DERIVATION in the database." - (with-db-critical-section db + (with-db-worker-thread db (let loop ((rows (sqlite-exec db "SELECT name, path FROM Outputs WHERE derivation =3D" derivation ";")) @@ -669,7 +669,7 @@ WHERE derivation =3D" derivation ";")) "Retrieve all builds in the database which are matched by given FILTER= S. FILTERS is an assoc list whose possible keys are the symbols query, border-low-id, border-high-id, and nr." - (with-db-critical-section db + (with-db-worker-thread db (let* ((stmt-text (format #f "SELECT * FROM ( SELECT Builds.rowid, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.job_name, Builds.syst= em, @@ -726,7 +726,7 @@ ORDER BY rowid DESC;")) "Retrieve all builds in the database which are matched by given FILTER= S. FILTERS is an assoc list whose possible keys are 'derivation | 'id | 'jo= bset | 'job | 'system | 'nr | 'order | 'status | 'evaluation." - (with-db-critical-section db + (with-db-worker-thread db (let* ((order (filters->order filters)) (stmt-text (format #f "SELECT * FROM ( SELECT Builds.derivation, Builds.rowid, Builds.timestamp, Builds.startti= me, @@ -801,13 +801,13 @@ ORDER BY ~a, rowid ASC;" order)) =20 (define (db-get-build derivation-or-id) "Retrieve a build in the database which corresponds to DERIVATION-OR-I= D." - (with-db-critical-section db + (with-db-worker-thread db (let ((key (if (number? derivation-or-id) 'id 'derivation))) (expect-one-row (db-get-builds `((,key . ,derivation-or-id))))))) =20 (define (db-add-event type timestamp details) (when (%record-events?) - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "\ INSERT INTO Events (type, timestamp, event_json) VALUES (" (symbol->string type) ", " @@ -817,7 +817,7 @@ INSERT INTO Events (type, timestamp, event_json) VALU= ES (" #t))) =20 (define (db-get-events filters) - (with-db-critical-section db + (with-db-worker-thread db (let* ((stmt-text "\ SELECT Events.id, Events.type, @@ -857,7 +857,7 @@ LIMIT :nr;") events)))))))) =20 (define (db-delete-events-with-ids-<=3D-to id) - (with-db-critical-section db + (with-db-worker-thread db (sqlite-exec db "DELETE FROM Events WHERE id <=3D " id ";"))) @@ -865,13 +865,13 @@ LIMIT :nr;") (define (db-get-pending-derivations) "Return the list of derivation file names corresponding to pending bui= lds in the database. The returned list is guaranteed to not have any duplicate= s." - (with-db-critical-section db + (with-db-worker-thread db (map (match-lambda (#(drv) drv)) (sqlite-exec db " SELECT derivation FROM Builds WHERE Builds.status < 0;")))) =20 (define (db-get-checkouts eval-id) - (with-db-critical-section db + (with-db-worker-thread db (let loop ((rows (sqlite-exec db "SELECT revision, input, directory FROM Checkou= ts WHERE evaluation =3D" eval-id ";")) @@ -887,7 +887,7 @@ WHERE evaluation =3D" eval-id ";")) checkouts))))))) =20 (define (db-get-evaluations limit) - (with-db-critical-section db + (with-db-worker-thread db (let loop ((rows (sqlite-exec db "SELECT id, specification, in_prog= ress FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) (evaluations '())) @@ -903,7 +903,7 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) evaluations))))))) =20 (define (db-get-evaluations-build-summary spec limit border-low border-h= igh) - (with-db-critical-section db + (with-db-worker-thread db (let loop ((rows (sqlite-exec db " SELECT E.id, E.in_progress, B.succeeded, B.failed, B.scheduled FROM @@ -936,7 +936,7 @@ ORDER BY E.id ASC;")) =20 (define (db-get-evaluations-id-min spec) "Return the min id of evaluations for the given specification SPEC." - (with-db-critical-section db + (with-db-worker-thread db (let ((rows (sqlite-exec db " SELECT MIN(id) FROM Evaluations WHERE specification=3D" spec))) @@ -944,14 +944,14 @@ WHERE specification=3D" spec))) =20 (define (db-get-evaluations-id-max spec) "Return the max id of evaluations for the given specification SPEC." - (with-db-critical-section db + (with-db-worker-thread db (let ((rows (sqlite-exec db " SELECT MAX(id) FROM Evaluations WHERE specification=3D" spec))) (and=3D> (expect-one-row rows) (cut vector-ref <> 0))))) =20 (define (db-get-evaluation-summary id) - (with-db-critical-section db + (with-db-worker-thread db (let ((rows (sqlite-exec db " SELECT E.id, E.in_progress, B.total, B.succeeded, B.failed, B.scheduled FROM @@ -977,7 +977,7 @@ ORDER BY E.id ASC;"))) =20 (define (db-get-builds-query-min query) "Return the smallest build row identifier matching QUERY." - (with-db-critical-section db + (with-db-worker-thread db (let* ((stmt-text "SELECT MIN(Builds.rowid) FROM Builds INNER JOIN Evaluations ON Builds.evaluation =3D Evaluations.id INNER JOIN Specifications ON Evaluations.specification =3D Specification= s.name @@ -996,7 +996,7 @@ AND (:system IS NULL =20 (define (db-get-builds-query-max query) "Return the largest build row identifier matching QUERY." - (with-db-critical-section db + (with-db-worker-thread db (let* ((stmt-text "SELECT MAX(Builds.rowid) FROM Builds INNER JOIN Evaluations ON Builds.evaluation =3D Evaluations.id INNER JOIN Specifications ON Evaluations.specification =3D Specification= s.name @@ -1016,7 +1016,7 @@ AND (:system IS NULL (define (db-get-builds-min eval status) "Return the min build (stoptime, rowid) pair for the given evaluation = EVAL and STATUS." - (with-db-critical-section db + (with-db-worker-thread db (let ((rows (sqlite-exec db " SELECT stoptime, MIN(rowid) FROM (SELECT rowid, stoptime FROM Builds @@ -1035,7 +1035,7 @@ AND (" status " IS NULL OR (" status " =3D 'pending= ' (define (db-get-builds-max eval status) "Return the max build (stoptime, rowid) pair for the given evaluation = EVAL and STATUS." - (with-db-critical-section db + (with-db-worker-thread db (let ((rows (sqlite-exec db " SELECT stoptime, MAX(rowid) FROM (SELECT rowid, stoptime FROM Builds @@ -1053,7 +1053,7 @@ AND (" status " IS NULL OR (" status " =3D 'pending= ' =20 (define (db-get-evaluation-specification eval) "Return specification of evaluation with id EVAL." - (with-db-critical-section db + (with-db-worker-thread db (let ((rows (sqlite-exec db " SELECT specification FROM Evaluations WHERE id =3D " eval))) diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index fe74b69..514899e 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -35,9 +35,9 @@ define-enumeration unwind-protect =20 - make-critical-section - call-with-critical-section - with-critical-section + make-worker-thread-channel + call-with-worker-thread + with-worker-thread =20 %non-blocking non-blocking @@ -96,21 +96,17 @@ delimited continuations and fibers." (conclusion) (apply throw args))))) =20 -(define %critical-section-args +(define %worker-thread-args (make-parameter #f)) =20 -(define (make-critical-section . args) - "Return a channel used to implement a critical section. That channel = can -then be passed to 'join-critical-section', which will ensure sequential -ordering. ARGS are the arguments of the critical section. - -Critical sections are implemented by passing the procedure to execute to= a -dedicated thread." +(define (make-worker-thread-channel . args) + "Return a channel used to offload work to a dedicated thread. ARGS ar= e the +arguments of the worker thread procedure." (parameterize (((@@ (fibers internal) current-fiber) #f)) (let ((channel (make-channel))) (call-with-new-thread (lambda () - (parameterize ((%critical-section-args args)) + (parameterize ((%worker-thread-args args)) (let loop () (match (get-message channel) (((? channel? reply) . (? procedure? proc)) @@ -118,21 +114,21 @@ dedicated thread." (loop))))) channel))) =20 -(define (call-with-critical-section channel proc) - "Send PROC to the critical section through CHANNEL. Return the result= of -PROC. If already in the critical section, call PROC immediately." - (let ((args (%critical-section-args))) +(define (call-with-worker-thread channel proc) + "Send PROC to the worker thread through CHANNEL. Return the result of= PROC. +If already in the worker thread, call PROC immediately." + (let ((args (%worker-thread-args))) (if args (apply proc args) (let ((reply (make-channel))) (put-message channel (cons reply proc)) (get-message reply))))) =20 -(define-syntax-rule (with-critical-section channel (vars ...) exp ...) - "Evaluate EXP... in the critical section corresponding to CHANNEL. -VARS... are bound to the arguments of the critical section." - (call-with-critical-section channel - (lambda (vars ...) exp ...))) +(define-syntax-rule (with-worker-thread channel (vars ...) exp ...) + "Evaluate EXP... in the worker thread corresponding to CHANNEL. +VARS... are bound to the arguments of the worker thread." + (call-with-worker-thread channel + (lambda (vars ...) exp ...))) =20 (define (%non-blocking thunk) (parameterize (((@@ (fibers internal) current-fiber) #f)) diff --git a/tests/database.scm b/tests/database.scm index d9dfe13..271f166 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -87,7 +87,7 @@ (test-assert "db-init" (begin (%db (db-init database-name)) - (%db-channel (make-critical-section (%db))) + (%db-channel (make-worker-thread-channel (%db))) #t)) =20 (test-assert "sqlite-exec" diff --git a/tests/http.scm b/tests/http.scm index b21fa17..337a775 100644 --- a/tests/http.scm +++ b/tests/http.scm @@ -108,7 +108,7 @@ (test-assert "db-init" (begin (%db (db-init database-name)) - (%db-channel (make-critical-section (%db))) + (%db-channel (make-worker-thread-channel (%db))) #t)) =20 (test-assert "cuirass-run" --=20 2.24.1