Megatest

	  regex-case
	  srfi-1
	  srfi-18
	  srfi-4
	  srfi-69
	  stack
	  typed-records
	  tcp-server
	  tcp
	  
	  commonmod
	  debugprint
	)

;;======================================================================
;; client

(defstruct tt-conn
  host
  port
  dbfname
)

(defstruct tt-srv
  ;; server related
  (areapath     #f)
  (host         #f)
  (port         #f)
  (conn         #f)
  (cleanup-proc #f)
  (handler      #f) ;; receives data and responds
  (socket       #f)
  (thread       #f)
  (host-port    #f)
  (cmd-thread   #f)
  )

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

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

;; client side handler
;;
(define (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)
  ;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now.
  (let* ((conn (hash-table-ref/default (tt-conns runremote) dbfname #f)))
    (if conn
	;; have connection, call the server
	(let* ((res (tt:send-receive runremote conn cmd rid params)))
	  (cond

;;======================================================================

(define (tt:sync-dbs ttdat)
  #f)

;; start the listener and start responding to requests
;;
;; NOTE: organise by dbfname, not run-id so we don't need
;;       to pull in more modules
;;
(define (tt:start-server areapath dbfname handler)
  ;; is there already a server for this dbfile? Then exit.
  (let* ((ttdat  (make-tt-srv areapath: areapath))
	 ;; (dbfname (dbmod:run-id->dbfname run-id))
	 (servers (tt:find-server ttdat dbfname)))
    (tt-srv-handler-set! ttdat handler)
    (if (null? servers)
	(begin
	  (tt:start-tcp-server ttdat) ;; start the tcp-server which applies handler to incoming data
	  (tt:keep-running ttdat dbfname))
	(begin
	  (debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
	  (exit)))))

((make-tcp-server 
  (tcp-listen 6504) 
  (lambda () 
    (write-line (seconds->string (current-seconds)))))
 #t)

;; find a port and start tcp-server
;;
(define (tt:start-tcp-server ttdat)
  (setup-listener ttdat)
  (let* ((socket   (tt-srv-socket ttdat))
	 (handler  (tt-srv-handler    ttdat)))
    ((make-tcp-server socket handler)
     #t ;; yes, send error messages to std-err
     )))

(define (tt:keep-running ttdat dbfile)
  ;; verfiy conn for ready
  ;; listener socket has been started by this stage
  (debug:print 0 *default-log-port* "INFO: Got here!!!!"))

;; ;; given an already set up uconn start the cmd-loop
;; ;;
;; (define (tt:cmd-loop ttdat)
;;   (let* ((serv-listener (-socket uconn))
;; 	 (listener      (lambda ()
;; 			  (let loop ((state 'start))
;; 			    (let-values (((inp oup)(tcp-accept serv-listener)))
;; 			      ;; (mutex-lock! *send-mutex*) ;; DOESN'T SEEM TO HELP
;; 			      (let* ((rdat  (deserialize inp)) ;; '(my-host-port qrykey cmd params)
;; 				     (resp  (ulex-handler uconn rdat)))
;; 				(serialize resp oup)
;; 				(close-input-port inp)
;; 				(close-output-port oup)
;; 				;; (mutex-unlock! *send-mutex*) ;; DOESN'T SEEM TO HELP
;; 				)
;; 			      (loop state))))))
;;     ;; start N of them
;;     (let loop ((thnum   0)
;; 	       (threads '()))
;;       (if (< thnum 100)
;; 	  (let* ((th (make-thread listener (conc "listener" thnum))))
;; 	    (thread-start! th)
;; 	    (loop (+ thnum 1)
;; 		  (cons th threads)))
;; 	  (map thread-join! threads)))))
;; 
;; 
;; 
;; (define (wait-and-close uconn)
;;   (thread-join! (udat-cmd-thread uconn))
;;   (tcp-close (udat-socket uconn)))
;; 
;; 

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

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

;; return servid
;; side-effects:
;;   ttdat-cleanup-proc is populated with function to remove the serverinfo file
(define (tt:create-server-registration-file ttdat dbfname)
  (let* ((areapath (tt-areapath ttdat))
	 (servdir  (tt:get-servinfo-dir areapath))

;; my port, address, hostname, pid etc.
;; return #f if fail to find a port to allocate.
;;
;;  if udata-in is #f create the record
;;  if there is already a serv-listener return the udata
;;
(define (setup-listener uconn #!optional (port 4242))
  (assert (tt-srv? uconn) "FATAL: setup-listener called with wrong struct "uconn)
  (handle-exceptions
   exn
   (if (< port 65535)
       (setup-listener uconn (+ port 1))
       #f)
   (connect-listener uconn port)))