366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
;; 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-logfile (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)
|
<
>
>
|
>
>
>
|
>
|
|
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
|
;; 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
;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
(define (open-logfile logpath)
(condition-case
(let* ((log-dir (or (pathname-directory logpath) ".")))
(if (not (directory-exists? log-dir))
(system (conc "mkdir -p " log-dir)))
(open-output-file logpath))
(exn ()
(debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath)
(define *didsomething* #t)
(exit 1))))
(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-log 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)
|
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
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
|
(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
;; ))))))
|
<
<
|
|
>
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
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
;;======================================================================
;; 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))
|