︙ | | |
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
|
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
|
-
+
|
(hash-table-keys args:arg-hash)
'("-list-servers"
"-stop-server"
"-show-cmdinfo"
"-list-runs")))
(if (setup-for-run)
(begin
(set! *fdb* (filedb:open-db (conc *toppath* "/db/paths.db")))
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
;; ok, so lets connect to the server
(let* ((transport-from-config (configf:lookup *configdat* "setup" "transport"))
(transport-from-cmdln (args:get-arg "-transport"))
|
︙ | | |
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
|
382
383
384
385
386
387
388
389
390
391
392
393
394
395
|
-
-
|
"fs"))))
(debug:print 2 "chosen-transport: " chosen-transport " have; config=" transport-from-config ", cmdln=" transport-from-cmdln ", cmdinfo=" transport-from-cmdinfo)
(case chosen-transport
((http)
(set! *transport-type 'http)
(server:ensure-running)
;; Get rid of this
(set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
(set! *fdb* (filedb:open-db (conc *toppath* "/db/paths.db")))
(client:launch))
(else ;; (fs)
(debug:print 0 "ERROR: Should NOT be getting here! fs transport is no longer supported")
(set! *transport-type* 'fs)
(set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))
|
︙ | | |
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
|
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
|
+
-
+
|
(if (not (or (equal? (db:test-get-status test) "PASS")
(equal? (db:test-get-status test) "WARN")
(equal? (db:test-get-state test) "NOT_STARTED")))
(begin
(print " cpuload: " (db:test-get-cpuload test)
"\n diskfree: " (db:test-get-diskfree test)
"\n uname: " (sdb:qry 'getstr (db:test-get-uname test))
"\n rundir: " (sdb:qry 'getstr ;; (filedb:get-path *fdb*
"\n rundir: " (filedb:get-path *fdb* (db:test-get-rundir test))
(db:test-get-rundir test))
)
;; Each test
;; DO NOT remote run
(let ((steps (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
(for-each
(lambda (step)
(format #t
|
︙ | | |
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
|
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
|
-
+
|
;; this is the socket if we are a client
;; (if (and *runremote*
;; (socket? *runremote*))
;; (close-socket *runremote*))
(if sdb:qry (sdb:qry 'finalize #f))
(if *fdb* (filedb:finalize-db! *fdb*))
;; (if *fdb* (filedb:finalize-db! *fdb*))
(if (not *didsomething*)
(debug:print 0 help))
;; (if *runremote* (rpc:close-all-connections!))
(if (not (eq? *globalexitstatus* 0))
|
︙ | | |