Megatest

;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;   we start the server if not running else start the client thread
;;======================================================================

(if (args:get-arg "-server")
    (begin
      (debug:print 2 "Launching server...")
      ;; (change-directory "/")
      (let ((fd-r (file-open "/dev/null" open/rdonly))
	    (fd-w (file-open "/dev/null" open/wronly)))
	(duplicate-fileno fd-r 0)
	(duplicate-fileno fd-w 1)
	(file-close fd-r)
	(file-close fd-w))
      (server:launch)))
      (let ((child-pid (process-fork (lambda ()(server:launch)))))
	(if (not (zero? child-pid))
	    (exit 0)))
      (create-session)
      (duplicate-fileno 1 2)
      (void)))

(if (args:get-arg "-list-servers")
	;; (args:get-arg "-kill-server"))
    (let ((tl (setup-for-run)))
      (if tl 
	  (let ((servers (open-run-close tasks:get-all-servers tasks:open-db))
		(fmtstr  "~5a~8a~8a~20a~20a~10a~10a~10a~10a\n")

	  ;;    (server:client-setup (- numtries 1))
	  ;;    #f)
	   (server:client-connect iface pullport pubport)) ;; )
	(if (> numtries 0)
	    (let ((exe (car (argv)))
		  (pid #f))
	      (debug:print-info 0 "No server available, attempting to start one...")
	      ;; (set! pid (process-run exe (list "-server" "-" "-debug" (if (list? *verbosity*)
	      ;;   							  (string-intersperse *verbosity* ",")
	      ;;   							  (conc *verbosity*)))))
	      (set! pid (process-fork (lambda ()
	      (set! pid (process-run exe (list "-server" "-" "-debug" (if (list? *verbosity*)
	         							  (string-intersperse *verbosity* ",")
	         							  (conc *verbosity*)))))
	      ;; (set! pid (process-fork (lambda ()
					;; (change-directory "/")
					;; (let ((fd-r (file-open "/dev/null" open/rdonly))
					;;       (fd-w (file-open "/dev/null" open/wronly)))
					;;   (duplicate-fileno fd-r 0)
					;;   (duplicate-fileno fd-w 1)
					;;   (file-close fd-r)
					;;   (file-close fd-w))
					;; (let ((child-pid (process-fork (lambda ()(server:launch)))))
					;;   (if (not (zero? child-pid))
					;;       (exit 0)))
					;; (create-session)
					;; (duplicate-fileno 1 2)
					;; (void)
					;; ;; child-pid
					;; )))
					;; (current-input-port  (open-input-file  "/dev/null"))
					;; (current-output-port (open-output-file "/dev/null"))
					;; (current-error-port  (open-output-file "/dev/null"))
					(server:launch)))) ;; should never get here ....
	      ;;                           (server:launch)))) ;; should never get here ....
	      (let loop ((count 0))
		(let ((hostinfo (open-run-close tasks:get-best-server tasks:open-db)))
		  (if (not hostinfo)
		      (begin
			(debug:print-info 0 "Waiting for server pid=" pid " to start")
			(sleep 2) ;; give server time to start
			(if (< count 5)