Overview
Comment: | add to server file glob to skip server-kill match |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6569-multi-db |
Files: | files | file ages | folders |
SHA1: |
931d0577a12af2d5eaf49924c42d90fd |
User & Date: | matt on 2021-02-19 22:00:07 |
Other Links: | branch diff | manifest | tags |
Context
2021-02-19
| ||
23:44 | Merged v1.6569-multi-db (which is actually modularization stuff) check-in: d983d860a1 user: matt tags: v1.65-real-new-runs-view | |
22:00 | add to server file glob to skip server-kill match Leaf check-in: 931d0577a1 user: matt tags: v1.6569-multi-db | |
16:31 | Added (declare (uses servermod)) and (import servermod) to fix megatest -cleanup-db check-in: 90ea1e537b user: mmgraham tags: v1.6569-multi-db | |
Changes
Modified servermod.scm from [467961a959] to [6b7ac0b729].
︙ | ︙ | |||
134 135 136 137 138 139 140 | (begin (condition-case (create-directory (conc areapath "/logs") #t) (exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs"))) (exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list. exn=" exn))) (directory-exists? (conc areapath "/logs"))) '())) | | | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | (begin (condition-case (create-directory (conc areapath "/logs") #t) (exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs"))) (exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list. exn=" exn))) (directory-exists? (conc areapath "/logs"))) '())) (let* ((server-logs (glob (conc areapath "/logs/server-[0-9]*.log"))) (num-serv-logs (length server-logs))) (if (null? server-logs) '() (let loop ((hed (car server-logs)) (tal (cdr server-logs)) (res '())) (let* ((mod-time (handle-exceptions |
︙ | ︙ |
Modified tasks.scm from [ae153a5943] to [2d959c8f92].
︙ | ︙ | |||
503 504 505 506 507 508 509 | param-key state-patt action-patt test-patt))))) (define (tasks:find-task-queue-records dbstruct target run-name test-patt state-patt action-patt) ;; (handle-exceptions ;; exn ;; '() ;; (sqlite3:first-row | | | > > > | | | > | | | | 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 | param-key state-patt action-patt test-patt))))) (define (tasks:find-task-queue-records dbstruct target run-name test-patt state-patt action-patt) ;; (handle-exceptions ;; exn ;; '() ;; (sqlite3:first-row (let (;; (db (db:get-db dbstruct)) (res '())) (db:with-db dbstruct #f #t (lambda (db) (sqlite3:for-each-row (lambda (a . b) (set! res (cons (cons a b) res))) db "SELECT id,action,owner,state,target,name,testpatt,keylock,params FROM tasks_queue WHERE target = ? AND name = ? AND state LIKE ? AND action LIKE ? AND testpatt LIKE ?;" target run-name state-patt action-patt test-patt) res)))) ;; ) ;; kill any runner processes (i.e. processes handling -runtests) that match target/runname ;; ;; do a remote call to get the task queue info but do the killing as self here. ;; (define (tasks:kill-runner target run-name testpatt) (let ((records (rmt:tasks-find-task-queue-records target run-name testpatt "running" "run-tests")) |
︙ | ︙ |