Overview
| Comment: | daemonization of server |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | daemon-server |
| Files: | files | file ages | folders |
| SHA1: |
7ba11ef21174413a2abcd55d75fde78a |
| User & Date: | mrwellan on 2012-12-12 21:25:54 |
| Other Links: | branch diff | manifest | tags |
Context
|
2012-12-12
| ||
| 21:25 | daemonization of server Closed-Leaf check-in: 7ba11ef211 user: mrwellan tags: daemon-server | |
| 21:25 | Fix for multiple return values from -test-paths check-in: 65e65c0318 user: mrwellan tags: trunk | |
Changes
Modified megatest.scm from [d00ef9a849] to [4e3a9f70b8].
| ︙ | ︙ | |||
283 284 285 286 287 288 289 |
;; 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")
(begin
(debug:print 2 "Launching server...")
| > > > > > > > | > > > > > | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 |
;; 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")
(begin
(debug:print 2 "Launching server...")
;; (change-directory "/")
(let ((fd-r (file-open "/dev/null" open/rdonly))
(fd-w (file-open "/dev/null" open/wronly)))
(duplicate-fileno fd-r 0)
(duplicate-fileno fd-w 1)
(file-close fd-r)
(file-close fd-w))
(let ((child-pid (process-fork (lambda ()(server:launch)))))
(if (not (zero? child-pid))
(exit 0)))
(create-session)
(duplicate-fileno 1 2)
(void)))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
(let ((tl (setup-for-run)))
(if tl
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
(fmtstr "~5a~8a~8a~20a~20a~10a~10a~10a~10a\n")
|
| ︙ | ︙ |
Modified server.scm from [2caba19210] to [d7826fbb60].
| ︙ | ︙ | |||
324 325 326 327 328 329 330 | ;; (server:client-setup (- numtries 1)) ;; #f) (server:client-connect iface pullport pubport)) ;; ) (if (> numtries 0) (let ((exe (car (argv))) (pid #f)) (debug:print-info 0 "No server available, attempting to start one...") | | | | | > > > > > > > > > > > > > > > | | 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 | ;; (server:client-setup (- numtries 1)) ;; #f) (server:client-connect iface pullport pubport)) ;; ) (if (> numtries 0) (let ((exe (car (argv))) (pid #f)) (debug:print-info 0 "No server available, attempting to start one...") (set! pid (process-run exe (list "-server" "-" "-debug" (if (list? *verbosity*) (string-intersperse *verbosity* ",") (conc *verbosity*))))) ;; (set! pid (process-fork (lambda () ;; (change-directory "/") ;; (let ((fd-r (file-open "/dev/null" open/rdonly)) ;; (fd-w (file-open "/dev/null" open/wronly))) ;; (duplicate-fileno fd-r 0) ;; (duplicate-fileno fd-w 1) ;; (file-close fd-r) ;; (file-close fd-w)) ;; (let ((child-pid (process-fork (lambda ()(server:launch))))) ;; (if (not (zero? child-pid)) ;; (exit 0))) ;; (create-session) ;; (duplicate-fileno 1 2) ;; (void) ;; ;; child-pid ;; ))) ;; (current-input-port (open-input-file "/dev/null")) ;; (current-output-port (open-output-file "/dev/null")) ;; (current-error-port (open-output-file "/dev/null")) ;; (server:launch)))) ;; should never get here .... (let loop ((count 0)) (let ((hostinfo (open-run-close tasks:get-best-server tasks:open-db))) (if (not hostinfo) (begin (debug:print-info 0 "Waiting for server pid=" pid " to start") (sleep 2) ;; give server time to start (if (< count 5) |
| ︙ | ︙ |