46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
;; (declare (uses daemon))
(declare (uses db))
;; (declare (uses dcommon))
(declare (uses commonmod))
(import commonmod)
(declare (uses rmtmod))
(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
|
>
>
>
|
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
;; (declare (uses daemon))
(declare (uses db))
;; (declare (uses dcommon))
(declare (uses commonmod))
(import commonmod)
(declare (uses rmtmod))
(import rmtmod)
(declare (uses dbmod))
(import dbmod)
(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
|
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
(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))))
;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
(handle-exceptions
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
|
(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))))
;; this is a good place to populate the *functions* hash with
;; functions needed during the transition to modules
;;
;; NOTE: the definition in dbmod seems to "win" - make it available everywhere
;;
(set! *functions* dbmod#*functions*)
(set! apimod#*functions* dbmod#*functions*)
(set! configfmod#*functions* dbmod#*functions*)
(set-fn 'client:setup client:setup)
(set-fn 'db:setup db:setup)
(set-fn 'server:expiration-timeout server:expiration-timeout)
(set-fn 'common:get-homehost common:get-homehost)
(set-fn 'server:check-if-running server:check-if-running)
(set-fn 'api:execute-requests api:execute-requests)
(set-fn 'http-transport:close-connections http-transport:close-connections )
(set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive)
(set-fn 'server:kind-run server:kind-run)
(set-fn 'server:start-and-wait server:start-and-wait)
(set-fn 'server:check-if-running server:check-if-running)
(set-fn 'server:ping server:ping )
(set-fn 'common:force-server? common:force-server? )
;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
(handle-exceptions
|