| ︙ | | | ︙ | |
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
|
x
" => "))
(common:get-disks) )
"\n"))
(set! *didsomething* #t)))
(if (args:get-arg "-ping")
(let* ((run-id (string->number (args:get-arg "-run-id")))
(host-port (let ((slst (string-split (args:get-arg "-ping") ":")))
(if (eq? (length slst) 2)
(list (car slst)(string->number (cadr slst)))
#f)))
(toppath (setup-for-run)))
(if (not run-id)
(begin
(debug:print 0 "ERROR: must specify run-id when doing ping, -run-id n")
(print "ERROR: No run-id")
(exit 1))
(if (not host-port)
(begin
(debug:print 0 "ERROR: argument to -ping is host:port, got " (args:get-arg "-ping"))
(let* ((server-dat (http-transport:client-connect (car host-port)(cadr host-port)))
(login-res (rmt:login-no-auto-client-setup server-dat run-id)))
(if (and (list? login-res)
(car login-res))
(begin
(print "LOGIN_OK")
(exit 0))
(begin
|
|
|
|
|
|
|
>
|
>
<
>
>
|
|
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
x
" => "))
(common:get-disks) )
"\n"))
(set! *didsomething* #t)))
(if (args:get-arg "-ping")
(let* ((run-id (string->number (args:get-arg "-run-id")))
(host-port (let ((slst (string-split (args:get-arg "-ping") ":")))
(if (eq? (length slst) 2)
(list (car slst)(string->number (cadr slst)))
#f)))
(toppath (setup-for-run))
(server-db-dat (if (not host-port)(open-run-close tasks:get-server tasks:open-db run-id) #f)))
(if (not run-id)
(begin
(debug:print 0 "ERROR: must specify run-id when doing ping, -run-id n")
(print "ERROR: No run-id")
(exit 1))
(if (and (not host-port)
(not server-db-dat))
(begin
(print "ERROR: bad host:port")
(exit 1))
(let* ((iface (if host-port (car host-port) (tasks:hostinfo-get-interface server-db-dat)))
(port (if host-port (cadr host-port)(tasks:hostinfo-get-port server-db-dat)))
(server-dat (http-transport:client-connect iface port))
(login-res (rmt:login-no-auto-client-setup server-dat run-id)))
(if (and (list? login-res)
(car login-res))
(begin
(print "LOGIN_OK")
(exit 0))
(begin
|
| ︙ | | | ︙ | |
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
|
;;======================================================================
;; Get test paths matching target, runname, and testpatt
(if (or (args:get-arg "-test-files")(args:get-arg "-test-paths"))
;; if we are in a test use the MT_CMDINFO data
(if (getenv "MT_CMDINFO")
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
;; (runremote (assoc/default 'runremote cmdinfo))
|
<
|
798
799
800
801
802
803
804
805
806
807
808
809
810
811
|
;;======================================================================
;; Get test paths matching target, runname, and testpatt
(if (or (args:get-arg "-test-files")(args:get-arg "-test-paths"))
;; if we are in a test use the MT_CMDINFO data
(if (getenv "MT_CMDINFO")
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
(testpath (assoc/default 'testpath cmdinfo))
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(db-host (assoc/default 'db-host cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(state (args:get-arg ":state"))
|
| ︙ | | | ︙ | |
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
|
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
;; if we are in a test use the MT_CMDINFO data
(if (getenv "MT_CMDINFO")
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
;; (runremote (assoc/default 'runremote cmdinfo))
|
<
|
845
846
847
848
849
850
851
852
853
854
855
856
857
858
|
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
;; if we are in a test use the MT_CMDINFO data
(if (getenv "MT_CMDINFO")
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
(testpath (assoc/default 'testpath cmdinfo))
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(db-host (assoc/default 'db-host cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(state (args:get-arg ":state"))
|
| ︙ | | | ︙ | |
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
|
(define (megatest:step step state status logfile msg)
(if (not (getenv "MT_CMDINFO"))
(begin
(debug:print 0 "ERROR: MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!")
(exit 5))
(let* ((cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
;; (runremote (assoc/default 'runremote cmdinfo))
|
<
|
923
924
925
926
927
928
929
930
931
932
933
934
935
936
|
(define (megatest:step step state status logfile msg)
(if (not (getenv "MT_CMDINFO"))
(begin
(debug:print 0 "ERROR: MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!")
(exit 5))
(let* ((cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
(testpath (assoc/default 'testpath cmdinfo))
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(db-host (assoc/default 'db-host cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(test-id (assoc/default 'test-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
|
| ︙ | | | ︙ | |
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
|
(args:get-arg "-summarize-items"))
(if (not (getenv "MT_CMDINFO"))
(begin
(debug:print 0 "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!")
(exit 5))
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
;; (runremote (assoc/default 'runremote cmdinfo))
|
<
|
969
970
971
972
973
974
975
976
977
978
979
980
981
982
|
(args:get-arg "-summarize-items"))
(if (not (getenv "MT_CMDINFO"))
(begin
(debug:print 0 "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!")
(exit 5))
(let* ((startingdir (current-directory))
(cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
(testpath (assoc/default 'testpath cmdinfo))
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(db-host (assoc/default 'db-host cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(test-id (assoc/default 'test-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
|
| ︙ | | | ︙ | |