@@ -27,11 +27,11 @@ ;; procstr is the name of the procedure to be called as a string (define (rpc-transport:autoremote procstr params) (handle-exceptions exn (begin - (debug:print 1 "Remote failed for " proc " " params) + (debug:print 1 #f "Remote failed for " proc " " params) (apply (eval (string->symbol procstr)) params)) ;; (if *runremote* ;; (apply (eval (string->symbol (conc "remote:" procstr))) params) (apply (eval (string->symbol procstr)) params))) @@ -43,11 +43,11 @@ (set! *run-id* run-id) (if (args:get-arg "-daemonize") (daemon:ize)) (if (server:check-if-running run-id) (begin - (debug:print 0 "INFO: Server for run-id " run-id " already running") + (debug:print 0 #f "INFO: Server for run-id " run-id " already running") (exit 0))) (let loop ((server-id (open-run-close tasks:server-lock-slot tasks:open-db run-id)) (remtries 4)) (if (not server-id) (if (> remtries 0) @@ -55,18 +55,18 @@ (thread-sleep! 2) (loop (open-run-close tasks:server-lock-slot tasks:open-db run-id) (- remtries 1))) (begin ;; since we didn't get the server lock we are going to clean up and bail out - (debug:print-info 2 "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue") + (debug:print-info 2 #f "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue") (open-run-close tasks:server-delete-records-for-this-pid tasks:open-db " rpc-transport:launch"))) (begin (rpc-transport:run (if (args:get-arg "-server")(args:get-arg "-server") "-") run-id server-id) (exit))))) (define (rpc-transport:run hostn run-id server-id) - (debug:print 2 "Attempting to start the rpc server ...") + (debug:print 2 #f "Attempting to start the rpc server ...") ;; (trace rpc:publish-procedure!) (rpc:publish-procedure! 'server:login server:login) (rpc:publish-procedure! 'testing (lambda () "Just testing")) @@ -99,11 +99,11 @@ (set! db *inmemdb*) (open-run-close tasks:server-set-interface-port tasks:open-db server-id ipaddrstr portnum) - (debug:print 0 "Server started on " host:port) + (debug:print 0 #f "Server started on " host:port) ;; (trace rpc:publish-procedure!) ;; (rpc:publish-procedure! 'server:login server:login) ;; (rpc:publish-procedure! 'testing (lambda () "Just testing")) @@ -123,18 +123,18 @@ (thread-sleep! 5) ;; no need to do this very often (let ((numrunning -1)) ;; (db:get-count-tests-running db))) (if (or (> numrunning 0) (> (+ *last-db-access* 60)(current-seconds))) (begin - (debug:print-info 0 "Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*)) + (debug:print-info 0 #f "Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*)) (loop (+ 1 count))) (begin - (debug:print-info 0 "Starting to shutdown the server side") + (debug:print-info 0 #f "Starting to shutdown the server side") (open-run-close tasks:server-delete-record tasks:open-db server-id " rpc-transport:try-start-server stop") (thread-sleep! 10) - (debug:print-info 0 "Max cached queries was " *max-cache-size*) - (debug:print-info 0 "Server shutdown complete. Exiting") + (debug:print-info 0 #f "Max cached queries was " *max-cache-size*) + (debug:print-info 0 #f "Server shutdown complete. Exiting") )))))) (define (rpc-transport:find-free-port-and-open port) (handle-exceptions exn @@ -162,11 +162,11 @@ (exit 1)))))) (define (rpc-transport:client-setup run-id #!key (remtries 10)) (if *runremote* (begin - (debug:print 0 "ERROR: Attempt to connect to server but already connected") + (debug:print 0 #f "ERROR: Attempt to connect to server but already connected") #f) (let* ((host-info (hash-table-ref/default *runremote* run-id #f))) ;; (open-run-close db:get-var #f "SERVER")) (if host-info (let ((iface (car host-info)) (port (cadr host-info)) @@ -178,11 +178,11 @@ (begin (server:try-running run-id) (thread-sleep! 2) (rpc-transport:client-setup run-id (- remtries 1))))) (let* ((server-db-info (open-run-close tasks:get-server tasks:open-db run-id))) - (debug:print-info 0 "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries) + (debug:print-info 0 #f "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries) (if server-db-info (let* ((iface (tasks:hostinfo-get-interface server-db-info)) (port (tasks:hostinfo-get-port server-db-info)) (server-dat (list iface port #f #f #f)) (ping-res ((rpc:procedure 'server:login host port) *toppath*))) @@ -201,26 +201,26 @@ ;; ;; (port (if (and hostinfo (> (length hostdat) 1))(cadr hostdat) #f))) ;; (if (and port ;; (string->number port)) ;; (let ((portn (string->number port))) -;; (debug:print-info 2 "Setting up to connect to host " host ":" port) +;; (debug:print-info 2 #f "Setting up to connect to host " host ":" port) ;; (handle-exceptions ;; exn ;; (begin -;; (debug:print 0 "ERROR: Failed to open a connection to the server at host: " host " port: " port) -;; (debug:print 0 " EXCEPTION: " ((condition-property-accessor 'exn 'message) exn)) +;; (debug:print 0 #f "ERROR: Failed to open a connection to the server at host: " host " port: " port) +;; (debug:print 0 #f " EXCEPTION: " ((condition-property-accessor 'exn 'message) exn)) ;; ;; (open-run-close ;; ;; (lambda (db . param) ;; ;; (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'")) ;; ;; #f) ;; (set! *runremote* #f)) ;; (if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server ;; ((rpc:procedure 'server:login host portn) *toppath*)) ;; (begin -;; (debug:print-info 2 "Logged in and connected to " host ":" port) +;; (debug:print-info 2 #f "Logged in and connected to " host ":" port) ;; (set! *runremote* (vector host portn))) ;; (begin -;; (debug:print-info 2 "Failed to login or connect to " host ":" port) +;; (debug:print-info 2 #f "Failed to login or connect to " host ":" port) ;; (set! *runremote* #f))))) -;; (debug:print-info 2 "no server available"))))) +;; (debug:print-info 2 #f "no server available")))))