Megatest

Diff
Login

Differences From Artifact [57bcb686f3]:

To Artifact [d652e662dd]:


445
446
447
448
449
450
451
452

453
454
455
456
457
458
459
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))
    (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
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)
	    (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
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)))))
	      #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))