Megatest

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

(declare (unit tcp-transportmod))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses dbfile))
(declare (uses dbmod))

(use address-info)

(module tcp-transportmod
	*
	
  (import scheme
	  (prefix sqlite3 sqlite3:)
	  chicken

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

;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic

(defstruct tt-conn
  host
  port
  host-port
  dbfname
  server-id
  server-start
  pid
)

(defstruct tt

	(let* ((dbstruct (dbmod:open-dbmoddb areapath run-id (dbfile:db-init-proc))))
	  (tt:start-tcp-server ttdat) ;; start the tcp-server which applies handler to incoming data
	  (tt:keep-running ttdat dbfname handler))
	(begin
	  (debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
	  (exit)))))

;; find a port and start tcp-server
;;
(define (tt:start-tcp-server ttdat)
  (setup-listener ttdat)
  (let* ((socket   (tt-socket ttdat))
	 (handler  (tt-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
;; ;;

  (assert (tt? 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)))

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

(define (connect-listener uconn port)
  ;; (tcp-listener-socket LISTENER)(socket-name so)
  ;; sockaddr-address, sockaddr-port, sockaddr->string
  (let* ((tlsn (tcp-listen port 1000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
	 (addr (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
	 (addr  (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
    (tt-port-set!      uconn port)
    (tt-host-port-set! uconn (conc addr":"port))
    (tt-socket-set!    uconn tlsn)
    uconn))