diff options
| -rw-r--r-- | .dir-locals.el | 2 | ||||
| -rw-r--r-- | guix/store/database.scm | 75 |
2 files changed, 13 insertions, 64 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index d18e6ba760..f135eb69a5 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -133,8 +133,6 @@ (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-savepoint 'scheme-indent-function 1)) - (eval . (put 'call-with-retrying-savepoint 'scheme-indent-function 1)) (eval . (put 'call-with-container 'scheme-indent-function 1)) (eval . (put 'container-excursion 'scheme-indent-function 1)) diff --git a/guix/store/database.scm b/guix/store/database.scm index 2968f13492..3093fd816a 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -151,39 +151,11 @@ times. This may reduce contention for the database somewhat." (false-if-exception (exec "rollback;")) (apply throw args)))) -(define* (call-with-savepoint db proc - #:optional (savepoint-name "SomeSavepoint")) - "Call PROC after creating a savepoint named SAVEPOINT-NAME. If PROC exits -abnormally, rollback to that savepoint. In all cases, remove the savepoint -prior to returning." - (define (exec sql) - (with-statement db sql stmt - (sqlite-fold cons '() stmt))) - - (dynamic-wind - (lambda () - (exec (string-append "SAVEPOINT " savepoint-name ";"))) - (lambda () - (catch #t - proc - (lambda args - (exec (string-append "ROLLBACK TO " savepoint-name ";")) - (apply throw args)))) - (lambda () - (exec (string-append "RELEASE " savepoint-name ";"))))) - (define* (call-with-retrying-transaction db proc #:key restartable?) (call-with-SQLITE_BUSY-retrying (lambda () (call-with-transaction db proc #:restartable? restartable?)))) -(define* (call-with-retrying-savepoint db proc - #:optional (savepoint-name - "SomeSavepoint")) - (call-with-SQLITE_BUSY-retrying - (lambda () - (call-with-savepoint db proc savepoint-name)))) - (define %default-database-file ;; Default location of the store database. (string-append %store-database-directory "/db.sqlite")) @@ -261,40 +233,19 @@ of course. Returns the row id of the row that was modified or inserted." (assert-integer "update-or-insert" positive? #:nar-size nar-size) (assert-integer "update-or-insert" (cut >= <> 0) #:time time) - ;; It's important that querying the path-id and the insert/update operation - ;; take place in the same transaction, as otherwise some other - ;; process/thread/fiber could register the same path between when we check - ;; whether it's already registered and when we register it, resulting in - ;; duplicate paths (which, due to a 'unique' constraint, would cause an - ;; exception to be thrown). With the default journaling mode this will - ;; prevent writes from occurring during that sensitive time, but with WAL - ;; mode it will instead arrange to return SQLITE_BUSY when a write occurs - ;; between the start of a read transaction and its upgrading to a write - ;; transaction (see https://sqlite.org/rescode.html#busy_snapshot). - ;; Experimentally, it seems this SQLITE_BUSY will ignore a busy_timeout and - ;; immediately return (makes sense, since waiting won't change anything). - - ;; Note that when that kind of SQLITE_BUSY error is returned, it will keep - ;; being returned every time we try to upgrade the same outermost - ;; transaction to a write transaction. So when retrying, we have to restart - ;; the *outermost* write transaction. We can't inherently tell whether - ;; we're the outermost write transaction, so we leave the retry-handling to - ;; the caller. - (call-with-savepoint db - (lambda () - (let ((id (path-id db path))) - (if id - (with-statement db update-sql stmt - (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-bind-arguments stmt - #:path path #:deriver deriver - #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt))) - (last-insert-row-id db))))) + (let ((id (path-id db path))) + (if id + (with-statement db update-sql stmt + (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-bind-arguments stmt + #:path path #:deriver deriver + #:hash hash #:size nar-size #:time time) + (sqlite-fold cons '() stmt))) + (last-insert-row-id db))) (define add-reference-sql "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") |