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 | "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, | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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))) |
︙ | ︙ |