Megatest

			     (if convert (lazy-convert inval) inval))))
		   (else f))))
	     (filter (lambda (x)
		       (not (string-match "^\\s*" x)))
		     val-list))
	'())))

(define (get-cpu-load)
  (let* ((load-info (with-input-from-file "/proc/loadavg" read-lines)))
    (map string->number (string-split load-info))))

(define *current-host-cores* #f)

(define (get-current-host-cores)
  (or *current-host-cores*
      (let ((cpu-info (with-input-from-file "/proc/cpuinfo" read-lines)))
	(let loop ((lines cpu-info))
	  (if (null? lines)
	      1 ;; gotta be at least one!
	      (let* ((inl (car lines))
		     (tail (cdr lines))
		     (parts (string-split inl)))
		(match parts
		  (("cpu" "cores" ":" num) (string->number num))
		  (else (loop tail)))))))))

(define (number-of-processes-running processname)
  (with-input-from-pipe
   (conc "ps -def | egrep \""processname"\" |wc -l")
   (lambda ()
     (string->number (read-line)))))

;; get the normalized (i.e. load / numcpus) for *this* host
;;
(define (get-normalized-cpu-load)
  (/ (get-cpu-load)(get-current-host-cores)))

;;======================================================================
;; testsuite and area utilites
;;======================================================================

(define (get-testsuite-name toppath configdat)
  (or (lookup configdat "setup" "area-name")
      (lookup configdat "setup" "testsuite")

(use canvas-draw)

(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))

(declare (unit dashboard-context-menu))
(declare (uses common))
(declare (uses commonmod))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

(import commonmod)

(define (dboard:launch-testpanel run-id test-id)
  (let* ((dboardexe (common:find-local-megatest "dashboard"))
         (cmd (conc dboardexe
                    " -test " run-id "," test-id
                    " &")))
    (system cmd)))

(use canvas-draw)

(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))

(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses commonmod))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))

(import commonmod)

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

;;======================================================================
;; C O M M O N

				  (let ((db (cdr *task-db*)))
				    (if (sqlite3:database? db)
					(begin
					  (sqlite3:interrupt! db)
					  (sqlite3:finalize! db #t)
					  ;; (vector-set! *task-db* 0 #f)
					  (set! *task-db* #f)))))
			      (if (and *no-sync-db*
				       (sqlite3:database? *no-sync-db*))
				  (sqlite3:finalize! *no-sync-db* #t))
			      (if (and (not (args:get-arg "-server"))
				       *runremote*)
				  (begin
				    (debug:print-info 0 *default-log-port* "Closing all client connections...")
				    (http-transport:close-connections *runremote*)
				    #;(http-client#close-all-connections!)))
                              ;; (if (and *runremote*

			    (if (not db-exists)
				(begin
				  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));"))
				)))
	       (on-tmp      (equal? (car (string-split dbpath "/")) "tmp"))
	       (db        (if on-tmp
			      (dbfile:cautious-open-database dbname init-proc 0 "WAL")
			      (dbfile:cautious-open-database dbname init-proc 0 #f)
			      ;; (sqlite3:open-database dbname)
			      )))
	  (if on-tmp	      ;; done in cautious-open-database
	      (begin
		(sqlite3:execute db "PRAGMA synchronous = 0;")
		(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))))
	  (set! *no-sync-db* db)
	  db))))

  (servinf-file #f)
  (last-serv-start 0)
  )

(define (tt:make-remote areapath)
  (make-tt areapath: areapath))

;; 1 ... or #f
(define (tt:valid-run-id run-id)
  (or (number? run-id)
      (not run-id)))

;; do all the busy work of finding and setting up conn for
;; connecting to a server
;; 
(define (tt:client-connect-to-server ttdat dbfname run-id testsuite)
  (assert (tt:valid-run-id run-id) "FATAL: invalid run-id "run-id)
  (let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f))
	 (server-start-proc (lambda ()
			      (tt:server-process-run
			       (tt-areapath ttdat)
			       testsuite ;; (dbfile:testsuite-name)
			       (common:find-local-megatest)
			       run-id))))

;; try running on that host
;;   incidental: rotate logs in logs/ dir.
;;
(define  (tt:server-process-run areapath testsuite mtexe run-id #!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area
  (assert areapath  "FATAL: tt:server-process-run called without areapath defined.")
  (assert testsuite "FATAL: tt:server-process-run called without testsuite defined.")
  (assert mtexe     "FATAL: tt:server-process-run called without mtexe defined.")
  (let* ((load (get-normalized-cpu-load))
	 (nrun (number-of-processes-running "mtest.*server")))
    (cond
     ((> load 2.0)
      (debug:print 0 *default-log-port* "Normalized load "load" is over the limit of 2.0. Not starting a server.")
      (thread-sleep! 1))
     ((> nrun 40)
      (debug:print 0 *default-log-port* nrun" servers running on this host, not starting another.")
      (thread-sleep! 1))
     (else
      (if (not (file-exists? (conc areapath"/logs")))
	      (create-directory (conc areapath"/logs") #t))
	  (let* ((logfile   (conc areapath "/logs/server.log")) ;; -" curr-pid "-" target-host ".log"))
		 (cmdln     (conc
			     mtexe
			     " -server - ";; (or target-host "-")
			     " -m testsuite:" testsuite
			     ;; " -run-id " (or run-id "main") ;; NO, we do NOT want to have run id as part of this
			     " -db "  (dbmod:run-id->dbfname run-id)
			     " " profile-mode
			     ))) ;; (conc " >> " logfile " 2>&1 &")))))
	    ;; we want the remote server to start in *toppath* so push there
	    ;; (push-directory areapath) ;; use cd in the command line instead
	    (debug:print 0 *default-log-port* "INFO: Trying to start server in tcp mode (" cmdln ") at "(common:human-time)"...")
	    ;; (debug:print 0 *default-log-port* "INFO: starting server at " (common:human-time))
	    (setenv "NBFAKE_QUIET" "yes") ;; BUG: change to with-environment-variable ...
	    (setenv "NBFAKE_LOG" logfile)
	    (system (conc "cd "areapath" ; nbfake " cmdln))
	    (unsetenv "NBFAKE_QUIET")
	    (unsetenv "NBFAKE_LOG")
	    ;;(pop-directory)
	    )))))

;;======================================================================
;; tcp connection stuff
;;======================================================================

;; find a port and start tcp-server. This only starts the tcp portion of
;; the server, look at (tt:start-server ...) above for the entry point