Megatest

# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

TODO
====

No-homehost
-----------

Server side

    1. Add invocation type to -m [DONE]
    
    2. Switch starting of servers to look at .homehost, if it exists, respect it,
       otherwise start on current machine. [DONE]
       
    3. On start server drops a packet into .meta after starting the http server,
       pkt includes:
        a. host
        b. port
        c. Invocation type of process that started the server
        d. D card (packet create card)
        e. Process id of the server process
	
    4. Server will stay alive if it receives calls
    
    5. Server touches the pkt file every ten seconds
    
    6. On exiting the server removes its pkt file
    
Client side

    1. If no pkts in .meta start a server, wait 5-10 seconds and look again
    
    2. Read all pkts in .meta dir
    
    3. Sort servers by (take left most)
        a. Invocation type: dboard -> runner -> other -> exec
        b. Run duration: shortest -> longest
        c. Tie breaker is the shar1 hash for the pkt
	
    4. Ping the server and continue as before
    
WW15
. fill newview matrix with data, filter pipeline gui elements
. improve [script], especially indent handling

WW16
. split db into megatest.db (runs etc.) db/<something>.db
. release basic newview implementation

  (message-digest-string (md5-primitive) str))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (common:run-sync?)
    (and (common:on-homehost?) ;; huh? isn't this by definition both true?
	 (args:get-arg "-server")))

(define (common:human-time)
  (time->string (seconds->local-time (current-seconds)) "%Y-%m-%d %H:%M:%S"))


(define (std-signal-handler signum)

      (if (and (getenv "MT_ITEMPATH")
               (not (equal? (getenv "MT_ITEMPATH") "")))
          (getenv "MT_TEST_NAME")
          (conc (getenv "MT_TEST_NAME") "/" (getenv "MT_ITEMPATH")))
      #f))

;;======================================================================
;; logic for getting homehost . Returns (host . at-home)
;; IF *toppath* is not set, wait up to five seconds trying every two seconds
;; (this is to accomodate the watchdog)
;;
(define (common:get-homehost #!key (trynum 5))
  ;; called often especially at start up. use mutex to eliminate collisions
  (let ((hhf (conc *toppath* "/.homehost")))
    (mutex-lock! *homehost-mutex*)
    (cond
     (*home-host*
      (mutex-unlock! *homehost-mutex*)
      *home-host*)
     ((not *toppath*)
      (mutex-unlock! *homehost-mutex*)
      (launch:setup) ;; safely mutexed now
      (if (> trynum 0)
	  (begin
	    (thread-sleep! 2)
	    (common:get-homehost trynum: (- trynum 1)))
	  `(#f . #f)))
     #;((and (configf:lookup *configdat* "server" "no-homehost")
	   (not (file-exists? hhf)))
      `(#f . #f))  ;; NEW METHOD, DO NOT USE A HOMEHOST - nope, not doing it this way.
     (else
      (let* ((currhost (get-host-name))
	     (bestadrs (server:get-best-guess-address currhost))
	     ;; first look in config, then look in file .homehost, create it if not found
	     (homehost (or (configf:lookup *configdat* "server" "homehost" )
			   (handle-exceptions
			       exn
			       (if (> trynum 0)
				   (let ((delay-time (* (- 5 trynum) 5)))
				     (mutex-unlock! *homehost-mutex*)
				     (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying "
						  delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn)
						  ", exn=" exn)
				     (thread-sleep! delay-time)
				     (common:get-homehost trynum: (- trynum 1)))
				   (begin
				     (mutex-unlock! *homehost-mutex*)
				     (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)
						  "] Failed to read .homehost file after trying five times. Giving up and exiting, message: "
						  ((condition-property-accessor 'exn 'message) exn))
				     (exit 1)))

			     (if (common:file-exists? hhf)
				 (with-input-from-file hhf read-line)
				 (if (file-write-access? *toppath*)
				     (begin
				       (with-output-to-file hhf
					 (lambda ()
					   (print bestadrs)))
				       (begin
					 (mutex-unlock! *homehost-mutex*)
					 (car (common:get-homehost))))
				     `(#f . #f))))))
	     (at-home  (or (equal? homehost currhost)
			   (equal? homehost bestadrs))))
	(set! *home-host* (cons homehost at-home))
	(mutex-unlock! *homehost-mutex*)
	*home-host*)))))

;;======================================================================
;; am I on the homehost?
;;
(define (common:on-homehost?)
  (let ((hh (common:get-homehost)))
    (if hh

    ((rpc)  (db:obj->string (vector success/fail query-sig result)))
    ((http) (db:obj->string (vector success/fail query-sig result)))
    ((fs)   result)
    (else 
     (debug:print-error 0 *default-log-port* "unrecognised transport type: " *transport-type*)
     result)))

(define (server:what-type-of-invocation)
  (cond
   ((args:get-arg "-run")       "run")
   ((args:get-arg "-server")    "server")
   ((args:get-arg "-execute")   "execute")
   ((or (args:get-arg "-remove-runs")) "run-related")
   ((string-search (car (argv)) "dboard") "dboard")
   (else (conc "other:"(string-intersperse (command-line-arguments) "_")))))

;; Given an area path,  start a server process    ### NOTE ### > file 2>&1 
;; if the target-host is set 
;; try running on that host
;;   incidental: rotate logs in logs/ dir.
;;
(define  (server:run areapath) ;; areapath is *toppath* for a given testsuite area
  (let* ((curr-host   (get-host-name))

	 (profile-mode (or (configf:lookup *configdat* "misc" "profilesw")
			   ""))
	 (cmdln (conc (common:get-megatest-exe)
		      " -server " (or target-host "-") (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes")
							   " -daemonize "
							   "")
		      ;; " -log " logfile
		      " -m testsuite:"testsuite":"(server:what-type-of-invocation)
		      " " profile-mode
		      )) ;; (conc " >> " logfile " 2>&1 &")))))
	 (log-rotate  (make-thread common:rotate-logs  "server run, rotate logs thread")) ;; why are we rotating logs here? This is a sensitive location with a lot going on!?
         (load-limit  (configf:lookup-number *configdat* "jobtools" "max-server-start-load" default: 3.0)))
    ;; we want the remote server to start in *toppath* so push there
    (push-directory areapath)
    (debug:print 0 *default-log-port* "INFO: Trying to start server (" cmdln ") ...")