Megatest

Diff
Login

Differences From Artifact [4b315f3788]:

To Artifact [f0738065cd]:


240
241
242
243
244
245
246

247
248
249
250
251
252
253
254
           #t
          )
          #f
  )
)

(define (dbfile:make-tmpdir-name areapath tmpadj)

  (let* ((dname (conc "/tmp/"(current-user-name)"/" (string-translate areapath "/" ".") tmpadj)))
    (unless (directory-exists? dname)
      (create-directory dname #t))
    dname))

(define (dbfile:run-id->path apath run-id)
  (conc apath"/"(dbfile:run-id->dbname run-id)))








>
|







240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
           #t
          )
          #f
  )
)

(define (dbfile:make-tmpdir-name areapath tmpadj)
  (let* ((area (pathname-file areapath))
         (dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
    (unless (directory-exists? dname)
      (create-directory dname #t))
    dname))

(define (dbfile:run-id->path apath run-id)
  (conc apath"/"(dbfile:run-id->dbname run-id)))

485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
;; opens and returns handle and nothing else
;;
;; NOTE: this is already protected by mutex *no-sync-db-mutex*
;;
(define (dbfile:raw-open-no-sync-db dbpath)
  (if (not (file-exists? dbpath))
      (create-directory dbpath #t))
  (debug:print-info 0 *default-log-port* "Opening "dbpath"/no-sync.db")
  (let* ((dbname    (conc dbpath "/no-sync.db"))
	 (db-exists (file-exists? dbname))
	 (init-proc (lambda (db)
		      (sqlite3:with-transaction
		       db
		       (lambda ()
			 ;; I have been having trouble with init of no-sync.db so







|







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
;; opens and returns handle and nothing else
;;
;; NOTE: this is already protected by mutex *no-sync-db-mutex*
;;
(define (dbfile:raw-open-no-sync-db dbpath)
  (if (not (file-exists? dbpath))
      (create-directory dbpath #t))
  (debug:print-info 2 *default-log-port* "(dbfile:raw-open-no-sync-db: Opening "dbpath"/no-sync.db")
  (let* ((dbname    (conc dbpath "/no-sync.db"))
	 (db-exists (file-exists? dbname))
	 (init-proc (lambda (db)
		      (sqlite3:with-transaction
		       db
		       (lambda ()
			 ;; I have been having trouble with init of no-sync.db so
523
524
525
526
527
528
529
530
531

532
533
534
535
536
537
538
539
540
541
542
543
                                 dbname TEXT,
                                 mtversion TEXT,
                                 reason TEXT DEFAULT 'none',
                                   CONSTRAINT no_sync_processes UNIQUE (host,pid));"
			    ))))))
	 (on-tmp      (equal? (car (string-split dbpath "/")) "tmp"))
	 (db        (if on-tmp
			(dbfile:cautious-open-database dbname init-proc 0 "WAL" force-init: #t)
			(dbfile:cautious-open-database dbname init-proc 0 #f    force-init: #t)

			;; (sqlite3:open-database dbname)
			)))
    (if on-tmp	      ;; done in cautious-open-database
	(begin
	  (sqlite3:execute db "PRAGMA synchronous = 0;")
	  (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))))
    db))

;; mtest processes registry calls

(define (dbfile:insert-or-update-process nsdb dat)
  (let* ((host      (procinf-host dat))







|
|
>




|







524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
                                 dbname TEXT,
                                 mtversion TEXT,
                                 reason TEXT DEFAULT 'none',
                                   CONSTRAINT no_sync_processes UNIQUE (host,pid));"
			    ))))))
	 (on-tmp      (equal? (car (string-split dbpath "/")) "tmp"))
	 (db        (if on-tmp
			(dbfile:cautious-open-database dbname init-proc 1 "WAL" force-init: #t) ;; WAL MODE should use syncronous=1
			;; (dbfile:cautious-open-database dbname init-proc 0 #f    force-init: #t)
			(dbfile:cautious-open-database dbname init-proc 0 "MEMORY" force-init: #t)
			;; (sqlite3:open-database dbname)
			)))
    (if on-tmp	      ;; done in cautious-open-database
	(begin
	  ;; (sqlite3:execute db "PRAGMA synchronous = 0;") ;; why was this here when is is handled by cautious-open-database?
	  (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))))
    db))

;; mtest processes registry calls

(define (dbfile:insert-or-update-process nsdb dat)
  (let* ((host      (procinf-host dat))
673
674
675
676
677
678
679

680
681
682
683
684

685
686
687
688


689


690
691
692
693
694
695
696
;; transaction protected lock aquisition
;; either:
;;    fails    returns  (#f lock-creation-time identifier)
;;    succeeds (returns (#t lock-creation-time identifier)
;; use (db:no-sync-del! db keyname) to release the lock
;;
(define (db:no-sync-get-lock-with-id db keyname identifier)

  (sqlite3:with-transaction
   db
   (lambda ()
     (condition-case
      (let* ((curr-val (db:no-sync-get/default db keyname #f)))

	(if curr-val
	    (match (db:extract-time-identifier curr-val) ;; result->timestamp, identifier
	       ((timestamp . ident)
		(cons (equal? ident identifier) timestamp))


	       (else (cons #f 'malformed-lock)))  ;; lock malformed


	    (let ((curr-sec (current-seconds))
		  (lock-value (if identifier
				  (conc (current-seconds)"+"identifier)
				  (current-seconds))))
	      (sqlite3:execute db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-value)
	      (cons #t curr-sec))))
      (exn (io-error)  (dbfile:print-err "ERROR: i/o error with no-sync db. Check permissions, disk space etc. and try again."))







>





>




>
>
|
>
>







675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
;; transaction protected lock aquisition
;; either:
;;    fails    returns  (#f lock-creation-time identifier)
;;    succeeds (returns (#t lock-creation-time identifier)
;; use (db:no-sync-del! db keyname) to release the lock
;;
(define (db:no-sync-get-lock-with-id db keyname identifier)
  (debug:print 2 *default-log-port* "db:no-sync-get-lock-with-id: db: " db " keyname: " keyname " identifier: " identifier)
  (sqlite3:with-transaction
   db
   (lambda ()
     (condition-case
      (let* ((curr-val (db:no-sync-get/default db keyname #f)))
        (debug:print 2 *default-log-port* "db:no-sync-get-lock-with-id: curr-val: " curr-val)
	(if curr-val
	    (match (db:extract-time-identifier curr-val) ;; result->timestamp, identifier
	       ((timestamp . ident)
		(cons (equal? ident identifier) timestamp))
	       (else 
                (debug:print 2 *default-log-port* "db:no-sync-get-lock-with-id: malformed lock")
                (cons #f 'malformed-lock)
                )
            )  ;; lock malformed
	    (let ((curr-sec (current-seconds))
		  (lock-value (if identifier
				  (conc (current-seconds)"+"identifier)
				  (current-seconds))))
	      (sqlite3:execute db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-value)
	      (cons #t curr-sec))))
      (exn (io-error)  (dbfile:print-err "ERROR: i/o error with no-sync db. Check permissions, disk space etc. and try again."))
1570
1571
1572
1573
1574
1575
1576
1577

1578







	 (result      (or stmth
			  (let* ((newstmth (sqlite3:prepare db stmt)))
			    ;; (db:hoh-set! stmt-cache db stmt newstmth)
			    (hash-table-set! stmt-cache stmt newstmth)
			    newstmth))))
    (mutex-unlock! *get-cache-stmth-mutex*)
    result))


)















>
|
>
>
>
>
>
>
>
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
	 (result      (or stmth
			  (let* ((newstmth (sqlite3:prepare db stmt)))
			    ;; (db:hoh-set! stmt-cache db stmt newstmth)
			    (hash-table-set! stmt-cache stmt newstmth)
			    newstmth))))
    (mutex-unlock! *get-cache-stmth-mutex*)
    result))

(define *mutex-stmth-call* (make-mutex))

(define (db:with-mutex-for-stmth proc)
  (mutex-lock! *mutex-stmth-call*)
  (let* ((res (proc)))
    (mutex-unlock! *mutex-stmth-call*)
    res))

)