Megatest

(require-library mutils)

(define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file

;; 'http or 'tcp
(rmt:transport-mode 'tcp)
;; (rmt:transport-mode 'tcp)
(rmt:transport-mode 'http)

(dbfile:db-init-proc db:initialize-main-db)

;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

	*
	
  (import scheme
	  (prefix sqlite3 sqlite3:)
	  chicken
	  data-structures

	  ;; address-info
	  address-info
	  directory-utils
	  extras
	  files
	  hostinfo
	  matchable
	  md5
	  message-digest

  (host         #f)
  (port         #f)
  (conn         #f)
  (cleanup-proc #f)
  socket
  thread
  host-port
  (cmd-thread   #f)
  )

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

(define (tt:client-connect-to-server ttdat)
  #f)

(define (tt:start-tcp-server ttdat)
  #f)

(define (tt:keep-running ttdat dbfile)
  #f)

(define (tt:shutdown-server ttdat)
  (let* ((cleanproc (tt-cleanup-proc ttdat)))
  (let* ((cleanproc (tt-srv-cleanup-proc ttdat)))
    (if cleanproc (cleanproc))
    ;; close up ports here
    #f))

(define (wait-and-close uconn)
  (thread-join! (tt-srv-cmd-thread uconn))
  (tcp-close (tt-srv-socket uconn)))

    (assert conn "FATAL: tt:create-server-registration-file called with no conn, dbfname="dbfname)
    (let* ((host    (tt-conn-host conn))
	   (port    (tt-conn-port conn))
	   (servinf (conc servdir"/"host":"port"-"(current-process-id)":"dbfname))
	   (serv-id (tt:mk-signature areapath))
	   (clean-proc (lambda ()
			 (delete-file* servinf))))
      (tt-cleanup-proc-set! ttdat clean-proc)
      (tt-srv-cleanup-proc-set! ttdat clean-proc)
      (with-output-to-file servinf
	(lambda ()
	  (print "SERVER STARTED: "host":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id))))
      serv-id)))

;; find valid server
;; get servers listed, last part of name must match :<dbfname>