95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
-rebuild-db : bring the database schema up to date
-update-meta : update the tests metadata for all tests
-env2file fname : write the environment to fname.csh and fname.sh
-setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-list-servers : list the servers
-repl : start a repl (useful for extending megatest)
Spreadsheet generation
-extract-ods fname.ods : extract an open document spreadsheet from the database
-pathmod path : insert path, i.e. path/runame/itempath/logfile.html
will clear the field if no rundir/testname/itempath/logfile
if it contains forward slashes the path will be converted
|
>
|
|
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
-rebuild-db : bring the database schema up to date
-update-meta : update the tests metadata for all tests
-env2file fname : write the environment to fname.csh and fname.sh
-setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-transport http|zmq : use http or zmq for transport (default is http)
-list-servers : list the servers
-repl : start a repl (useful for extending megatest)
Spreadsheet generation
-extract-ods fname.ods : extract an open document spreadsheet from the database
-pathmod path : insert path, i.e. path/runame/itempath/logfile.html
will clear the field if no rundir/testname/itempath/logfile
if it contains forward slashes the path will be converted
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
":variable"
":value"
":expected"
":tol"
":units"
;; misc
"-server"
"-kill-server"
"-port"
"-extract-ods"
"-pathmod"
"-env2file"
"-setvars"
"-set-state-status"
|
>
|
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
":variable"
":value"
":expected"
":tol"
":units"
;; misc
"-server"
"-transport"
"-kill-server"
"-port"
"-extract-ods"
"-pathmod"
"-env2file"
"-setvars"
"-set-state-status"
|
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
|
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(begin
(debug:print 2 "Launching server...")
(server:launch)))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
(let ((tl (setup-for-run)))
(if tl
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
(fmtstr "~5a~8a~8a~20a~20a~10a~10a~10a~10a\n")
(servers-to-kill '()))
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Interface" "OutPort" "InPort" "LastBeat" "State")
(format #t fmtstr "==" "=====" "===" "====" "=========" "=======" "======" "========" "=====")
(for-each
(lambda (server)
(let* (;; (killinfo (args:get-arg "-kill-server"))
;; (khost-port (if killinfo (if (substring-index ":" killinfo)(string-split ":") #f) #f))
;; (kpid (if killinfo (if (substring-index ":" killinfo) #f (string->number killinfo)) #f))
(id (vector-ref server 0))
(pid (vector-ref server 1))
(hostname (vector-ref server 2))
(interface (vector-ref server 3))
(pullport (vector-ref server 4))
(pubport (vector-ref server 5))
(start-time (vector-ref server 6))
(priority (vector-ref server 7))
(state (vector-ref server 8))
(mt-ver (vector-ref server 9))
(last-update (vector-ref server 10)) ;; (open-run-close tasks:server-alive? tasks:open-db #f hostname: hostname port: port))
(killed #f)
(status (< last-update 20)))
;; (zmq-sockets (if status (server:client-connect hostname port) #f)))
;; no need to login as status of #t indicates we are connecting to correct
;; server
(if (equal? state "dead")
(if (> last-update (* 25 60 60)) ;; keep records around for slighly over a day.
(open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid action: 'delete))
(if (> last-update 20) ;; Mark as dead if not updated in last 20 seconds
(open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid)))
(format #t fmtstr id mt-ver pid hostname interface pullport pubport last-update
(if status "alive" "dead"))))
servers)
(debug:print-info 1 "Done with listservers")
(set! *didsomething* #t)
(exit) ;; must do, would have to add checks to many/all calls below
)
(exit)))
;; if not list or kill then start a client (if appropriate)
|
|
|
|
|
|
|
>
|
|
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
|
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(let ((transport (args:get-arg "-transport" 'http)))
(debug:print 2 "Launching server using transport " transport)
(server:launch transport)))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
(let ((tl (setup-for-run)))
(if tl
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
(fmtstr "~5a~8a~8a~20a~20a~10a~10a~10a~10a~10a\n")
(servers-to-kill '()))
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Interface" "OutPort" "InPort" "LastBeat" "State" "Transport")
(format #t fmtstr "==" "=====" "===" "====" "=========" "=======" "======" "========" "=====" "=========")
(for-each
(lambda (server)
(let* (;; (killinfo (args:get-arg "-kill-server"))
;; (khost-port (if killinfo (if (substring-index ":" killinfo)(string-split ":") #f) #f))
;; (kpid (if killinfo (if (substring-index ":" killinfo) #f (string->number killinfo)) #f))
(id (vector-ref server 0))
(pid (vector-ref server 1))
(hostname (vector-ref server 2))
(interface (vector-ref server 3))
(pullport (vector-ref server 4))
(pubport (vector-ref server 5))
(start-time (vector-ref server 6))
(priority (vector-ref server 7))
(state (vector-ref server 8))
(mt-ver (vector-ref server 9))
(last-update (vector-ref server 10)) ;; (open-run-close tasks:server-alive? tasks:open-db #f hostname: hostname port: port))
(transport (vector-ref server 11))
(killed #f)
(status (< last-update 20)))
;; (zmq-sockets (if status (server:client-connect hostname port) #f)))
;; no need to login as status of #t indicates we are connecting to correct
;; server
(if (equal? state "dead")
(if (> last-update (* 25 60 60)) ;; keep records around for slighly over a day.
(open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid action: 'delete))
(if (> last-update 20) ;; Mark as dead if not updated in last 20 seconds
(open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid)))
(format #t fmtstr id mt-ver pid hostname interface pullport pubport last-update
(if status "alive" "dead") transport)))
servers)
(debug:print-info 1 "Done with listservers")
(set! *didsomething* #t)
(exit) ;; must do, would have to add checks to many/all calls below
)
(exit)))
;; if not list or kill then start a client (if appropriate)
|