Overview
Comment: | Recovered couple lost edits. Switch default to -old for dispatcher |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-revolution-alt-dispatch |
Files: | files | file ages | folders |
SHA1: |
e908cda9c3844ba7ee9e8397f568a5a2 |
User & Date: | mrwellan on 2024-01-29 12:43:59 |
Other Links: | branch diff | manifest | tags |
Context
2024-01-29
| ||
13:01 | Merged in alt-dispatch changes check-in: 530b4ded14 user: mrwellan tags: v1.80-revolution | |
12:43 | Recovered couple lost edits. Switch default to -old for dispatcher Leaf check-in: e908cda9c3 user: mrwellan tags: v1.80-revolution-alt-dispatch | |
2024-01-28
| ||
20:17 | queue based handling WIP. Compiles and almost runs. check-in: 06c8fc61e9 user: matt tags: v1.80-revolution-alt-dispatch | |
Changes
Modified api.scm from [5ca8bfa389] to [755af5d3a9].
︙ | ︙ | |||
125 126 127 128 129 130 131 | (assert #f "FATAL: failed to deserialize indat "indat)))))) ;; (set! *api-process-request-count* (- *api-process-request-count* 1)) ;; (serialize payload) (api:unregister-thread (current-thread)) result))) | | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | (assert #f "FATAL: failed to deserialize indat "indat)))))) ;; (set! *api-process-request-count* (- *api-process-request-count* 1)) ;; (serialize payload) (api:unregister-thread (current-thread)) result))) (define api:tcp-dispatch-request-make-handler api:tcp-dispatch-request-make-handler-old) ;; choose -old or -new (define *api-halt-writes* #f) (define (api:dispatch-request dbstruct cmd run-id params) (if (not *no-sync-db*) (db:open-no-sync-db)) (let* ((start-time (current-milliseconds))) |
︙ | ︙ |
Modified megatest.scm from [0b10f3d522] to [f57dc1364c].
︙ | ︙ | |||
975 976 977 978 979 980 981 982 983 984 985 986 987 988 | (tl (launch:setup)) (keys (keys:config-get-fields *configdat*))) (case (rmt:transport-mode) ((tcp) (let* ((timeout (server:expiration-timeout))) (debug:print 0 *default-log-port* "INFO: megatest -server starting on " (get-host-name) " for " dbfname " using tcp method with timeout of "timeout) (tt-server-timeout-param timeout) (thread-start! (make-thread api:print-db-stats "print-db-stats")) (if dbfname (tt:start-server tl #f dbfname api:tcp-dispatch-request-make-handler keys) (begin (debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -db is required.") (exit 1))))) (else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode)))) | > | 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 | (tl (launch:setup)) (keys (keys:config-get-fields *configdat*))) (case (rmt:transport-mode) ((tcp) (let* ((timeout (server:expiration-timeout))) (debug:print 0 *default-log-port* "INFO: megatest -server starting on " (get-host-name) " for " dbfname " using tcp method with timeout of "timeout) (tt-server-timeout-param timeout) (api:queue-processor) (thread-start! (make-thread api:print-db-stats "print-db-stats")) (if dbfname (tt:start-server tl #f dbfname api:tcp-dispatch-request-make-handler keys) (begin (debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -db is required.") (exit 1))))) (else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode)))) |
︙ | ︙ |
Modified rmtmod.scm from [883a743d2f] to [c803418b6e].
︙ | ︙ | |||
198 199 200 201 202 203 204 205 206 | ;; Maintenance ;;====================================================================== (define (rmt:get-toplevels-and-incompletes run-id running-deadtime remotehoststart-deadtime) (rmtmod:send-receive 'get-toplevels-and-incompletes run-id (list run-id running-deadtime remotehoststart-deadtime))) (define (rmt:get-status-from-final-status-file run-dir) (let ((infile (conc run-dir "/.final-status"))) | > > > > | > | | 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | ;; Maintenance ;;====================================================================== (define (rmt:get-toplevels-and-incompletes run-id running-deadtime remotehoststart-deadtime) (rmtmod:send-receive 'get-toplevels-and-incompletes run-id (list run-id running-deadtime remotehoststart-deadtime))) ;; .final-status file is two lines: ;; "state" ;; "status" ;; (define (rmt:get-status-from-final-status-file run-dir) (let ((infile (conc run-dir "/.final-status"))) ;; first verify we are able to read the output file (if (not (file-read-access? infile)) (begin (debug:print 2 *default-log-port* "ERROR: cannot read " infile) (debug:print 2 *default-log-port* "ERROR: run-dir is " run-dir) #f ) (let ((res (with-input-from-file infile read-lines))) (if (null? res) #f res))))) ;; (string-split (car res))))))) <== I would have preferred a single line STATE STATUS without "'s ;; (string-split (car res))))))) ;; DUNNO WHICH IS CORRECT ;; select end_time-now from ;; (select testname,item_path,event_time+run_duration as ;; end_time,strftime('%s','now') as now from tests where state in ;; ('RUNNING','REMOTEHOSTSTART','LAUNCHED')); ;; ;; NOT EASY TO MIGRATE TO db{file,mod} |
︙ | ︙ |
Modified tests.scm from [776a2ca8e7] to [af6a335a09].
︙ | ︙ | |||
1433 1434 1435 1436 1437 1438 1439 | (define (tests:save-final-status run-id test-id) (let* ((test-dat (rmt:get-test-info-by-id run-id test-id)) (out-dir (db:test-get-rundir test-dat)) (status-file (conc out-dir "/.final-status")) ) ;; first verify we are able to write the output file (if (not (file-write-access? out-dir)) | | < | | | > > | | < | 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 | (define (tests:save-final-status run-id test-id) (let* ((test-dat (rmt:get-test-info-by-id run-id test-id)) (out-dir (db:test-get-rundir test-dat)) (status-file (conc out-dir "/.final-status")) ) ;; first verify we are able to write the output file (if (not (file-write-access? out-dir)) (debug:print 0 *default-log-port* "ERROR: cannot write .final-status to " out-dir) (let* ((outp (open-output-file status-file)) (status (db:test-get-status test-dat)) (state (db:test-get-state test-dat))) (with-output-to-port outp (lambda () (print state) ;; printf was putting in ", not sure why but that was a hassle in other contexts (print status))) (close-output-port outp))))) ;; summarize test in to a file test-summary.html in the test directory ;; (define (tests:summarize-test run-id test-id) (let* ((test-dat (rmt:get-test-info-by-id run-id test-id)) (out-dir (db:test-get-rundir test-dat)) (out-file (conc out-dir "/test-summary.html"))) |
︙ | ︙ |