Megatest

Changes On Branch 169e4f3073a5164d
Login

Changes In Branch v1.80-processes Through [169e4f3073] Excluding Merge-Ins

This is equivalent to a diff from 72065b6c5e to 169e4f3073

2023-10-06
16:56
Fixed dbmod:attach-sync so that it works for the non-id rows. Adjusted some log messages. Removed old lock files check-in: 1e29e5e90e user: mmgraham tags: v1.80
2023-10-02
19:56
fixed uses in dbfile check-in: 119cfc1040 user: mrwellan tags: v1.80-processes
07:00
Process registration now working check-in: 169e4f3073 user: matt tags: v1.80-processes
06:19
Fixed schema typo check-in: 4ce89b978d user: matt tags: v1.80-processes
2023-09-29
08:17
Merged fork check-in: 35feb6b8db user: mrwellan tags: v1.80-processes
2023-09-25
19:04
Added sync file age checking to -db2db check-in: 72065b6c5e user: mmgraham tags: v1.80
19:02
Corrected 20 second age check for sync lock file. Added exception handler for a sqlite3:with-transaction. check-in: 8f8169ac4d user: mmgraham tags: v1.80

Modified api.scm from [c477d1f287] to [5fa313076b].

401
402
403
404
405
406
407






408
409
410
411
412
413
414
    ((tasks-get-last)            (apply tasks:get-last dbstruct params))

    ;; NO SYNC DB
    ((no-sync-set)               (apply db:no-sync-set         *no-sync-db* params))
    ((no-sync-get/default)       (apply db:no-sync-get/default *no-sync-db* params))
    ((no-sync-del!)              (apply db:no-sync-del!        *no-sync-db* params))
    ((no-sync-get-lock)          (apply db:no-sync-get-lock    *no-sync-db* params))






    
    ;; ARCHIVES
    ;; ((archive-get-allocations)   
    ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
    ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
    ;; ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))








>
>
>
>
>
>







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
    ((tasks-get-last)            (apply tasks:get-last dbstruct params))

    ;; NO SYNC DB
    ((no-sync-set)               (apply db:no-sync-set         *no-sync-db* params))
    ((no-sync-get/default)       (apply db:no-sync-get/default *no-sync-db* params))
    ((no-sync-del!)              (apply db:no-sync-del!        *no-sync-db* params))
    ((no-sync-get-lock)          (apply db:no-sync-get-lock    *no-sync-db* params))

    ;; NO SYNC DB PROCESSES
    ((register-process)          (apply dbfile:register-process *no-sync-db* params))
    ((set-process-done)          (apply dbfile:set-process-done *no-sync-db* params))
    ((set-process-status)        (apply dbfile:set-process-status *no-sync-db* params))
    ((get-process-options)       (apply dbfile:get-process-options *no-sync-db* params))
    
    ;; ARCHIVES
    ;; ((archive-get-allocations)   
    ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
    ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
    ;; ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))

Modified dbfile.scm from [1a2e6b4c5e] to [24616e6fd1].

463
464
465
466
467
468
469
470














471
472
473
474
475
476
477
478
479
480
481
482




























483
484
485
486
487
488
489
			    "CREATE TABLE IF NOT EXISTS no_sync_metadat
                                (var TEXT,
                                 val TEXT,
                                   CONSTRAINT no_sync_metadat_constraint UNIQUE (var));"
			    "CREATE TABLE IF NOT EXISTS no_sync_locks 
                                (key TEXT,
                                 val TEXT,
                                   CONSTRAINT no_sync_metadat_constraint UNIQUE (key));"))))))














	 (on-tmp      (equal? (car (string-split dbpath "/")) "tmp"))
	 (db        (if on-tmp
			(dbfile:cautious-open-database dbname init-proc 0 "WAL")
			(dbfile:cautious-open-database dbname init-proc 0 #f)
			;; (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))





























(define (dbfile:with-no-sync-db dbpath proc)
  (mutex-lock! *no-sync-db-mutex*)
  (let* ((already-open *no-sync-db*)
	 (db  (or already-open (dbfile:raw-open-no-sync-db dbpath)))
	 (res (proc db)))
    (if (not already-open)
	(sqlite3:finalize! db))







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
			    "CREATE TABLE IF NOT EXISTS no_sync_metadat
                                (var TEXT,
                                 val TEXT,
                                   CONSTRAINT no_sync_metadat_constraint UNIQUE (var));"
			    "CREATE TABLE IF NOT EXISTS no_sync_locks 
                                (key TEXT,
                                 val TEXT,
                                   CONSTRAINT no_sync_metadat_constraint UNIQUE (key));"
			    "CREATE TABLE IF NOT EXISTS processes
                                (id INTEGER PRIMARY KEY,
                                 host TEXT,
                                 port INTEGER,
                                 pid INTEGER,
                                 starttime INTEGER,
                                 endtime INTEGER,
                                 status TEXT,
                                 purpose TEXT,
                                 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")
			(dbfile:cautious-open-database dbname init-proc 0 #f)
			;; (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))

;; processes table calls

(define (dbfile:register-process nsdb host port pid starttime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?);"
		   host port pid starttime status purpose dbname mtversion))

(define (dbfile:set-process-status nsdb host pid newstatus)
  (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid))

(define (dbfile:get-process-options nsdb purpose dbname)
  (sqlite3:fold-row
   ;; host port pid starttime status mtversion
   (lambda (res . row)
     (cons row res))
   '()
   nsdb
   "SELECT host,port,pid,starttime,status,mtversion FROM processes WHERE purpose=? AND dbname LIKE ? AND status='alive';"
   purpose dbname))

(define (dbfile:set-process-done nsdb host pid reason)
  (sqlite3:execute nsdb "UPDATE processes SET status='ended',endtime=?,reason=? WHERE host=? AND pid=?;" (current-seconds) reason host pid)
  (dbfile:cleanup-old-entries nsdb))

(define (dbfile:cleanup-old-entries nsdb)
  (sqlite3:execute nsdb "DELETE FROM process WHERE status='ended' AND endtime<?;" (- (current-seconds) (* 3600 48))))

;; other no-sync functions

(define (dbfile:with-no-sync-db dbpath proc)
  (mutex-lock! *no-sync-db-mutex*)
  (let* ((already-open *no-sync-db*)
	 (db  (or already-open (dbfile:raw-open-no-sync-db dbpath)))
	 (res (proc db)))
    (if (not already-open)
	(sqlite3:finalize! db))

Modified rmt.scm from [6ddef022d0] to [64f3d622e8].

724
725
726
727
728
729
730














731
732
733
734
735
736
737

(define (rmt:no-sync-del! var)
  (rmt:send-receive 'no-sync-del! #f `(,var)))

(define (rmt:no-sync-get-lock keyname)
  (rmt:send-receive 'no-sync-get-lock #f `(,keyname)))















;;======================================================================
;; A R C H I V E S
;;======================================================================

(define (rmt:archive-get-allocations  testname itempath dneeded)
  (rmt:send-receive 'archive-get-allocations #f (list testname itempath dneeded)))








>
>
>
>
>
>
>
>
>
>
>
>
>
>







724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751

(define (rmt:no-sync-del! var)
  (rmt:send-receive 'no-sync-del! #f `(,var)))

(define (rmt:no-sync-get-lock keyname)
  (rmt:send-receive 'no-sync-get-lock #f `(,keyname)))

;; process registration

(define (rmt:register-process host port pid starttime status purpose dbname mtversion)
  (rmt:send-receive 'register-process #f (list host port pid starttime status purpose dbname mtversion)))

(define (rmt:set-process-done host pid reason)
  (rmt:send-receive 'set-process-done #f (list host pid reason)))

(define (rmt:set-process-status host pid newstatus)
  (rmt:send-receive 'set-process-status #f (list host pid newstatus)))

(define (rmt:get-process-options purpose dbname)
  (rmt:get-process-options 'get-process-options #f (list purpose dbname)))

;;======================================================================
;; A R C H I V E S
;;======================================================================

(define (rmt:archive-get-allocations  testname itempath dneeded)
  (rmt:send-receive 'archive-get-allocations #f (list testname itempath dneeded)))