Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -22,10 +22,11 @@ (declare (uses common)) (declare (uses db)) (declare (uses tests)) (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running. (declare (uses server)) +(declare (uses daemon)) (include "common_records.scm") (include "db_records.scm") (define (http-transport:make-server-url hostport) @@ -118,11 +119,11 @@ exn (begin (print-error-message exn) (if (< portnum 9000) (begin - (print "WARNING: failed to start on portnum: " portnum ", trying next port") + (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port") (thread-sleep! 0.1) ;; (open-run-close tasks:remove-server-records tasks:open-db) (open-run-close tasks:server-delete tasks:open-db ipaddrstr portnum) (http-transport:try-start-server ipaddrstr (+ portnum 1))) (print "ERROR: Tried and tried but could not start the server"))) @@ -217,17 +218,18 @@ (loop)))))) (iface (car server-info)) (port (cadr server-info)) (last-access 0) (tdb (tasks:open-db)) - (spid (tasks:server-get-server-id tdb #f iface port #f)) + (spid ;;(open-run-close tasks:server-get-server-id tasks:open-db #f iface port #f)) + (tasks:server-get-server-id tdb #f iface port #f)) (server-timeout (let ((tmo (config-lookup *configdat* "server" "timeout"))) (if (and (string? tmo) (string->number tmo)) (* 60 60 (string->number tmo)) ;; default to three days - (* 3 24 60))))) + (* 3 24 60 60))))) (debug:print-info 2 "server-timeout: " server-timeout ", server pid: " spid " on " iface ":" port) (let loop ((count 0)) (thread-sleep! 4) ;; no need to do this very often ;; NB// sync currently does NOT return queue-length (let () ;; (queue-len (cdb:client-call server-info 'sync #t 1))) @@ -238,18 +240,20 @@ ;; Check that iface and port have not changed (can happen if server port collides) (mutex-lock! *heartbeat-mutex*) (set! sdat *runremote*) (mutex-unlock! *heartbeat-mutex*) - (if (not (equal? sdat (list iface port))) + (if (or (not (equal? sdat (list iface port))) + (not spid)) (begin - (debug:print-info 1 "interface changed, refreshing iface and port info") + (debug:print-info 0 "interface changed, refreshing iface and port info") (set! iface (car sdat)) (set! port (cadr sdat)) (set! spid (tasks:server-get-server-id tdb #f iface port #f)))) ;; NOTE: Get rid of this mechanism! It really is not needed... + ;; (open-run-close tasks:server-update-heartbeat tasks:open-db spid) (tasks:server-update-heartbeat tdb spid) ;; (if ;; (or (> numrunning 0) ;; stay alive for two days after last access (mutex-lock! *heartbeat-mutex*) (set! last-access *last-db-access*) @@ -262,11 +266,11 @@ (loop 0)) (begin (debug:print-info 0 "Starting to shutdown the server.") ;; need to delete only *my* server entry (future use) (set! *time-to-exit* #t) - (tasks:server-deregister-self tdb (get-host-name)) + (open-run-close tasks:server-deregister-self tasks:open-db (get-host-name)) (thread-sleep! 1) (debug:print-info 0 "Max cached queries was " *max-cache-size*) (debug:print-info 0 "Number of cached writes " *number-of-writes*) (debug:print-info 0 "Average cached write time " (if (eq? *number-of-writes* 0) @@ -313,10 +317,27 @@ (set! *didsomething* #t) (thread-join! th2)) (debug:print 0 "ERROR: Failed to setup for megatest"))) (exit))) +;; (use trace) +;; (trace http-transport:keep-running +;; tasks:server-update-heartbeat +;; tasks:server-get-server-id) +;; tasks:get-best-server +;; http-transport:run +;; http-transport:launch +;; http-transport:try-start-server +;; http-transport:client-send-receive +;; http-transport:make-server-url +;; tasks:server-register +;; tasks:server-delete +;; start-server +;; hostname->ip +;; with-input-from-request +;; tasks:server-deregister-self) + (define (http-transport:server-signal-handler signum) (handle-exceptions exn (debug:print " ... exiting ...") (let ((th1 (make-thread (lambda () Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,7 @@ ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.5415) +(define megatest-version 1.5416) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -26,11 +26,11 @@ (let* ((dbpath (conc *toppath* "/monitor.db")) (exists (file-exists? dbpath)) (mdb (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath)) (handler (make-busy-timeout 36000))) (sqlite3:set-busy-handler! mdb handler) - (sqlite3:execute mdb (conc "PRAGMA synchronous = 0;")) + (sqlite3:execute mdb (conc "PRAGMA synchronous = 1;")) (if (not exists) (begin (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY, action TEXT DEFAULT '', owner TEXT, @@ -141,10 +141,11 @@ "SELECT id FROM servers WHERE pid=-999;"))) (if hostname hostname iface)(if pid pid port)) res)) (define (tasks:server-update-heartbeat mdb server-id) + (debug:print-info 0 "Heart beat update of server id=" server-id) (sqlite3:execute mdb "UPDATE servers SET heartbeat=strftime('%s','now') WHERE id=?;" server-id)) ;; alive servers keep the heartbeat field upto date with seconds every 6 or so seconds (define (tasks:server-alive? mdb server-id #!key (iface #f)(hostname #f)(port #f)(pid #f)) (let* ((server-id (if server-id