Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -1,7 +1,7 @@ -;;====================================================================== -;; Copyright 2006-2013, Matthew Welland. + +;; Copyright 2006-2016, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the @@ -166,43 +166,33 @@ (debug:print-error 0 *default-log-port* "(3) Transport [" transport-type "] specified for run-id [" run-id "] is not implemented in rmt:send-receive. Cannot proceed.") #f))))) - ;; no connection info; try to start a server, or access locally if no - ;; server and the query is read-only + ;; no connection info; try to start a server ;; ;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call ;; - (if (and (< attemptnum 15) - (member cmd api:write-queries)) - (let* ((faststart (configf:lookup *configdat* "server" "faststart"))) - (hash-table-delete! *runremote* run-id) - ;; (mutex-unlock! *send-receive-mutex*) - (if (and faststart (equal? faststart "no")) - (begin - (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10) - (thread-sleep! (random 5)) ;; give some time to settle and minimize collison? - (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1))) - (let ((start-time (current-milliseconds)) - (max-query (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") - "300"))) - (newres (rmt:open-qry-close-locally cmd run-id params))) - (let ((delta (- (current-milliseconds) start-time))) - (if (> delta max-query) - (begin - (debug:print-info 0 *default-log-port* "Starting server as query time " delta " is over the limit of " max-query) - (server:kind-run run-id))) - ;; return the result! - newres) - ))) - (begin - ;; (debug:print-error 0 *default-log-port* "Communication failed!") - ;; (mutex-unlock! *send-receive-mutex*) - ;; (exit) - (rmt:open-qry-close-locally cmd run-id params) - ))))) + (let* ((faststart (configf:lookup *configdat* "server" "faststart"))) + (hash-table-delete! *runremote* run-id) + ;; (mutex-unlock! *send-receive-mutex*) + (if (and faststart (equal? faststart "no")) + (begin + (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10) + (thread-sleep! (random 5)) ;; give some time to settle and minimize collison? + (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1))) + (let ((start-time (current-milliseconds)) + (max-query (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") + "300"))) + (newres (rmt:open-qry-close-locally cmd run-id params))) + (let ((delta (- (current-milliseconds) start-time))) + (if (> delta max-query) + (begin + (debug:print-info 0 *default-log-port* "Starting server as query time " delta " is over the limit of " max-query) + (server:kind-run run-id))) + ;; return the result! + newres))))))) (define (rmt:update-db-stats run-id rawcmd params duration) (mutex-lock! *db-stats-mutex*) (handle-exceptions exn Index: rpc-transport.scm ================================================================== --- rpc-transport.scm +++ rpc-transport.scm @@ -1,7 +1,7 @@ -;; Copyright 2006-2012, Matthew Welland. +;; Copyright 2006-2016, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the @@ -189,16 +189,16 @@ ;; start_server? ;; (define (rpc-transport:launch run-id) (set! *run-id* run-id) - ;; send to background if requested - (when (args:get-arg "-daemonize") - (daemon:ize) - (when *alt-log-file* ;; we should re-connect to this port, I think daemon:ize disrupts it - (current-error-port *alt-log-file*) - (current-output-port *alt-log-file*))) + ;; ;; send to background if requested + ;; (when (args:get-arg "-daemonize") + ;; (daemon:ize) + ;; (when *alt-log-file* ;; we should re-connect to this port, I think daemon:ize disrupts it + ;; (current-error-port *alt-log-file*) + ;; (current-output-port *alt-log-file*))) ;; double check we dont alrady have a running server for this run-id (when (server:check-if-running run-id) (debug:print 0 *default-log-port* "INFO: Server for run-id " run-id " already running") (exit 0)) Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -1,7 +1,7 @@ -;; Copyright 2006-2012, Matthew Welland. +;; Copyright 2006-2016, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the @@ -117,14 +117,13 @@ (curr-ip (server:get-best-guess-address curr-host)) (target-host (configf:lookup *configdat* "server" "homehost" )) (testsuite (common:get-testsuite-name)) (logfile (conc *toppath* "/logs/" run-id ".log")) (cmdln (conc (common:get-megatest-exe) - " -server " (or target-host "-") " -run-id " run-id (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes") - (conc " -daemonize -log " logfile) - "") - " -m testsuite:" testsuite))) ;; (conc " >> " logfile " 2>&1 &"))))) + " -server " (or target-host "-") + " -run-id " run-id " -log " logfile + " -m testsuite:" testsuite))) (debug:print 0 *default-log-port* "INFO: Starting server (" cmdln ") as none running ...") (push-directory *toppath*) (if (not (directory-exists? "logs"))(create-directory "logs")) ;; Rotate logs, logic: