Overview
| Comment: | Improved auto start server message, bumped other server releated noise to level 2 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.55 |
| Files: | files | file ages | folders |
| SHA1: |
4a5256913c0b5915529ef108209c70d9 |
| User & Date: | matt on 2013-08-05 09:16:11 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-08-05
| ||
| 10:41 | Tweak to deal with possible race condition in post handling of state/status in managing processes in launch check-in: d54079768e user: mrwellan tags: v1.55 | |
| 09:16 | Improved auto start server message, bumped other server releated noise to level 2 check-in: 4a5256913c user: matt tags: v1.55 | |
| 00:19 | Made all stages respect the same hierarchy in setting transport. If -runtests uses http, so should test internal calls check-in: d42aaaab5b user: matt tags: v1.55 | |
Changes
Modified megatest.scm from [eaedd380e0] to [7c0eaf00e3].
| ︙ | ︙ | |||
341 342 343 344 345 346 347 | (getenv "MT_CMDINFO"))))))) (if res (cadr res) #f)) #f)) (chosen-transport (string->symbol (or transport-from-cmdln transport-from-cmdinfo transport-from-config "fs")))) | | | 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 | (getenv "MT_CMDINFO"))))))) (if res (cadr res) #f)) #f)) (chosen-transport (string->symbol (or transport-from-cmdln transport-from-cmdinfo transport-from-config "fs")))) (debug:print 2 "chosen-transport: " chosen-transport " have; config=" transport-from-config ", cmdln=" transport-from-cmdln ", cmdinfo=" transport-from-cmdinfo) (case chosen-transport ((http) (set! *transport-type 'http) (server:ensure-running) (client:launch)) (else ;; (fs) (set! *transport-type* 'fs) |
| ︙ | ︙ |
Modified server.scm from [b6cfd8a4e3] to [9e4ffe8744].
| ︙ | ︙ | |||
122 123 124 125 126 127 128 |
(define (server:ensure-running)
(let loop ((servers (open-run-close tasks:get-best-server tasks:open-db))
(trycount 0))
(if (or (not servers)
(null? servers))
(begin
(if (even? trycount) ;; just do the server start every other time through this loop (every 8 seconds)
| | > | | < < < < < | | 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 |
(define (server:ensure-running)
(let loop ((servers (open-run-close tasks:get-best-server tasks:open-db))
(trycount 0))
(if (or (not servers)
(null? servers))
(begin
(if (even? trycount) ;; just do the server start every other time through this loop (every 8 seconds)
(let ((cmdln (conc (if (getenv "MT_MEGATEST") (getenv "MT_MEGATEST") "megatest")
" -server - -daemonize")))
(debug:print 0 "INFO: Starting server (" cmdln ") as none running ...")
;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
;; no need to use fork, no need to do the list-servers trick. Just start the damn server, it will exit on it's own
;; if there is an existing server
(system cmdln)
(thread-sleep! 3)
;; (process-run (car (argv)) (list "-server" "-" "-daemonize" "-transport" (args:get-arg "-transport" "http")))
)
(begin
(debug:print-info 0 "Waiting for server to start")
(thread-sleep! 4)))
(if (< trycount 10)
(loop (open-run-close tasks:get-best-server tasks:open-db)
(+ trycount 1))
(debug:print 0 "WARNING: Couldn't start or find a server.")))
(debug:print 2 "INFO: Server(s) running " servers)
)))
|