Megatest

		 0))

;; The watchdog is to keep an eye on things like db sync etc.
;;
(define *watchdog*
  (make-thread 
   (lambda ()
     (thread-sleep! 0.5) ;; half second delay for startup
     (thread-sleep! 0.05) ;; delay for startup
     (let loop ()
       ;; sync for filesystem local db writes
       ;;
       (let ((start-time      (current-seconds))
	     (servers-started (make-hash-table)))
	 (mutex-lock! *db-multi-sync-mutex*)
	 (for-each 
	  (lambda (run-id)
	    (mutex-lock! *db-multi-sync-mutex*)
	    (let ((last-write (hash-table-ref/default *db-local-sync* run-id 0)))
	      (if (> (- start-time last-write) 5) ;; every five seconds
		  (let ((sync-time (- (current-seconds) start-time)))
		    (db:multi-db-sync (list run-id) 'new2old)
		    (if (common:low-noise-print 30 "sync new to old")
			(begin
			  (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds")
			  (if (and (> sync-time 10) ;; took more than ten seconds, start a server for this run
				   (hash-table-ref/default servers-started run-id #f))
			      (begin
				(debug:print-info 0 "Sync is taking a long time, start up a server to assist for run " run-id)
				(server:kind-run run-id)
				(hash-table-set! servers-started run-id #t)))))
		    (hash-table-delete! *db-local-sync* run-id)))))
	    (if (hash-table-ref/default *db-local-sync* run-id 0)
		;; (if (> (- start-time last-write) 5) ;; every five seconds
		(let ((sync-time (- (current-seconds) start-time)))
		  (db:multi-db-sync (list run-id) 'new2old)
		  (if (common:low-noise-print 30 "sync new to old")
		      (begin
			(debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds")
			(if (and (> sync-time 10) ;; took more than ten seconds, start a server for this run
				 (hash-table-ref/default servers-started run-id #f))
			    (begin
			      (debug:print-info 0 "Sync is taking a long time, start up a server to assist for run " run-id)
			      (server:kind-run run-id)
			      (hash-table-set! servers-started run-id #t)))))
		  (hash-table-delete! *db-local-sync* run-id)))
	  (hash-table-keys *db-local-sync*))
	 (mutex-unlock! *db-multi-sync-mutex*))
       
	    (mutex-unlock! *db-multi-sync-mutex*))
	  (hash-table-keys *db-local-sync*)))

       ;; keep going unless time to exit
       ;;
       (if (not *time-to-exit*)
	   (begin
	     (thread-sleep! 5) ;; five second resolution is only a minor burden and should be tolerable 
	     (thread-sleep! 1) ;; wait one second before syncing again
	     (loop)))))
   "Watchdog thread"))

(thread-start! *watchdog*)

(define (std-exit-procedure)
  (rmt:print-db-stats)

    (begin
      (db:multi-db-sync 
       #f ;; do all run-ids
       'killservers
       'dejunk
       'adj-testids
       'old2new
       'new2old
       ;; 'new2old
       )
      (set! *didsomething* #t)))

(if (args:get-arg "-sync-to-megatest.db")
    (begin
      (db:multi-db-sync 
       #f ;; do all run-ids

	   (res           (api:execute-requests dbstruct-local (symbol->string cmd) params))
	   (duration      (- (current-milliseconds) start)))
      (rmt:update-db-stats run-id cmd params duration)
      ;; mark this run as dirty if this was a write
      (if (not (member cmd api:read-only-queries))
	  (let ((start-time (current-seconds)))
	    (mutex-lock! *db-multi-sync-mutex*)
	    (if (not (hash-table-ref/default *db-local-sync* run-id #f))
		(hash-table-set! *db-local-sync* run-id start-time)) ;; the oldest "write"
	    ;; (if (not (hash-table-ref/default *db-local-sync* run-id #f))
	    ;; just set it every time. Is a write more expensive than a read and does it matter?
	    (hash-table-set! *db-local-sync* run-id start-time) ;; the oldest "write"
	    (mutex-unlock! *db-multi-sync-mutex*)))
      res)))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((run-id   (if run-id run-id 0))
	 (jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))
	 (res (http-transport:client-api-send-receive run-id connection-info cmd jparams)))