Megatest

     (else
      "nopurpose"))))

;; megatest process tracking

(defstruct procinf
  (start      (current-seconds))
  (end        -1)
  (host       (get-host-name)) ;; why is this not being recognised?
  (pid        (current-process-id))
  (port       #f)
  (port       -1)
  (cwd        (current-directory))
  (load       #f)
  (purpose    #f) ;; get-purpose needed to be run in megatest.scm
  (dbname     #f)
  (mtbin      (car (argv)))
  (mtversion  #f)
  (status     "running")

(define (dbfile:insert-or-update-process nsdb dat)
  (let* ((host      (procinf-host dat))
	 (pid       (procinf-pid  dat))
	 (curr-info (dbfile:get-process-info nsdb host pid)))
    (if curr-info ;; record exists, do update
	(match curr-info
	  ((host port pid starttime status purpose dbname mtversion)
	  ((host port pid starttime endtime status purpose dbname mtversion)
	   (sqlite3:execute
	    nsdb
	    "UPDATE processes SET port=?,starttime=?,status=?,
	    "UPDATE processes SET port=?,starttime=?,endtime=?,status=?,
                                  purpose=?,dbname=?,mtversion=?
              WHERE host=? AND pid=?;"
	    (or (procinf-port      dat) port)
	    (or (procinf-start     dat) starttime)
	    (or (procinf-end       dat) endtime)
	    (or (procinf-status    dat) status)
	    (or (procinf-purpose   dat) purpose)
	    (or (procinf-dbname    dat) dbname)
	    (or (procinf-mtversion dat) mtversion)
	    host pid))
	  (else
	   #f ;; what to do?
	   ))
	(dbfile:register-process
	 nsdb
	 (procinf-host      dat)
	 (procinf-port      dat)
	 (procinf-pid       dat)
	 (procinf-start     dat)
	 (procinf-end       dat)
	 (procinf-status    dat)
	 (procinf-purpose   dat)
	 (procinf-dbname    dat)
	 (procinf-mtversion dat)))))
	  

(define (dbfile:register-process nsdb host port pid starttime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?);"
		   host port pid starttime status purpose dbname mtversion))
(define (dbfile:register-process nsdb host port pid starttime endtime status purpose dbname mtversion)
  (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,endtime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?,?);"
		   host port pid starttime endtime status purpose dbname mtversion))

(define (dbfile:set-process-status nsdb host pid newstatus)
  (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid))

(define (dbfile:get-process-options nsdb purpose dbname)
  (sqlite3:fold-row
   ;; host port pid starttime status mtversion
   (lambda (res . row)
     (cons row res))
   '()
   nsdb
   "SELECT host,port,pid,starttime,status,mtversion FROM processes WHERE purpose=? AND dbname LIKE ? AND status='alive';"
   "SELECT host,port,pid,starttime,endtime,status,mtversion FROM processes WHERE purpose=? AND dbname LIKE ? AND status='alive';"
   purpose dbname))

(define (dbfile:get-process-info nsdb host pid)
  (let ((res (sqlite3:fold-row
	      ;; host port pid starttime status mtversion
	      (lambda (res . row)
		(cons row res))
	      '()
	      nsdb
	      "SELECT host,port,pid,starttime,status,purpose,dbname,mtversion FROM processes WHERE host=? AND pid=?;"
	      "SELECT host,port,pid,starttime,endtime,status,purpose,dbname,mtversion FROM processes WHERE host=? AND pid=?;"
	      host pid)))
    (if (null? res)
	#f
	(car res))))

(define (dbfile:set-process-done nsdb host pid reason)
  (sqlite3:execute nsdb "UPDATE processes SET status='ended',endtime=?,reason=? WHERE host=? AND pid=?;" (current-seconds) reason host pid)

			      "tcp-server-thread"))
		 (run-thread (make-thread
			      (lambda ()
				(tt:keep-running ttdat dbfname dbstruct)))))
	    (thread-start! tcp-thread)
	    (thread-start! run-thread)

	    (procinf-port-set! *procinf* (tt-port ttdat))
	    (let* ((areapath     (tt-areapath ttdat))
		   (nosyncdbpath (conc areapath"/.mtdb")))
	      ;; this didn't seem to work, is port not available yet?
	      (let loop ((count 0))
		(if (tt-port ttdat)
		    (begin
		      (procinf-port-set! *procinf* (tt-port ttdat))
		      (procinf-dbname-set! *procinf* dbfname)
		      (dbfile:with-no-sync-db
		       nosyncdbpath
		       (lambda (nsdb)
			 (dbfile:insert-or-update-process nsdb *procinf*))))
		    (if (< count 5)
			(begin
			  (thread-sleep! 0.5)
			  (loop (+ count 1)))
			(debug:print 0 *default-log-port* "ERROR: (tt-port ttdat) no port set!"))))
	    
	      (thread-join! run-thread) ;; run thread will exit on timeout or other conditions
	      ;; replace with call to (dbfile:set-process-done nsdb host pid reason)
	      (procinf-status-set! *procinf* "done")
	      (procinf-end-set! *procinf* (current-seconds))
	      (dbfile:with-no-sync-db
	       nosyncdbpath
	       (lambda (nsdb)
		 (dbfile:insert-or-update-process nsdb *procinf*)))
	    
	      (thread-join! run-thread) ;; run thread will exit on timeout or other conditions
	      (procinf-status-set! *procinf* "done")
	      (dbfile:with-no-sync-db
	       nosyncdbpath
	       (lambda (nsdb)
		 (dbfile:insert-or-update-process nsdb *procinf*))))
            (debug:print 0 *default-log-port* "Exiting now.")
	    (exit))))))
              (debug:print 0 *default-log-port* "Exiting now.")
	      (exit)))))))

(define (tt:keep-running ttdat dbfname dbstruct)
  ;; verfiy conn for ready
  ;; listener socket has been started by this stage
  ;; wait for a port before creating the registration file
  ;;
  (let* ((db-locked-in #f)