Megatest

Check-in [931d0577a1]
Login
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: 931d0577a12af2d5eaf49924c42d90fd9274bdde
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
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-*.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







|







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
510
511



512
513
514

515
516
517
518
519
520
521
522
523
524
525
526
			 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 '()))



    (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"))







|
|
>
>
>
|
|
|
>
|


|
|







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