445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
|
(define (dbfile:cautious-open-database fname init-proc #!optional (tries-left 10))
(let* ((lock-file (conc fname".lock"))
(retry (lambda ()
(thread-sleep! 1.1)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: Five attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (not (dbfile:simple-file-lock lock-file))
(begin
(dbfile:print-err "INFO: lock file "lock-file" exists, trying again in 1 second.")
(thread-sleep! 1)
(dbfile:cautious-open-database fname init-proc (- tries-left 1)))
(let* ((db-exists (file-exists? fname))
(result (condition-case
(let* ((db (sqlite3:open-database fname)))
|
|
|
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
|
(define (dbfile:cautious-open-database fname init-proc #!optional (tries-left 10))
(let* ((lock-file (conc fname".lock"))
(retry (lambda ()
(thread-sleep! 1.1)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: Five attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (and (file-write-access? fname) (not (dbfile:simple-file-lock lock-file)))
(begin
(dbfile:print-err "INFO: lock file "lock-file" exists, trying again in 1 second.")
(thread-sleep! 1)
(dbfile:cautious-open-database fname init-proc (- tries-left 1)))
(let* ((db-exists (file-exists? fname))
(result (condition-case
(let* ((db (sqlite3:open-database fname)))
|
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
|
(retry))
(exn (permission)(dbfile:print-err exn "ERROR: database " fname " has some permissions problem.")
(retry))
(exn ()
(dbfile:print-err exn "ERROR: Unknown error with database " fname " message: "
((condition-property-accessor 'exn 'message) exn))
(retry)))))
(dbfile:simple-file-release-lock lock-file)
result))))
(define (dbfile:open-no-sync-db dbpath)
(if *no-sync-db*
*no-sync-db*
(begin
|
>
|
>
|
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
|
(retry))
(exn (permission)(dbfile:print-err exn "ERROR: database " fname " has some permissions problem.")
(retry))
(exn ()
(dbfile:print-err exn "ERROR: Unknown error with database " fname " message: "
((condition-property-accessor 'exn 'message) exn))
(retry)))))
(if (file-write-access? fname)
(dbfile:simple-file-release-lock lock-file)
)
result))))
(define (dbfile:open-no-sync-db dbpath)
(if *no-sync-db*
*no-sync-db*
(begin
|
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
|
(thread-sleep! 0.25)
(if (file-exists? fname)
(handle-exceptions exn
#f
(with-input-from-file fname
(lambda ()
(equal? key-string (read-line)))))
#f)))))
(define (dbfile:simple-file-lock-and-wait fname #!key (expire-time 300))
(let ((end-time (+ expire-time (current-seconds))))
(let loop ((got-lock (dbfile:simple-file-lock fname expire-time: expire-time)))
(if got-lock
#t
(if (> end-time (current-seconds))
|
|
>
>
>
>
|
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
|
(thread-sleep! 0.25)
(if (file-exists? fname)
(handle-exceptions exn
#f
(with-input-from-file fname
(lambda ()
(equal? key-string (read-line)))))
#f)
)
)
)
)
(define (dbfile:simple-file-lock-and-wait fname #!key (expire-time 300))
(let ((end-time (+ expire-time (current-seconds))))
(let loop ((got-lock (dbfile:simple-file-lock fname expire-time: expire-time)))
(if got-lock
#t
(if (> end-time (current-seconds))
|