Megatest

  ;; listener socket has been started by this stage
  ;; wait for a port before creating the registration file
  ;;
  (let* ((cleanup (lambda ()
		    (if (tt-cleanup-proc ttdat)
			((tt-cleanup-proc ttdat))))))
    (let loop ((count 0))
      (if (> count 60)
      (if (> count 240)
	  (begin
	    (debug:print 0 *default-log-port* "FATAL: Could not start a tcp server, giving up.")
	    (exit 1))
	  (if (not (tt-port ttdat)) ;; no connection yet
	      (let* ((last-update (dbr:dbstruct-last-update dbstruct))
		     (curr-secs   (current-seconds)))
		(if (> (- curr-secs last-update) 3) ;; every 3-4 seconds update the db? maybe this should be refresh the inmem?
		    (begin
	      (begin
		      ((dbr:dbstruct-sync-proc dbstruct) last-update)
		      (dbr:dbstruct-last-update-set! dbstruct curr-secs)))
		(thread-sleep! 0.25)
		(loop (+ count 1))))))
    
    ;; load or reload the data into inmem db before
    ;; ((dbr:dbstruct-sync-proc dbstruct) (dbr:dbstruct-last-update dbstruct))
    ;; (dbr:dbstruct-last-update-set! dbstruct (- (current-seconds) 1))
    (tt:create-server-registration-file ttdat dbfname)
    ;; now start watching the last-access, if it hasn't been touched
    ;; in over ten seconds we exit
    (thread-sleep! 0.05) ;; any real need for delay here?

	(if ok
	    ;; (if (> *api-process-request-count* 0) ;; have requests in flight
	    ;;	(tt-last-access-set! ttdat (current-seconds)))
	    (tt-last-access-set! ttdat *db-last-access*) ;; bit silly, just use db-last-access
	    (begin
	      (cleanup)
	      (exit)))
	

	(let* ((last-update (dbr:dbstruct-last-update dbstruct))
	       (curr-secs   (current-seconds)))
	  (if (> (- curr-secs last-update) 3) ;; every 3-4 seconds update the db? maybe this should be refresh the inmem?
	      (begin
		((dbr:dbstruct-sync-proc dbstruct) last-update)
		(dbr:dbstruct-last-update-set! dbstruct curr-secs))))
	  
	(if (< (- (current-seconds) (tt-last-access ttdat)) 60)
	    (begin
	      (thread-sleep! 5)
	      (loop)))))
	(cleanup)
	(debug:print 0 *default-log-port* "INFO: Server timed out, exiting.")))
    (cleanup)
    (debug:print 0 *default-log-port* "INFO: Server timed out, exiting.")))

  
;; ;; given an already set up uconn start the cmd-loop
;; ;;
;; (define (tt:cmd-loop ttdat)
;;   (let* ((serv-listener (-socket uconn))
;; 	 (listener      (lambda ()