Commitfab3cb5cRecorded2 Sep 2026Repositorysigil-sqlite

Serialise a connection across the whole primitive; finalize on every path

Message

A SQLite connection is a SERIAL resource and this library treated it as a shared one. SQLite ends a connection's implicit read transaction only when NO statement on it is active, so if fiber A has a statement open and fiber B runs a query on the SAME connection, B's read transaction cannot be released when B finalizes -- A is still using the btree. The connection is pinned to B's snapshot until A completes, and every later read on it silently misses anything committed in between.

Measured against kiln, whose controller shares one connection between its HTTP app and its run loop: /api/groups answered HTTP 200 with a pre-commit view of its own database -- 55 rows where an independent connection to the same file saw 755 -- and stayed that way until the process restarted.

Three defects, three changes.

  1. THE CONNECTION IS NOW HELD ACROSS THE WHOLE PRIMITIVE. sqlite-query, sqlite-query-row, sqlite-run and sqlite-exec take a per-connection lock for their whole duration, yields included.
   Guarding only the busy window would not have been enough, and that is a
   measurement rather than a judgement: a fiber yields inside an UNCONTENDED
   query too, allocation-driven, roughly once per 450 rows. A witness fiber
   counts ~44 yields across a 20000-row query with no contention anywhere.
   Scope is deliberately the PRIMITIVE. Held any coarser it would deadlock the
   moment a consumer's database helper called another one. At primitive scope
   reentrancy is impossible by construction: no user code runs between prepare
   and finalize -- the call set there is natives plus pure list operations, with
   no callback.
  1. STATEMENTS ARE FINALIZED ON EVERY EXIT PATH. sqlite-query finalized only on its else branch and sqlite-run only after a successful step, so a raise from sqlite-step -- the ordinary outcome when the busy budget is exhausted -- leaked the statement. A leaked statement holds the read transaction open for the life of the process, which is what turned a transient stale read into a permanent one. dynamic-wind's after thunk runs when the body raises, verified on this runtime rather than assumed.
  1. PRAGMA busy_timeout=N IS HONOURED INSTEAD OF SWALLOWED. It cannot be passed to SQLite: a blocking step freezes the whole cooperative scheduler, measured at 0 witness ticks in two seconds against 4701 for the retrying path. It was accepted and silently ignored -- dead configuration that read as live. It now sets the cooperative retry budget, which is the same intent expressed where this library can act on it. sqlite-busy-budget and sqlite-set-busy-budget! are the explicit form.

BEHAVIOUR CHANGE, stated plainly: concurrent database calls on ONE connection now serialise, and a fiber waiting on a connection whose holder is parked on a contended write waits for that whole busy budget. Callers wanting concurrent database work want separate connections. A wait longer than three times the busy budget raises rather than hanging, so two fibers deadlocking over two connections is a loud error rather than a silent stop.

NOT COVERED, and documented as such: the low-level prepare/step/finalize API cannot be serialised, because the library cannot know when the caller's statement is done; and BEGIN..COMMIT spans several primitives, so another fiber's query can still interleave inside a transaction. Give a transaction its own connection. docs/concurrency.md carries both.

test/test-sqlite-connection-pin.sgl is the regression test: four arms, the first two differing by exactly one read, which is the variable that decides the bug.

Adds sigil-test / sigil-test-runner as dev-dependencies. README has always claimed sigil test --report works and it could not: sigil test refuses to build a native package without them.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01NuSfnnNgQ81hjRygkkqWM6

Changed
 docs/concurrency.md                 |  81 +++++++++++++++++++++++++++++++++++++++++++++
 native/sqlite.c                     |  71 ++++++++++++++++++++++++++++++++++++++++
 package.sgl                         |  10 +++++-
 sigil.lock                          |  40 ++++++++++++++++++++---
 src/sigil/sqlite.sgl                | 281 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------
 test/test-sqlite-connection-pin.sgl | 227 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 656 insertions(+), 54 deletions(-)
Diff
docs/concurrency.mdadded
@@ -0,0 +1,81 @@
+1
# Concurrency: one connection is one serial resource
+2
+3
`sigil-sqlite` runs on a single-threaded cooperative scheduler. That makes two
+4
things true at once, and the interaction between them is the whole of this page.
+5
+6
1. A contended `sqlite3_step` must never block, or it freezes every fiber —
+7
including the one holding the lock, which can then never run to commit. So
+8
the native layer forces SQLite's own `busy_timeout` to 0 and the Scheme layer
+9
retries cooperatively, yielding between attempts.
+10
2. **A SQLite connection is a serial resource.** SQLite ends a connection's
+11
implicit read transaction only when *no statement on it is active*.
+12
+13
Put those together and a shared connection has a sharp edge. If fiber A has a
+14
statement open — parked in the busy-retry, or simply part-way through a result
+15
set — and fiber B runs a query on the *same* connection, B's read transaction
+16
cannot be released when B finalizes: A is still using the btree. The connection
+17
is pinned to B's snapshot until A completes, and every later read on it silently
+18
misses anything committed in between.
+19
+20
## What the library does about it
+21
+22
Every high-level primitive — `sqlite-query`, `sqlite-query-row`, `sqlite-run`,
+23
`sqlite-exec` — holds the connection exclusively for its whole duration, yields
+24
included. Concurrent calls on one connection serialise.
+25
+26
**The lock spans the whole primitive, not just the busy window.** A fiber yields
+27
inside an *uncontended* query too: allocation-driven, roughly once per 450 rows.
+28
A 20000-row query yields about 44 times with no contention anywhere. Guarding
+29
only the retry would leave every one of those windows open.
+30
+31
Statements are finalized on **every** exit path, including a raise. A statement
+32
leaked by a raise holds the connection's read transaction open for the life of
+33
the process, which turns a transient stale read into a permanent one.
+34
+35
## What this costs you
+36
+37
Concurrent database work on one connection now **queues**. A fiber waiting for a
+38
connection whose holder is parked on a contended write waits for that whole busy
+39
budget — by default 5 seconds. If you want database calls to proceed
+40
concurrently, **give each fiber its own connection**. That is what connections
+41
are for, and WAL readers are cheap.
+42
+43
A fiber that waits more than `*sqlite-connection-wait-seconds*` (15s, three times
+44
the busy budget) for a connection **raises** rather than waiting forever. Two
+45
fibers each holding a connection the other wants is a deadlock; a bounded wait
+46
turns it into a loud, attributable error instead of a process that stops with no
+47
output.
+48
+49
## What is NOT covered
+50
+51
**The low-level API.** `sqlite-prepare` / `sqlite-step` / `sqlite-finalize` are
+52
not serialised and cannot be: the library does not know when your statement is
+53
finished. If you hold a statement across steps on a connection another fiber
+54
also uses, you own the hazard described at the top of this page. Use the
+55
high-level API, or give that work its own connection.
+56
+57
**Multi-statement transactions.** `BEGIN` … `COMMIT` spans several primitives,
+58
and the lock is released between them, so another fiber's query can interleave
+59
inside your transaction. There is deliberately no exported "hold this connection
+60
across several calls" primitive, because holding the lock across caller code
+61
deadlocks the moment one of your database helpers calls another. **Give a
+62
transaction its own connection.**
+63
+64
## busy_timeout
+65
+66
`PRAGMA busy_timeout=N` cannot be passed to SQLite — a blocking step would
+67
freeze the scheduler, which is the thing point 1 above exists to prevent. It
+68
used to be accepted and silently ignored: dead configuration that read as live.
+69
It now sets the cooperative retry budget instead, which is the same intent
+70
expressed where this library can act on it.
+71
+72
The budget is **process-wide**, not per-connection: `sqlite-step` receives a
+73
statement and has no connection to look a per-connection value up on. Prefer
+74
`sqlite-set-busy-budget!`, which says so in its name; read it back with
+75
`sqlite-busy-budget`.
+76
+77
## Diagnostics
+78
+79
`sqlite-connection-locked?` answers whether a fiber currently holds a
+80
connection. It is a diagnostic, not a synchronisation primitive: by the time you
+81
act on the answer it may have changed.
native/sqlite.cmodified
@@ -17,6 +17,14 @@
17
typedef struct {
18
sqlite3 *db;
19
int closed;
+20
/* Cooperative connection lock. A SQLite connection is a SERIAL resource:
+21
* its implicit read transaction ends only when no statement is active, so
+22
* two fibers interleaving on one connection can pin a snapshot. The
+23
* scheme layer holds this across a whole primitive, yields included.
+24
* Single-threaded cooperative runtime, so a plain int is atomic enough:
+25
* only a yield can interleave, and this is never held across one without
+26
* the holder intending it. */
+27
int locked;
28
} SqliteDB;
29
30
/*
@@ -137,6 +145,7 @@ static Value native_sqlite_open(SigilVM *vm, int argc, Value *args)
145
146
handle->db = db;
147
handle->closed = 0;
+148
handle->locked = 0;
149
150
return sigil_make_foreign(vm, db_type_tag, handle, db_finalizer, sizeof(SqliteDB));
151
}
@@ -597,6 +606,60 @@ static Value native_sqlite_errmsg(SigilVM *vm, int argc, Value *args)
606
return sigil_make_string(vm, msg, strlen(msg));
607
}
608
+609
/*
+610
* %sqlite-try-acquire! db -> boolean
+611
* %sqlite-release! db -> unspecified
+612
*
+613
* A cooperative, per-connection mutual-exclusion flag. NOT a thread lock: the
+614
* runtime is single-threaded, so a plain int cannot be torn. Its whole job is
+615
* to stop two FIBERS interleaving inside one connection.
+616
*
+617
* Why a connection needs one at all: SQLite ends a connection's implicit read
+618
* transaction only when no statement on it is active. If fiber A has a
+619
* statement open (parked in the busy-retry, or simply mid-result-set) and
+620
* fiber B runs a query on the same connection, B's read transaction cannot be
+621
* released when B finalizes -- A is still using the btree. The connection is
+622
* then pinned to B's snapshot until A completes, and every later read on it
+623
* misses any commit made in between. See docs/concurrency.md.
+624
*/
+625
static Value native_sqlite_try_acquire(SigilVM *vm, int argc, Value *args)
+626
{
+627
(void)argc;
+628
if (!is_db(args[0])) {
+629
sigil__vm_error(vm, SIGIL_ERR_TYPE, "%sqlite-try-acquire!: expected database handle");
+630
return SIGIL_UNDEFINED;
+631
}
+632
SqliteDB *handle = as_db(args[0]);
+633
if (handle->locked) return SIGIL_FALSE;
+634
handle->locked = 1;
+635
return SIGIL_TRUE;
+636
}
+637
+638
static Value native_sqlite_release(SigilVM *vm, int argc, Value *args)
+639
{
+640
(void)argc;
+641
if (!is_db(args[0])) {
+642
sigil__vm_error(vm, SIGIL_ERR_TYPE, "%sqlite-release!: expected database handle");
+643
return SIGIL_UNDEFINED;
+644
}
+645
as_db(args[0])->locked = 0;
+646
return SIGIL_TRUE;
+647
}
+648
+649
/*
+650
* sqlite-connection-locked? db -> boolean
+651
* Diagnostic only: is a fiber currently holding this connection?
+652
*/
+653
static Value native_sqlite_connection_locked(SigilVM *vm, int argc, Value *args)
+654
{
+655
(void)argc;
+656
if (!is_db(args[0])) {
+657
sigil__vm_error(vm, SIGIL_ERR_TYPE, "sqlite-connection-locked?: expected database handle");
+658
return SIGIL_UNDEFINED;
+659
}
+660
return sigil_bool(as_db(args[0])->locked != 0);
+661
}
+662
663
/*
664
* Helper macro for module-scoped registration with export
665
*/
@@ -662,6 +725,14 @@ void sigil__init_sigil_sqlite_module(SigilVM *vm)
725
REGISTER_AND_EXPORT("sqlite-errmsg", native_sqlite_errmsg,
726
SIGIL_ARITY_EXACT(1), "Get last error message");
727
+728
/* Cooperative per-connection lock (see docs/concurrency.md). */
+729
REGISTER_AND_EXPORT("%sqlite-try-acquire!", native_sqlite_try_acquire,
+730
SIGIL_ARITY_EXACT(1), "Try to acquire the connection");
+731
REGISTER_AND_EXPORT("%sqlite-release!", native_sqlite_release,
+732
SIGIL_ARITY_EXACT(1), "Release the connection");
+733
REGISTER_AND_EXPORT("sqlite-connection-locked?", native_sqlite_connection_locked,
+734
SIGIL_ARITY_EXACT(1), "Is a fiber holding this connection?");
+735
736
sigil_end_module(vm);
737
}
738
package.sglmodified
@@ -5,7 +5,7 @@
5
6
(package
7
name: "sigil-sqlite"
−8
version: "0.16.2"
+8
version: "0.16.3"
9
sigil: "^0.17"
10
description: "SQLite database bindings for Sigil"
11
url: "https://codeberg.org/sigil/sigil-sqlite"
@@ -15,6 +15,14 @@
15
dependencies: (list
16
)
17
+18
;; Test harness. `sigil test` refuses to build a native package without
+19
;; these, and README.md has always claimed `sigil test --report` works.
+20
dev-dependencies: (list
+21
(from-git url: "codeberg:sigil/sigil"
+22
package: "sigil-test" version: "^0.17")
+23
(from-git url: "codeberg:sigil/sigil"
+24
package: "sigil-test-runner" version: "^0.17"))
+25
26
;; Native library definition
27
libraries: (list
28
(library
sigil.lockmodified
@@ -3,13 +3,45 @@
3
(package name: "sigil-lib"
4
url: "codeberg:sigil/sigil"
5
ref: "^0.17"
−6
sha: "8b3e7f90795b569a5ac3011c5a46311989230648"
+6
sha: "070f133a3524142b4febfd7c287385186b616252"
7
package-selector: "sigil-lib"
−8
version: "0.17.13")
+8
version: "0.17.20")
9
(package name: "sigil-stdlib"
10
url: "codeberg:sigil/sigil"
11
ref: "^0.17"
−12
sha: "8b3e7f90795b569a5ac3011c5a46311989230648"
+12
sha: "070f133a3524142b4febfd7c287385186b616252"
13
package-selector: "sigil-stdlib"
−14
version: "0.17.13")
+14
version: "0.17.20")
+15
(package name: "sigil-test"
+16
url: "codeberg:sigil/sigil"
+17
ref: "^0.17"
+18
sha: "070f133a3524142b4febfd7c287385186b616252"
+19
package-selector: "sigil-test"
+20
version: "0.17.20")
+21
(package name: "sigil-test-runner"
+22
url: "codeberg:sigil/sigil"
+23
ref: "^0.17"
+24
sha: "070f133a3524142b4febfd7c287385186b616252"
+25
package-selector: "sigil-test-runner"
+26
version: "0.17.20")
+27
(package name: "sigil-ansi"
+28
url: "codeberg:sigil/sigil-ansi"
+29
ref: "^0.16.0"
+30
sha: "1e14b6f9d034ca8ef9f404e2ded316d0780ad7cf"
+31
version: "0.16.0")
+32
(package name: "sigil-json"
+33
url: "codeberg:sigil/sigil-json"
+34
ref: "^0.16.0"
+35
sha: "55c9e74712b5f79b45d41c65cfe0aef2c8f7e155"
+36
version: "0.16.0")
+37
(package name: "sigil-version"
+38
url: "codeberg:sigil/sigil-version"
+39
ref: "^0.16.0"
+40
sha: "2d2c9ef9c2694466f65abc14cddf9bfb9cada4a4"
+41
version: "0.16.0")
+42
(package name: "sigil-git"
+43
url: "codeberg:sigil/sigil-git"
+44
ref: "^0.16.0"
+45
sha: "2d54eb99d3ca0597b3ccd9d4829d312c54721086"
+46
version: "0.16.1")
47
)
src/sigil/sqlite.sglmodified
@@ -58,7 +58,14 @@
58
sqlite-query
59
sqlite-query-row
60
sqlite-run
−61
call-with-database)
+61
call-with-database
+62
+63
;; Cooperative busy-retry budget (see the busy_timeout notes below)
+64
sqlite-busy-budget
+65
sqlite-set-busy-budget!
+66
+67
;; Diagnostic: is a fiber holding this connection?
+68
sqlite-connection-locked?)
69
70
(begin
71
@@ -170,6 +177,166 @@
177
(loop)))
178
result)))))
179
+180
;; ========== Per-connection serialisation ==========
+181
;;
+182
;; A SQLITE CONNECTION IS A SERIAL RESOURCE AND THIS LIBRARY USED TO TREAT
+183
;; IT AS A SHARED ONE.
+184
;;
+185
;; SQLite ends a connection's implicit read transaction only when NO
+186
;; statement on it is active. So if fiber A has a statement open on a
+187
;; connection and fiber B runs a query on the SAME connection, B's read
+188
;; transaction cannot be released when B finalizes -- A is still using the
+189
;; btree. The connection is pinned to B's snapshot until A finishes, and
+190
;; every later read on it silently misses anything committed in between.
+191
;;
+192
;; That is not hypothetical: it produced a CI controller serving a
+193
;; pre-commit view of its own database, HTTP 200, no error, permanently,
+194
;; until the process restarted. Once pinned, the connection's own parked
+195
;; write can never complete either -- it exhausts the busy budget, RAISES,
+196
;; and (before this change) leaked its statement, which held the read
+197
;; transaction open for the life of the process.
+198
;;
+199
;; GUARDING ONLY THE BUSY WINDOW IS NOT ENOUGH, and this is the measurement
+200
;; that decided the design: a fiber yields inside an UNCONTENDED query too,
+201
;; roughly once per 450 rows, driven by allocation rather than by time. A
+202
;; witness fiber ticking across a 20000-row query counts ~44 yields with no
+203
;; busy anywhere. So the lock spans the WHOLE primitive -- prepare through
+204
;; finalize, every yield included -- not just the retry.
+205
;;
+206
;; SCOPE IS DELIBERATELY THE PRIMITIVE, NOT THE CALLER. Held any coarser,
+207
;; the lock would deadlock the moment a consumer's DB helper called another
+208
;; DB helper. At primitive scope reentrancy is impossible by construction:
+209
;; no user code runs between prepare and finalize -- the whole call set
+210
;; there is natives plus pure list operations, with no callback.
+211
;;
+212
;; WHAT IT COSTS, stated plainly because it is a real behaviour change:
+213
;; concurrent DB calls on ONE connection now SERIALISE. A fiber waiting for
+214
;; a connection whose holder is parked on a contended write waits for that
+215
;; whole busy budget. Callers who want concurrency across DB work want
+216
;; separate connections; that is what connections are for.
+217
;;
+218
;; The low-level API (sqlite-prepare / sqlite-step / sqlite-finalize) is
+219
;; NOT covered -- it cannot be, since the library does not know when the
+220
;; caller's statement is finished. A caller holding a statement across
+221
;; steps on a shared connection still owns that hazard. See
+222
;; docs/concurrency.md.
+223
+224
(define-native (%sqlite-try-acquire! db)
+225
(: sqlite-db? -> boolean?))
+226
+227
(define-native (%sqlite-release! db)
+228
(: sqlite-db? -> boolean?))
+229
+230
;;; Is a fiber currently holding this connection? Diagnostic.
+231
(define-native (sqlite-connection-locked? db)
+232
(: sqlite-db? -> boolean?))
+233
+234
;; How long a fiber will wait for a connection another fiber holds before
+235
;; giving up. It must exceed the busy budget, because a legitimate holder
+236
;; may be parked on a contended write for exactly that long; three times is
+237
;; the margin. A BOUND rather than an infinite wait on purpose: two
+238
;; connections acquired in opposite orders by two fibers is a deadlock, and
+239
;; a bounded wait turns that into a loud, attributable error instead of a
+240
;; process that stops forever with no output.
+241
(define *sqlite-connection-wait-seconds* 15.0)
+242
(define *sqlite-connection-poll-interval* 0.001)
+243
+244
;;; Run `thunk` holding `db` exclusively. Releases on EVERY exit path,
+245
;;; including a raise -- `dynamic-wind`'s after thunk runs when the body
+246
;;; raises (measured, not assumed).
+247
(define (call-with-connection db thunk)
+248
(: sqlite-db? procedure? -> any?)
+249
(let ((deadline (+ (current-second) *sqlite-connection-wait-seconds*)))
+250
(let loop ()
+251
(if (%sqlite-try-acquire! db)
+252
(dynamic-wind
+253
(lambda () #t)
+254
thunk
+255
(lambda () (%sqlite-release! db)))
+256
(if (> (current-second) deadline)
+257
(error (string-append
+258
"sqlite: connection busy -- another fiber has held it for "
+259
(number->string *sqlite-connection-wait-seconds*)
+260
"s. Either a DB call is wedged, or two fibers are each "
+261
"waiting for a connection the other holds. Use one "
+262
"connection per fiber if you need concurrent DB work."))
+263
(begin
+264
(sleep *sqlite-connection-poll-interval*)
+265
(loop)))))))
+266
+267
;; ---------- busy_timeout: was accepted and ignored ----------
+268
;;
+269
;; `PRAGMA busy_timeout=N` USED TO BE DEAD CONFIGURATION THAT READ AS LIVE.
+270
;; The native layer forces SQLite's own busy_timeout to 0 on every call --
+271
;; deliberately, and it must keep doing so: a step that blocks inside C
+272
;; freezes the entire cooperative scheduler, including the fiber holding
+273
;; the lock, which can then never run to commit. That was measured: a
+274
;; blocking step let a witness fiber tick 0 times in two seconds where the
+275
;; retrying path let it tick 4701 times.
+276
;;
+277
;; So the PRAGMA cannot be passed through to SQLite. Instead of continuing
+278
;; to swallow it, it is now HONOURED: it sets the cooperative retry budget,
+279
;; which is the same intent expressed where this library can act on it.
+280
;; `PRAGMA busy_timeout=5000` therefore means what a caller has always
+281
;; reasonably assumed it meant.
+282
;;
+283
;; The budget is process-wide rather than per-connection, because
+284
;; `sqlite-step` receives a statement and has no connection to look it up
+285
;; on. Setting it from one connection changes it for all of them. Prefer
+286
;; `sqlite-set-busy-budget!`, which says so.
+287
+288
;;; The cooperative busy-retry budget, in seconds.
+289
(define (sqlite-busy-budget)
+290
(: -> number?)
+291
*sqlite-busy-budget-seconds*)
+292
+293
;;; Set the cooperative busy-retry budget, in seconds. PROCESS-WIDE.
+294
(define (sqlite-set-busy-budget! seconds)
+295
(: number? -> number?)
+296
(set! *sqlite-busy-budget-seconds* seconds)
+297
seconds)
+298
+299
(define (%lower-char c)
+300
(if (and (char>=? c #\A) (char<=? c #\Z))
+301
(integer->char (+ (char->integer c) 32))
+302
c))
+303
+304
(define (%lower-string s)
+305
(list->string (map %lower-char (string->list s))))
+306
+307
;; Index of `needle` in `hay` at or after `start`, or #f.
+308
(define (%string-find hay needle start)
+309
(let ((hn (string-length hay))
+310
(nn (string-length needle)))
+311
(let loop ((i start))
+312
(cond ((> (+ i nn) hn) #f)
+313
((string=? (substring hay i (+ i nn)) needle) i)
+314
(else (loop (+ i 1)))))))
+315
+316
;; If `sql` is a busy_timeout pragma, its value in milliseconds; else #f.
+317
;; Deliberately tolerant about spacing and case, and deliberately narrow
+318
;; about everything else: it must not claim statements it does not
+319
;; understand.
+320
(define (%busy-timeout-pragma-ms sql)
+321
(let* ((low (%lower-string sql))
+322
(p (%string-find low "pragma" 0))
+323
(b (and p (%string-find low "busy_timeout" p)))
+324
(e (and b (%string-find low "=" b))))
+325
(and e
+326
(let loop ((i (+ e 1)) (digits '()))
+327
(cond ((>= i (string-length low))
+328
(if (null? digits) #f
+329
(string->number (list->string (reverse digits)))))
+330
((and (char>=? (string-ref low i) #\0)
+331
(char<=? (string-ref low i) #\9))
+332
(loop (+ i 1) (cons (string-ref low i) digits)))
+333
((null? digits)
+334
(if (char=? (string-ref low i) #\space)
+335
(loop (+ i 1) digits)
+336
#f))
+337
(else (string->number (list->string (reverse digits)))))))))
+338
+339
340
;;; Execute a SQL string directly.
341
;;;
342
;;; Suitable for DDL statements and simple queries that don't need
@@ -183,7 +350,11 @@
350
;;; ```
351
(define (sqlite-exec db sql)
352
(: sqlite-db? string? -> boolean?)
−186
(retry-on-busy "sqlite-exec" (lambda () (%sqlite-exec-native db sql))))
+353
(let ((ms (%busy-timeout-pragma-ms sql)))
+354
(when ms (sqlite-set-busy-budget! (/ ms 1000.0))))
+355
(call-with-connection db
+356
(lambda ()
+357
(retry-on-busy "sqlite-exec" (lambda () (%sqlite-exec-native db sql))))))
358
359
;;; Step through a prepared statement.
360
;;;
@@ -289,40 +460,50 @@
460
;;; ```
461
(define (sqlite-query db sql . params)
462
(: sqlite-db? string? any? ... -> list?)
−292
(let ((stmt (sqlite-prepare db sql)))
−293
(if (not stmt)
−294
'()
−295
(begin
−296
;; Bind parameters (1-based index)
−297
(let loop ((params params) (idx 1))
−298
(when (not (null? params))
−299
(sqlite-bind stmt idx (car params))
−300
(loop (cdr params) (+ idx 1))))
−301
;; Collect column names
−302
(let* ((col-count (sqlite-column-count stmt))
−303
(col-names (let loop ((i 0) (names '()))
−304
(if (>= i col-count)
−305
(reverse names)
−306
(loop (+ i 1)
−307
(cons (string->symbol (sqlite-column-name stmt i))
−308
names))))))
−309
;; Collect rows
−310
(let loop ((rows '()))
−311
(let ((result (sqlite-step stmt)))
−312
(cond
−313
((eq? result 'row)
−314
;; Build alist for this row
−315
(let ((row (let inner ((i 0) (pairs '()))
−316
(if (>= i col-count)
−317
(reverse pairs)
−318
(inner (+ i 1)
−319
(cons (cons (list-ref col-names i)
−320
(sqlite-column stmt i))
−321
pairs))))))
−322
(loop (cons row rows))))
−323
(else
−324
(sqlite-finalize stmt)
−325
(reverse rows))))))))))
+463
(call-with-connection db
+464
(lambda ()
+465
(let ((stmt (sqlite-prepare db sql)))
+466
(if (not stmt)
+467
'()
+468
;; The statement is finalized by the after thunk, so it is
+469
;; released on EVERY exit path. It previously finalized only on
+470
;; the `else` branch below, which meant a raise from
+471
;; `sqlite-step` -- the ordinary outcome when the busy budget is
+472
;; exhausted -- leaked the statement. A leaked statement holds
+473
;; the connection's read transaction open for the life of the
+474
;; process, which is what turned a transient stale read into a
+475
;; permanent one.
+476
(dynamic-wind
+477
(lambda () #t)
+478
(lambda ()
+479
;; Bind parameters (1-based index)
+480
(let loop ((params params) (idx 1))
+481
(when (not (null? params))
+482
(sqlite-bind stmt idx (car params))
+483
(loop (cdr params) (+ idx 1))))
+484
;; Collect column names
+485
(let* ((col-count (sqlite-column-count stmt))
+486
(col-names (let loop ((i 0) (names '()))
+487
(if (>= i col-count)
+488
(reverse names)
+489
(loop (+ i 1)
+490
(cons (string->symbol (sqlite-column-name stmt i))
+491
names))))))
+492
;; Collect rows
+493
(let loop ((rows '()))
+494
(let ((result (sqlite-step stmt)))
+495
(cond
+496
((eq? result 'row)
+497
(let ((row (let inner ((i 0) (pairs '()))
+498
(if (>= i col-count)
+499
(reverse pairs)
+500
(inner (+ i 1)
+501
(cons (cons (list-ref col-names i)
+502
(sqlite-column stmt i))
+503
pairs))))))
+504
(loop (cons row rows))))
+505
(else (reverse rows)))))))
+506
(lambda () (sqlite-finalize stmt))))))))
507
508
;;; Execute a SQL query and return only the first row as an alist.
509
;;; Returns #f if no rows match.
@@ -350,19 +531,21 @@
531
;;; ```
532
(define (sqlite-run db sql . params)
533
(: sqlite-db? string? any? ... -> boolean?)
−353
(let ((stmt (sqlite-prepare db sql)))
−354
(if (not stmt)
−355
#f
−356
(begin
−357
;; Bind parameters
−358
(let loop ((params params) (idx 1))
−359
(when (not (null? params))
−360
(sqlite-bind stmt idx (car params))
−361
(loop (cdr params) (+ idx 1))))
−362
;; Execute
−363
(let ((result (sqlite-step stmt)))
−364
(sqlite-finalize stmt)
−365
(and result #t))))))
+534
(call-with-connection db
+535
(lambda ()
+536
(let ((stmt (sqlite-prepare db sql)))
+537
(if (not stmt)
+538
#f
+539
;; Finalized on every exit path -- see sqlite-query.
+540
(dynamic-wind
+541
(lambda () #t)
+542
(lambda ()
+543
(let loop ((params params) (idx 1))
+544
(when (not (null? params))
+545
(sqlite-bind stmt idx (car params))
+546
(loop (cdr params) (+ idx 1))))
+547
(and (sqlite-step stmt) #t))
+548
(lambda () (sqlite-finalize stmt))))))))
549
550
;;; Open a database, call proc with the handle, and ensure it's closed.
551
;;;
test/test-sqlite-connection-pin.sgladded
@@ -0,0 +1,227 @@
+1
;;; Regression test for the shared-connection snapshot pin.
+2
;;;
+3
;;; THE DEFECT. SQLite ends a connection's implicit read transaction only when
+4
;;; NO statement on it is active. So if fiber A has a statement open on a
+5
;;; connection -- parked in the cooperative busy-retry, say -- and fiber B runs
+6
;;; a query on the SAME connection, B's read transaction cannot be released
+7
;;; when B finalizes: A is still using the btree. The connection is pinned to
+8
;;; B's snapshot until A completes, and every later read on it silently misses
+9
;;; anything committed in between.
+10
;;;
+11
;;; It produced a CI controller serving a pre-commit view of its own database:
+12
;;; HTTP 200, no error, and permanent, because the parked write then could not
+13
;;; complete either -- it exhausted the busy budget, RAISED, and leaked its
+14
;;; unfinalized statement, which held the read transaction open for the life of
+15
;;; the process.
+16
;;;
+17
;;; THE ORDER IS THE VARIABLE, which is why arm 1 has a control that differs by
+18
;;; exactly one read. Before the fix, READ-DURING-PARK returned the pre-commit
+19
;;; count and NO-READ-DURING-PARK did not.
+20
;;;
+21
;;; Arms:
+22
;;; 1. NO-READ-DURING-PARK control -- no read while the write is parked
+23
;;; 2. READ-DURING-PARK the defect: a read on the shared connection while
+24
;;; a write on it is parked, across an external commit
+25
;;; 3. RAISE-LEAKS-STATEMENT a write that exhausts the budget and raises must
+26
;;; still finalize, or it pins the connection forever
+27
;;; 4. BUSY-TIMEOUT-PRAGMA `PRAGMA busy_timeout=N` must actually set the
+28
;;; retry budget rather than be silently swallowed
+29
+30
(import (sigil core)
+31
(sigil async)
+32
(sigil sqlite)
+33
(sigil time)
+34
(sigil string))
+35
+36
(display "Testing SQLite shared-connection snapshot pin...\n")
+37
+38
(define SEED 700)
+39
(define BASE 10)
+40
(define failures '())
+41
(define (fail! msg) (set! failures (cons msg failures)))
+42
+43
(define (fresh-count path)
+44
(let* ((F (sqlite-open path))
+45
(r (sqlite-query-row F "SELECT count(*) AS n FROM t"))
+46
(n (if r (assoc-ref 'n r) 'query-failed)))
+47
(sqlite-close F)
+48
n))
+49
+50
(define (shared-count C)
+51
(let ((r (sqlite-query-row C "SELECT count(*) AS n FROM t")))
+52
(if r (assoc-ref 'n r) 'query-failed)))
+53
+54
(define (make-db path)
+55
(let ((C (sqlite-open path)))
+56
(sqlite-exec C "PRAGMA journal_mode=WAL")
+57
(sqlite-exec C "DROP TABLE IF EXISTS t")
+58
(sqlite-exec C "DROP TABLE IF EXISTS w")
+59
(sqlite-exec C "CREATE TABLE t (id INTEGER PRIMARY KEY, v TEXT)")
+60
(sqlite-exec C "CREATE TABLE w (id INTEGER PRIMARY KEY, v TEXT)")
+61
(let loop ((i 0))
+62
(when (< i BASE)
+63
(sqlite-run C "INSERT INTO t (v) VALUES (?)" "base")
+64
(loop (+ i 1))))
+65
C))
+66
+67
;; ---------------------------------------------------------------- arms 1 & 2
+68
;;
+69
;; `read-during?` is the ONLY difference between them.
+70
(define (run-pin-arm name path read-during?)
+71
(let ((C (make-db path))
+72
(P #f)
+73
(committed #f) (reheld #f) (released #f)
+74
(started 0) (finished 0)
+75
(early 'not-taken)
+76
(shared 'unset) (fresh 'unset))
+77
(set! P (sqlite-open path))
+78
(with-async
+79
;; The external writer: holds the lock, commits SEED rows, re-takes it so
+80
;; the park outlives the commit, then releases.
+81
(go (begin
+82
(sqlite-exec P "BEGIN IMMEDIATE")
+83
(sleep 0.30)
+84
(let loop ((i 0))
+85
(when (< i SEED)
+86
(sqlite-run P "INSERT INTO t (v) VALUES (?)" "seed")
+87
(loop (+ i 1))))
+88
(sqlite-exec P "COMMIT")
+89
(set! committed #t)
+90
(sqlite-exec P "BEGIN IMMEDIATE")
+91
(set! reheld #t)
+92
(sleep 0.80)
+93
(sqlite-exec P "COMMIT")
+94
(set! released #t)))
+95
;; The write on the SHARED connection. Parks on the external lock.
+96
(go (begin
+97
(sleep 0.05)
+98
(set! started (+ started 1))
+99
(guard (exn (#t #f))
+100
(sqlite-run C "INSERT INTO w (v) VALUES (?)" "shared-write"))
+101
(set! finished (+ finished 1))))
+102
;; THE ONE DIFFERENCE: a read on the shared connection during the park.
+103
(go (when read-during?
+104
(sleep 0.15)
+105
(set! early (shared-count C))))
+106
;; The measurement, once the external commit is durable.
+107
(go (begin
+108
(let loop ((n 0))
+109
(when (and (not reheld) (< n 2000)) (sleep 0.005) (loop (+ n 1))))
+110
(let loop ((n 0))
+111
(when (and (not (and released (= finished started))) (< n 4000))
+112
(sleep 0.005) (loop (+ n 1))))
+113
(sleep 0.05)
+114
(set! shared (shared-count C))
+115
(set! fresh (fresh-count path)))))
+116
(sqlite-close C)
+117
(sqlite-close P)
+118
(display (string-append " " name
+119
": shared=" (number->string shared)
+120
" fresh=" (number->string fresh)
+121
" early-read=" (if (eq? early 'not-taken) "not-taken"
+122
(number->string early))
+123
"\n"))
+124
;; SETUP ASSERTIONS FIRST. Without these an "agree" could be two equal
+125
;; wrong numbers -- a seed that never landed makes every arm pass.
+126
(when (not committed)
+127
(fail! (string-append name ": SETUP -- the external writer never committed")))
+128
(when (not (= fresh (+ BASE SEED)))
+129
(fail! (string-append name ": SETUP -- an independent connection sees "
+130
(number->string fresh) ", expected "
+131
(number->string (+ BASE SEED)))))
+132
(when (and read-during? (eq? early 'not-taken))
+133
(fail! (string-append name ": SETUP -- the during-park read never happened, "
+134
"so this arm did not test what it claims")))
+135
;; THE ASSERTION.
+136
(when (not (equal? shared fresh))
+137
(fail! (string-append name ": THE CONNECTION IS PINNED. It reports "
+138
(number->string shared)
+139
" rows while an independent connection sees "
+140
(number->string fresh)
+141
" in the same database. A read ran on the shared "
+142
"connection while a write on it was parked, and the "
+143
"read transaction it opened could not be released.")))
+144
(list shared fresh)))
+145
+146
(run-pin-arm "arm1 NO-READ-DURING-PARK (control)" "/tmp/sqlite-pin-a.db" #f)
+147
(run-pin-arm "arm2 READ-DURING-PARK" "/tmp/sqlite-pin-b.db" #t)
+148
+149
;; ------------------------------------------------------------------- arm 3
+150
;;
+151
;; A write that exhausts the busy budget RAISES. If it does not finalize on the
+152
;; way out, its statement holds the connection's read transaction open forever
+153
;; and every later read on that connection is stale.
+154
(define (run-leak-arm)
+155
(let* ((path "/tmp/sqlite-pin-c.db")
+156
(C (make-db path))
+157
(P (sqlite-open path))
+158
(raised #f) (after 'unset) (fresh 'unset))
+159
(sqlite-set-busy-budget! 0.25)
+160
(sqlite-exec P "BEGIN IMMEDIATE")
+161
(guard (exn (#t (set! raised #t)))
+162
(sqlite-run C "INSERT INTO w (v) VALUES (?)" "doomed"))
+163
;; The external writer commits and gets out of the way.
+164
(let loop ((i 0))
+165
(when (< i SEED)
+166
(sqlite-run P "INSERT INTO t (v) VALUES (?)" "seed")
+167
(loop (+ i 1))))
+168
(sqlite-exec P "COMMIT")
+169
(set! after (shared-count C))
+170
(set! fresh (fresh-count path))
+171
(sqlite-set-busy-budget! 5.0)
+172
(sqlite-close C)
+173
(sqlite-close P)
+174
(display (string-append " arm3 RAISE-LEAKS-STATEMENT: raised=" (if raised "#t" "#f")
+175
" shared-after=" (number->string after)
+176
" fresh=" (number->string fresh) "\n"))
+177
(when (not raised)
+178
(fail! "arm3: SETUP -- the contended write did not raise, so nothing was leaked or not leaked"))
+179
(when (not (= fresh (+ BASE SEED)))
+180
(fail! "arm3: SETUP -- the external writer's rows are not in the database"))
+181
(when (not (= after fresh))
+182
(fail! (string-append "arm3: A RAISED STATEMENT WAS NOT FINALIZED. The connection "
+183
"reports " (number->string after) " rows where an independent "
+184
"connection sees " (number->string fresh)
+185
". The leaked statement is holding the read transaction open.")))))
+186
(run-leak-arm)
+187
+188
;; ------------------------------------------------------------------- arm 4
+189
;;
+190
;; `PRAGMA busy_timeout=N` was accepted and silently ignored: the native layer
+191
;; forces SQLite's own busy_timeout to 0 (it must -- a blocking step freezes the
+192
;; whole cooperative scheduler). It now sets the cooperative retry budget.
+193
(define (run-pragma-arm)
+194
(let ((path "/tmp/sqlite-pin-d.db"))
+195
(let ((C (sqlite-open path)))
+196
(sqlite-set-busy-budget! 5.0)
+197
;; CONTROL FIRST: an unrelated pragma must NOT move the budget, or this
+198
;; arm would pass for any pragma at all.
+199
(sqlite-exec C "PRAGMA journal_mode=WAL")
+200
(when (not (= (sqlite-busy-budget) 5.0))
+201
(fail! (string-append "arm4: CONTROL -- an unrelated pragma changed the budget to "
+202
(number->string (sqlite-busy-budget)))))
+203
(sqlite-exec C "PRAGMA busy_timeout=250")
+204
(display (string-append " arm4 BUSY-TIMEOUT-PRAGMA: budget after PRAGMA busy_timeout=250 is "
+205
(number->string (sqlite-busy-budget)) "s\n"))
+206
(when (not (= (sqlite-busy-budget) 0.25))
+207
(fail! (string-append "arm4: `PRAGMA busy_timeout=250` did not set the retry budget; "
+208
"it is " (number->string (sqlite-busy-budget))
+209
"s. Dead configuration that reads as live.")))
+210
(sqlite-set-busy-budget! 5.0)
+211
(sqlite-close C))))
+212
(run-pragma-arm)
+213
+214
;; ---------------------------------------------------------------- verdict
+215
(if (null? failures)
+216
(display "PASS: the shared connection is serialised; no pin, no leaked statement, busy_timeout honoured\n")
+217
(begin
+218
(display "FAIL:\n")
+219
(let loop ((f (reverse failures)))
+220
(when (not (null? f))
+221
(display (string-append " - " (car f) "\n"))
+222
(loop (cdr f))))))
+223
+224
;; Final top-level value drives the harness exit code: 0 on pass, error on fail.
+225
(if (null? failures)
+226
0
+227
(error "shared-connection snapshot pin regression"))