350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
|
;; The watchdog is to keep an eye on things like db sync etc.
;;
(define *watchdog* (make-thread common:watchdog "Watchdog thread"))
(if (not (args:get-arg "-server"))
(thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog
;;(BB> "thread-start! watchdog")
(if (args:get-arg "-log")
(let ((oup (open-output-file (args:get-arg "-log"))))
(debug:print-info 0 *default-log-port* "Sending log output to " (args:get-arg "-log"))
(set! *default-log-port* oup)))
(if (or (args:get-arg "-h")
(args:get-arg "-help")
(args:get-arg "--help"))
(begin
(print help)
|
<
>
|
>
>
>
|
>
|
|
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
|
;; The watchdog is to keep an eye on things like db sync etc.
;;
(define *watchdog* (make-thread common:watchdog "Watchdog thread"))
(if (not (args:get-arg "-server"))
(thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
(let* ((tl (or (args:get-arg "-log")(launch:setup))) ;; run launch:setup if -server
(logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
(conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
(oup (open-output-file logf)))
(if (not (args:get-arg "-log"))
(hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
(debug:print-info 0 *default-log-port* "Sending log output to " logf)
(set! *default-log-port* oup)))
(if (or (args:get-arg "-h")
(args:get-arg "-help")
(args:get-arg "--help"))
(begin
(print help)
|
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
744
745
746
747
748
749
750
|
(debug:print-error 0 *default-log-port* "Parameter to -envdelta should be new=star-end")))))
;;======================================================================
;; 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")
;; Server? Start up here.
;;
;; (run-id (and (args:get-arg "-run-id")
;; (string->number (args:get-arg "-run-id"))))
;; (if run-id
;; (begin
;; ;; (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
;; ))))))
|
<
<
|
|
>
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
|
(debug:print-error 0 *default-log-port* "Parameter to -envdelta should be new=star-end")))))
;;======================================================================
;; 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
;;======================================================================
;; Server? Start up here.
;;
(if (args:get-arg "-server")
(let ((tl (launch:setup))
(transport-type (string->symbol (or (args:get-arg "-transport") "http"))))
(server:launch 0 transport-type)
(set! *didsomething* #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))
|