649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
|
;; Server? Start up here.
;;
(let ((tl (launch:setup-for-run *area-dat*))
(run-id (and (args:get-arg "-run-id")
(string->number (args:get-arg "-run-id")))))
(if run-id
(begin
(server:launch run-id)
(set! *didsomething* #t))
(debug:print 0 "ERROR: server requires run-id be specified with -run-id")))
;; Not a server? This section will decide how to communicate
;;
;; Setup client for all expect listed here
(if (null? (lset-intersection
|
|
|
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
|
;; Server? Start up here.
;;
(let ((tl (launch:setup-for-run *area-dat*))
(run-id (and (args:get-arg "-run-id")
(string->number (args:get-arg "-run-id")))))
(if run-id
(begin
(server:launch run-id *area-dat*)
(set! *didsomething* #t))
(debug:print 0 "ERROR: server requires run-id be specified with -run-id")))
;; Not a server? This section will decide how to communicate
;;
;; Setup client for all expect listed here
(if (null? (lset-intersection
|
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
|
;; MAY STILL NEED THIS
;; (set! *megatest-db* (make-dbr:dbstruct path: toppath local: #t))))))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
(let ((tl (launch:setup-for-run *area-dat*)))
(if tl
(let* ((tdbdat (tasks:open-db))
(servers (tasks:get-all-servers (db:delay-if-busy tdbdat)))
(fmtstr "~5a~12a~8a~20a~24a~10a~10a~10a~10a\n")
(servers-to-kill '())
(killinfo (args:get-arg "-stop-server"))
(khost-port (if killinfo (if (substring-index ":" killinfo)(string-split ":") #f) #f))
(sid (if killinfo (if (substring-index ":" killinfo) #f (string->number killinfo)) #f)))
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Interface:OutPort" "InPort" "LastBeat" "State" "Transport")
|
|
|
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
|
;; MAY STILL NEED THIS
;; (set! *megatest-db* (make-dbr:dbstruct path: toppath local: #t))))))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
(let ((tl (launch:setup-for-run *area-dat*)))
(if tl
(let* ((tdbdat (tasks:open-db *area-dat*))
(servers (tasks:get-all-servers (db:delay-if-busy tdbdat)))
(fmtstr "~5a~12a~8a~20a~24a~10a~10a~10a~10a\n")
(servers-to-kill '())
(killinfo (args:get-arg "-stop-server"))
(khost-port (if killinfo (if (substring-index ":" killinfo)(string-split ":") #f) #f))
(sid (if killinfo (if (substring-index ":" killinfo) #f (string->number killinfo)) #f)))
(format #t fmtstr "Id" "MTver" "Pid" "Host" "Interface:OutPort" "InPort" "LastBeat" "State" "Transport")
|
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
|
"-runtests"
"run a test"
(lambda (target runname keys keyvals)
;;
;; May or may not implement it this way ...
;;
;; Insert this run into the tasks queue
;; (open-run-close tasks:add tasks:open-db
;; "runtests"
;; user
;; target
;; runname
;; (args:get-arg "-runtests")
;; #f))))
(runs:run-tests target
|
|
|
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
|
"-runtests"
"run a test"
(lambda (target runname keys keyvals)
;;
;; May or may not implement it this way ...
;;
;; Insert this run into the tasks queue
;; (open-run-close tasks:add (lambda ()(tasks:open-db *area-dat*))
;; "runtests"
;; user
;; target
;; runname
;; (args:get-arg "-runtests")
;; #f))))
(runs:run-tests target
|