suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

db/sqlite3: fix custodian shutdown wrt locking

Browse Source
This commit is contained in:
Ryan Culpepper 2015-02-04 20:19:13 -05:00
parent acdb0b0e90
commit 991340e0b0
3 changed files with 65 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
racket/collects/db/private/generic/common.rkt
View File

@ -132,9 +132,11 @@
;; ---- ;; ----
;; LOCKING: requires unlocked
(define/public (call-with-lock who proc) (define/public (call-with-lock who proc)
(call-with-lock* who proc #f #t)) (call-with-lock* who proc #f #t))
;; LOCKING: requires unlocked
(define/public-final (call-with-lock* who proc hopeless require-connected?) (define/public-final (call-with-lock* who proc hopeless require-connected?)
(let ([me (thread-dead-evt (current-thread))] (let ([me (thread-dead-evt (current-thread))]
[eb? (break-enabled)] [eb? (break-enabled)]
@ -189,14 +191,17 @@
(for-each call-with-continuation-barrier async-calls)))) (for-each call-with-continuation-barrier async-calls))))
;; needs overriding ;; needs overriding
;; LOCKING: must not block, must not acquire lock
(define/public (connected?) #f) (define/public (connected?) #f)
;; LOCKING: requires locked
(define/public (add-delayed-call! proc) (define/public (add-delayed-call! proc)
(set! delayed-async-calls (cons proc delayed-async-calls))) (set! delayed-async-calls (cons proc delayed-async-calls)))
;; on-break-within-lock : -> void ;; on-break-within-lock : -> void
;; Called before unlock; makes it easy to disconnect on any break ;; Called before unlock; makes it easy to disconnect on any break
;; within lock. ;; within lock.
;; LOCKING: called within lock
(define/public (on-break-within-lock) (define/public (on-break-within-lock)
(void)) (void))
@ -212,6 +217,7 @@
(super-new) (super-new)
;; disconnect : -> void ;; disconnect : -> void
;; LOCKING: requires unlocked
(define/public (disconnect) (define/public (disconnect)
(when (connected?) (when (connected?)
(call-with-lock* 'disconnect (call-with-lock* 'disconnect
@ -219,6 +225,7 @@
(lambda () (disconnect* #f)) (lambda () (disconnect* #f))
#f))) #f)))
;; LOCKING: requires locked
(define/public (disconnect* politely?) (define/public (disconnect* politely?)
(dprintf " ** disconnecting~a\n" (if politely? " politely" "")) (dprintf " ** disconnecting~a\n" (if politely? " politely" ""))
(void)) (void))
@ -264,7 +271,6 @@
;; ---- ;; ----
;; (inherit call-with-lock)
(define/override (call-with-lock fsym proc) (define/override (call-with-lock fsym proc)
(super call-with-lock fsym (super call-with-lock fsym
(lambda () (lambda ()

4
racket/collects/db/private/generic/interfaces.rkt
View File

@ -181,6 +181,7 @@ For SQLite, use symbol instead of SQLSTATE string.
(provide error/internal (provide error/internal
error/internal* error/internal*
error/not-connected error/not-connected
error/disconnect-in-lock
error/no-support error/no-support
error/need-password error/need-password
error/comm error/comm
@ -223,6 +224,9 @@ For SQLite, use symbol instead of SQLSTATE string.
(define (error/not-connected fsym) (define (error/not-connected fsym)
(error fsym "not connected")) (error fsym "not connected"))
(define (error/disconnect-in-lock fsym)
(error fsym "disconnected during operation;\n possibly due to custodian shutdown"))
;; ---- ;; ----
(define (error/invalid-nested-isolation fsym isolation) (define (error/invalid-nested-isolation fsym isolation)

95
racket/collects/db/private/sqlite3/connection.rkt
View File

@ -48,6 +48,15 @@
(define/override (call-with-lock fsym proc) (define/override (call-with-lock fsym proc)
(call-with-lock* fsym (lambda () (set! saved-tx-status (get-tx-status)) (proc)) #f #t)) (call-with-lock* fsym (lambda () (set! saved-tx-status (get-tx-status)) (proc)) #f #t))
;; Custodian shutdown can cause disconnect even in the middle of
;; operation (with lock held). So use (A _) around any FFI calls,
;; check still connected.
(define-syntax-rule (A e ...)
(call-as-atomic
(lambda ()
(unless -db (error/disconnect-in-lock 'sqlite3))
e ...)))
(define/private (get-db fsym) (define/private (get-db fsym)
(or -db (error/not-connected fsym))) (or -db (error/not-connected fsym)))
@ -73,19 +82,19 @@
(when delenda (when delenda
(for ([pst (in-hash-values delenda)]) (for ([pst (in-hash-values delenda)])
(send pst finalize #f))) (send pst finalize #f)))
(void (sqlite3_reset stmt)) (A (sqlite3_reset stmt)
(void (sqlite3_clear_bindings stmt)) (sqlite3_clear_bindings stmt))
(for ([i (in-naturals 1)] (for ([i (in-naturals 1)]
[param (in-list params)]) [param (in-list params)])
(load-param fsym db stmt i param)) (load-param fsym db stmt i param))
(let* ([info (let* ([info
(for/list ([i (in-range (sqlite3_column_count stmt))]) (for/list ([i (in-range (A (sqlite3_column_count stmt)))])
`((name . ,(sqlite3_column_name stmt i)) (A `((name . ,(sqlite3_column_name stmt i))
(decltype . ,(sqlite3_column_decltype stmt i))))] (decltype . ,(sqlite3_column_decltype stmt i)))))]
[saved-last-insert-rowid [saved-last-insert-rowid
(and (null? info) (sqlite3_last_insert_rowid db))] (and (null? info) (A (sqlite3_last_insert_rowid db)))]
[saved-total-changes [saved-total-changes
(and (null? info) (sqlite3_total_changes db))] (and (null? info) (A (sqlite3_total_changes db)))]
[result [result
(or cursor? (or cursor?
(step* fsym db stmt #f +inf.0 pst))]) (step* fsym db stmt #f +inf.0 pst))])
@ -99,8 +108,8 @@
(cursor-result info pst (box #f))] (cursor-result info pst (box #f))]
[else [else
(simple-result (simple-result
(let ([last-insert-rowid (sqlite3_last_insert_rowid db)] (let ([last-insert-rowid (A (sqlite3_last_insert_rowid db))]
[total-changes (sqlite3_total_changes db)]) [total-changes (A (sqlite3_total_changes db))])
;; Not all statements clear last_insert_rowid, changes; so ;; Not all statements clear last_insert_rowid, changes; so
;; extra guards to make sure results are relevant. ;; extra guards to make sure results are relevant.
`((insert-id `((insert-id
@ -108,7 +117,7 @@
last-insert-rowid)) last-insert-rowid))
(affected-rows (affected-rows
. ,(if (> total-changes saved-total-changes) . ,(if (> total-changes saved-total-changes)
(sqlite3_changes db) (A (sqlite3_changes db))
0)))))]))))) 0)))))])))))
(define/public (fetch/cursor fsym cursor fetch-size) (define/public (fetch/cursor fsym cursor fetch-size)
@ -139,23 +148,23 @@
(define/private (load-param fsym db stmt i param) (define/private (load-param fsym db stmt i param)
(HANDLE fsym (HANDLE fsym
(cond [(int64? param) (cond [(int64? param)
(sqlite3_bind_int64 stmt i param)] (A (sqlite3_bind_int64 stmt i param))]
[(real? param) ;; includes >64-bit exact integers [(real? param) ;; includes >64-bit exact integers
(sqlite3_bind_double stmt i (exact->inexact param))] (A (sqlite3_bind_double stmt i (exact->inexact param)))]
[(string? param) [(string? param)
(sqlite3_bind_text stmt i param)] (A (sqlite3_bind_text stmt i param))]
[(bytes? param) [(bytes? param)
(sqlite3_bind_blob stmt i param)] (A (sqlite3_bind_blob stmt i param))]
[(sql-null? param) [(sql-null? param)
(sqlite3_bind_null stmt i)] (A (sqlite3_bind_null stmt i))]
[else [else
(error/internal* fsym "bad parameter value" '("value" value) param)]))) (error/internal* fsym "bad parameter value" '("value" value) param)])))
(define/private (step* fsym db stmt end-box fetch-limit pst) (define/private (step* fsym db stmt end-box fetch-limit pst)
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(lambda (e) (lambda (e)
(void (sqlite3_reset stmt)) (A (sqlite3_reset stmt)
(void (sqlite3_clear_bindings stmt)) (sqlite3_clear_bindings stmt))
(raise e))]) (raise e))])
(let loop ([fetch-limit fetch-limit]) (let loop ([fetch-limit fetch-limit])
(if (zero? fetch-limit) (if (zero? fetch-limit)
@ -164,30 +173,30 @@
(cond [c (cond [c
(cons c (loop (sub1 fetch-limit)))] (cons c (loop (sub1 fetch-limit)))]
[else [else
(void (sqlite3_reset stmt)) (A (sqlite3_reset stmt)
(void (sqlite3_clear_bindings stmt)) (sqlite3_clear_bindings stmt))
(when end-box (set-box! end-box #t)) (when end-box (set-box! end-box #t))
null])))))) null]))))))
(define/private (step fsym db stmt pst) (define/private (step fsym db stmt pst)
(let ([s (HANDLE fsym (sqlite3_step stmt) pst)]) (let ([s (HANDLE fsym (A (sqlite3_step stmt)) pst)])
(cond [(= s SQLITE_DONE) #f] (cond [(= s SQLITE_DONE) #f]
[(= s SQLITE_ROW) [(= s SQLITE_ROW)
(let* ([column-count (sqlite3_column_count stmt)] (let* ([column-count (A (sqlite3_column_count stmt))]
[vec (make-vector column-count)]) [vec (make-vector column-count)])
(for ([i (in-range column-count)]) (for ([i (in-range column-count)])
(vector-set! vec i (vector-set! vec i
(let ([type (sqlite3_column_type stmt i)]) (let ([type (A (sqlite3_column_type stmt i))])
(cond [(= type SQLITE_NULL) (cond [(= type SQLITE_NULL)
sql-null] sql-null]
[(= type SQLITE_INTEGER) [(= type SQLITE_INTEGER)
(sqlite3_column_int64 stmt i)] (A (sqlite3_column_int64 stmt i))]
[(= type SQLITE_FLOAT) [(= type SQLITE_FLOAT)
(sqlite3_column_double stmt i)] (A (sqlite3_column_double stmt i))]
[(= type SQLITE_TEXT) [(= type SQLITE_TEXT)
(sqlite3_column_text stmt i)] (A (sqlite3_column_text stmt i))]
[(= type SQLITE_BLOB) [(= type SQLITE_BLOB)
(sqlite3_column_blob stmt i)] (A (sqlite3_column_blob stmt i))]
[else [else
(error/internal* fsym "unknown column type" (error/internal* fsym "unknown column type"
"type" type)])))) "type" type)]))))
@ -200,26 +209,24 @@
(let*-values ([(db) (get-db fsym)] (let*-values ([(db) (get-db fsym)]
[(prep-status stmt) [(prep-status stmt)
(HANDLE fsym (HANDLE fsym
(call-as-atomic
;; Do not allow break/kill between prepare and ;; Do not allow break/kill between prepare and
;; entry of stmt in table. ;; entry of stmt in table.
(lambda () (A (let-values ([(prep-status stmt tail?)
(let-values ([(prep-status stmt tail?)
(sqlite3_prepare_v2 db sql)]) (sqlite3_prepare_v2 db sql)])
(when tail? (when tail?
(when stmt (sqlite3_finalize stmt)) (when stmt (sqlite3_finalize stmt))
(error* fsym "multiple statements given" (error* fsym "multiple statements given"
'("given" value) sql)) '("given" value) sql))
(when stmt (hash-set! stmt-table stmt #t)) (when stmt (hash-set! stmt-table stmt #t))
(values prep-status stmt)))))]) (values prep-status stmt))))])
(when DEBUG? (when DEBUG?
(dprintf " << prepared statement #x~x\n" (cast stmt _pointer _uintptr))) (dprintf " << prepared statement #x~x\n" (cast stmt _pointer _uintptr)))
(unless stmt (error* fsym "SQL syntax error" '("given" value) sql)) (unless stmt (error* fsym "SQL syntax error" '("given" value) sql))
(let* ([param-typeids (let* ([param-typeids
(for/list ([i (in-range (sqlite3_bind_parameter_count stmt))]) (for/list ([i (in-range (A (sqlite3_bind_parameter_count stmt)))])
'any)] 'any)]
[result-dvecs [result-dvecs
(for/list ([i (in-range (sqlite3_column_count stmt))]) (for/list ([i (in-range (A (sqlite3_column_count stmt)))])
'#(any))] '#(any))]
[pst (new prepared-statement% [pst (new prepared-statement%
(handle stmt) (handle stmt)
@ -236,8 +243,8 @@
(call-as-atomic (call-as-atomic
(lambda () (lambda ()
(let ([db -db]) (let ([db -db])
(set! -db #f)
(when db (when db
(set! -db #f)
;; Free all of connection's prepared statements. This will leave ;; Free all of connection's prepared statements. This will leave
;; pst objects with dangling foreign objects, so don't try to free ;; pst objects with dangling foreign objects, so don't try to free
;; them again---check that -db is not-#f. ;; them again---check that -db is not-#f.
@ -275,7 +282,7 @@
;; http://www.sqlite.org/lang_transaction.html ;; http://www.sqlite.org/lang_transaction.html
(define/private (read-tx-status) (define/private (read-tx-status)
(not (sqlite3_get_autocommit -db))) (not (A (sqlite3_get_autocommit -db))))
(define/override (start-transaction* fsym isolation option) (define/override (start-transaction* fsym isolation option)
;; Isolation level can be set to READ UNCOMMITTED via pragma, but ;; Isolation level can be set to READ UNCOMMITTED via pragma, but
@ -371,7 +378,10 @@
(when (memv (simplify-status full-s) maybe-rollback-status-list) (when (memv (simplify-status full-s) maybe-rollback-status-list)
(when (and saved-tx-status -db (not (read-tx-status))) ;; was in trans, now not (when (and saved-tx-status -db (not (read-tx-status))) ;; was in trans, now not
(set-tx-status! who 'invalid))) (set-tx-status! who 'invalid)))
(handle-status* who full-s -db db-spec pst)) (handle-status* who full-s this db-spec pst))
(define/public (get-error-message)
(A (sqlite3_errmsg -db)))
;; ---- ;; ----
(super-new) (super-new)
@ -381,7 +391,7 @@
;; (eg, sqlite3_close) used by its methods from being finalized. ;; (eg, sqlite3_close) used by its methods from being finalized.
(let ([dont-gc this%]) (let ([dont-gc this%])
(lambda (obj) (lambda (obj)
(send obj disconnect) (send obj disconnect* #f)
;; Dummy result to prevent reference from being optimized away ;; Dummy result to prevent reference from being optimized away
dont-gc))))) dont-gc)))))
@ -406,8 +416,12 @@
[sym [sym
(cadr info)] (cadr info)]
[message [message
(cond [(and (= s SQLITE_ERROR) db) (cond [(= s SQLITE_ERROR)
(cond [(is-a? db connection%)
(send db get-error-message)]
[(sqlite3_database? db)
(sqlite3_errmsg db)] (sqlite3_errmsg db)]
[else (caddr info)])]
[else (caddr info)])]) [else (caddr info)])])
(define extra (define extra
(string-append (string-append
@ -416,13 +430,6 @@
;; query, if available ;; query, if available
(cond [sql (format "\n SQL: ~e" sql)] (cond [sql (format "\n SQL: ~e" sql)]
[else ""]) [else ""])
;; query in sqlite3_stmt, if differs
(let* ([stmt (and pst (send pst get-handle))]
[stmt_sql (and stmt (sqlite3_sql stmt))])
(cond [(equal? sql stmt_sql) ;; ie, either agree or both absent
""]
[else
(format "\n sqlite3_sql: ~e" stmt_sql)]))
;; db file and mode, if relevant and available ;; db file and mode, if relevant and available
(cond [(memv s include-db-file-status-list) (cond [(memv s include-db-file-status-list)
(string-append (string-append