From patchwork Tue Feb 20 19:39:02 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Christopher Baines X-Patchwork-Id: 60809 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 1AA7527BBE2; Tue, 20 Feb 2024 19:40:19 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id D9A1D27BBE9 for ; Tue, 20 Feb 2024 19:40:17 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rcVy3-0002NF-96; Tue, 20 Feb 2024 14:39:51 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rcVxw-0002Lj-HU for guix-patches@gnu.org; Tue, 20 Feb 2024 14:39:44 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rcVxw-0000Pj-0L; Tue, 20 Feb 2024 14:39:44 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rcVyG-0002SY-As; Tue, 20 Feb 2024 14:40:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#69292] [PATCH 2/6] store: database: Remove with-statement and associated code. Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Tue, 20 Feb 2024 19:40:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69292 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 69292@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 69292-submit@debbugs.gnu.org id=B69292.17084580039435 (code B ref 69292); Tue, 20 Feb 2024 19:40:04 +0000 Received: (at 69292) by debbugs.gnu.org; 20 Feb 2024 19:40:03 +0000 Received: from localhost ([127.0.0.1]:46615 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rcVyD-0002Ru-Pg for submit@debbugs.gnu.org; Tue, 20 Feb 2024 14:40:02 -0500 Received: from mira.cbaines.net ([212.71.252.8]:43148) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rcVyC-0002RS-5C for 69292@debbugs.gnu.org; Tue, 20 Feb 2024 14:40:00 -0500 Received: from localhost (unknown [212.132.255.10]) by mira.cbaines.net (Postfix) with ESMTPSA id AF90427BBE9 for <69292@debbugs.gnu.org>; Tue, 20 Feb 2024 19:39:07 +0000 (GMT) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id e23dd3da for <69292@debbugs.gnu.org>; Tue, 20 Feb 2024 19:39:07 +0000 (UTC) From: Christopher Baines Date: Tue, 20 Feb 2024 19:39:02 +0000 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: <4b6a268daab5e0b307dff2229d551a47c9fe1ebc.1708457946.git.mail@cbaines.net> References: <4b6a268daab5e0b307dff2229d551a47c9fe1ebc.1708457946.git.mail@cbaines.net> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches I think using dynamic-wind to finalize all statements is the wrong approach. Firstly it would be good to allow reseting statements rather than finalizing them. Then for the problem of handling errors, the approach I've settled on in the build coordinator is to close the database connection, since that'll trigger guile-sqlite3 to finalize all the cached statements. This reverts commit 5d6e2255286e591def122ec2f4a3cbda497fea21. * .dir-locals.el (scheme-mode): Remove with-statement. * guix/store/database.scm (call-with-statement): Remove procedure. (with-statement): Remove syntax rule. (call-with-transaction, last-insert-row-id, path-id, update-or-insert, add-references): Don't use with-statement. Change-Id: I2fd976b3f12ec8105cc56350933a953cf53647e8 --- .dir-locals.el | 1 - guix/store/database.scm | 62 ++++++++++++++++++----------------------- 2 files changed, 27 insertions(+), 36 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index f135eb69a5..2d1a03c313 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -131,7 +131,6 @@ (eval . (put 'with-database 'scheme-indent-function 2)) (eval . (put 'call-with-database 'scheme-indent-function 1)) (eval . (put 'call-with-transaction 'scheme-indent-function 1)) - (eval . (put 'with-statement 'scheme-indent-function 3)) (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1)) (eval . (put 'call-with-container 'scheme-indent-function 1)) diff --git a/guix/store/database.scm b/guix/store/database.scm index 3093fd816a..de72b79860 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -130,25 +130,22 @@ (define* (call-with-transaction db proc #:key restartable?) the transaction, otherwise commit the transaction after it finishes. RESTARTABLE? may be set to a non-#f value when it is safe to run PROC multiple times. This may reduce contention for the database somewhat." - (define (exec sql) - (with-statement db sql stmt - (sqlite-fold cons '() stmt))) ;; We might use begin immediate here so that if we need to retry, we figure ;; that out immediately rather than because some SQLITE_BUSY exception gets ;; thrown partway through PROC - in which case the part already executed ;; (which may contain side-effects!) might have to be executed again for ;; every retry. - (exec (if restartable? "begin;" "begin immediate;")) + (sqlite-exec db (if restartable? "begin;" "begin immediate;")) (catch #t (lambda () (let-values ((result (proc))) - (exec "commit;") + (sqlite-exec db "commit;") (apply values result))) (lambda args ;; The roll back may or may not have occurred automatically when the ;; error was generated. If it has occurred, this does nothing but signal ;; an error. If it hasn't occurred, this needs to be done. - (false-if-exception (exec "rollback;")) + (false-if-exception (sqlite-exec db "rollback;")) (apply throw args)))) (define* (call-with-retrying-transaction db proc #:key restartable?) @@ -170,26 +167,14 @@ (define-syntax with-database ((_ file db exp ...) (call-with-database file (lambda (db) exp ...))))) -(define (call-with-statement db sql proc) - (let ((stmt (sqlite-prepare db sql #:cache? #t))) - (dynamic-wind - (const #t) - (lambda () - (proc stmt)) - (lambda () - (sqlite-finalize stmt))))) - -(define-syntax-rule (with-statement db sql stmt exp ...) - "Run EXP... with STMT bound to a prepared statement corresponding to the sql -string SQL for DB." - (call-with-statement db sql - (lambda (stmt) exp ...))) - (define (last-insert-row-id db) ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. ;; Work around that. - (with-statement db "SELECT last_insert_rowid();" stmt - (match (sqlite-fold cons '() stmt) + (let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();" + #:cache? #t)) + (result (sqlite-fold cons '() stmt))) + (sqlite-finalize stmt) + (match result ((#(id)) id) (_ #f)))) @@ -199,11 +184,13 @@ (define path-id-sql (define* (path-id db path) "If PATH exists in the 'ValidPaths' table, return its numerical identifier. Otherwise, return #f." - (with-statement db path-id-sql stmt + (let ((stmt (sqlite-prepare db path-id-sql #:cache? #t))) (sqlite-bind-arguments stmt #:path path) - (match (sqlite-fold cons '() stmt) - ((#(id) . _) id) - (_ #f)))) + (let ((result (sqlite-fold cons '() stmt))) + (sqlite-finalize stmt) + (match result + ((#(id) . _) id) + (_ #f))))) (define update-sql "UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver = @@ -235,17 +222,20 @@ (define* (update-or-insert db #:key path deriver hash nar-size time) (let ((id (path-id db path))) (if id - (with-statement db update-sql stmt + (let ((stmt (sqlite-prepare db update-sql #:cache? #t))) (sqlite-bind-arguments stmt #:id id #:deriver deriver #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt)) - (with-statement db insert-sql stmt + (sqlite-fold cons '() stmt) + (sqlite-finalize stmt) + (last-insert-row-id db)) + (let ((stmt (sqlite-prepare db insert-sql #:cache? #t))) (sqlite-bind-arguments stmt #:path path #:deriver deriver #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt))) - (last-insert-row-id db))) + (sqlite-fold cons '() stmt) ;execute it + (sqlite-finalize stmt) + (last-insert-row-id db))))) (define add-reference-sql "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") @@ -253,13 +243,15 @@ (define add-reference-sql (define (add-references db referrer references) "REFERRER is the id of the referring store item, REFERENCES is a list ids of items referred to." - (with-statement db add-reference-sql stmt + (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t))) (for-each (lambda (reference) (sqlite-reset stmt) (sqlite-bind-arguments stmt #:referrer referrer #:reference reference) - (sqlite-fold cons '() stmt)) - references))) + (sqlite-fold cons '() stmt) ;execute it + (last-insert-row-id db)) + references) + (sqlite-finalize stmt))) (define (timestamp) "Return a timestamp, either the current time of SOURCE_DATE_EPOCH."