695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
|
;;======================================================================
(if (args:get-arg "-server")
;; Server? Start up here.
;;
(let ((tl (launch:setup))
(run-id (and (args:get-arg "-run-id")
(string->number (args:get-arg "-run-id"))))
(transport-type (string->symbol (or (args:get-arg "-transport") "http"))))
(if run-id
(begin
(server:launch run-id transport-type)
(set! *didsomething* #t))
(debug:print-error 0 *default-log-port* "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
equal?
(hash-table-keys args:arg-hash)
'("-list-servers"
"-stop-server"
"-kill-server"
"-show-cmdinfo"
"-list-runs"
"-ping")))
(if (launch:setup)
(let ((run-id (and (args:get-arg "-run-id")
(string->number (args:get-arg "-run-id")))))
;; (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" "-create-megatest-area" "-create-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 *default-log-port* "Server connection not needed")
(begin
;; (if run-id
;; (client:launch run-id)
;; (client:launch 0) ;; without run-id we'll start a server for "0"
#t
))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server")
(args:get-arg "-kill-server"))
(let ((tl (launch:setup)))
(if tl
(let* ((tdbdat (tasks:open-db))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
|
;;======================================================================
(if (args:get-arg "-server")
;; Server? Start up here.
;;
(let ((tl (launch:setup))
;; (run-id (and (args:get-arg "-run-id")
;; (string->number (args:get-arg "-run-id"))))
(transport-type (string->symbol (or (args:get-arg "-transport") "http"))))
;; (if run-id
;; (begin
(server:launch 0 transport-type)
(set! *didsomething* #t)))
;; ;; (debug:print-error 0 *default-log-port* "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
;; equal?
;; (hash-table-keys args:arg-hash)
;; '("-list-servers"
;; "-stop-server"
;; "-kill-server"
;; "-show-cmdinfo"
;; "-list-runs"
;; "-ping")))
;; (if (launch:setup)
;; (let ((run-id (and (args:get-arg "-run-id")
;; (string->number (args:get-arg "-run-id")))))
;; ;; (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" "-create-megatest-area" "-create-test")
;; (eq? (length (hash-table-keys args:arg-hash)) 0))
;; (debug:print-info 1 *default-log-port* "Server connection not needed")
;; (begin
;; ;; (if run-id
;; ;; (client:launch run-id)
;; ;; (client:launch 0) ;; without run-id we'll start a server for "0"
;; #t
;; ))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server")
(args:get-arg "-kill-server"))
(let ((tl (launch:setup)))
(if tl
(let* ((tdbdat (tasks:open-db))
|