Megatest

(if (args:get-arg "-server")
    (let ((mode (string->symbol (args:get-arg "-server"))))
      (print "Mode: " mode)
      (case mode
	((main)(print "Starting server in main mode."))
	(else  (print "Starting server in hidden mode.")))
       ;; opens the port, drops the pkt, contacts other servers and then waits for messages
      (if (not (server:launch mode (lambda (pktrecvd)(print "Received: " pktrecvd))))
      (if (not (server:launch mode)) ;;  (lambda (pktrecvd)(print "Received: " pktrecvd))))
	  (exit 1))
      (set! *didsomething* #t)))

(if (args:get-arg "-repl")
    (begin
      ;; user will have to start the server manually
      (print "Run: (server:start-nmsg 'main) to start the server")

(module
    nmsg-transport
    (
     nmsg:start-server
     nmsg:open-send-close
     nmsg:open-send-receive
     nmsg:recv
     nmsg:send
     nmsg:close
     )

(import scheme posix chicken data-structures ports)

(use nanomsg srfi-18)

       (thread-start! th1)
       (thread-start! th2)
       (thread-join! th1)
       res))))

(define nmsg:close nn-close)
(define nmsg:recv  nn-recv)
(define nmsg:send  nn-send)

)

	  ;; set all the area info in the 
	  (area-pktsdir-set! *area-info* pktdir)
	  (area-mtrah-set!   *area-info* mtdir)
	  (area-conn-set!    *area-info* area-conn)
	  (area-port-set!    *area-info* port-num)
	  (mutex-unlock! (area-mutex *area-info*))
	  area-conn))))

(define (server:std-handler dat)
  ;; (let* ((from-host (alist-ref 'hostname dat))
  dat)
	 

;; Call this to start the actual server
;;
;; start_server
;;
;;   mode: '
;;   handler: proc which takes pktrecieved as argument
;;
(define (server:launch mode proc)
  (let* ((start-time (current-seconds))
	 (rep        (server:start-nmsg mode))
	 (last-msg   (current-seconds))
	 (th1        (make-thread
		      (lambda ()
			(let loop ()
			  (let ((pktdat (server:receive rep)))
			    (set! last-msg (current-seconds))
			    ;; (print "received: " pktdat)
			    (if (not (eof-object? pktdat))
(define (server:launch mode #!optional (proc server:std-handler))
  (let* ((start-time    (current-seconds))
	 (rep           (server:start-nmsg mode))
	 (last-msg-time (current-seconds))
	 (th1           (make-thread
			 (lambda ()
			   (let loop ()
			     (let ((dat (server:receive rep)))
			       (set! last-msg-time (current-seconds))
			       ;; (print "received: " pktdat)
			       (if (not (eof-object? dat))
				(begin
				  (proc pktdat)
				  (loop))))))
		      "message handler"))
	 (th2       (make-thread
		     (lambda ()
		       (let loop ()
			 (thread-sleep! 10)
			 (if (> (- (current-seconds) last-msg) 60) ;; timeout after 60 seconds
			     (begin
			       (print "Waited for 60 seconds and no messages, exiting now.")
			       (exit))
			     (loop)))))))
				   (let ((resdat (proc dat)))
				     (nmsg:send rep (with-output-to-string (lambda ()(write resdat))))
				     (loop))))))
			 "message handler"))
	 (th2           (make-thread
			 (lambda ()
			   (let loop ()
			     (thread-sleep! 10)
			     (if (> (- (current-seconds) last-msg-time) 60) ;; timeout after 60 seconds
				 (begin
				   (print "Waited for 60 seconds and no messages, exiting now.")
				   (exit))
				 (loop)))))))
    (thread-start! th1)
    (thread-start! th2)
    (thread-join! th1)))

;; get the response
;;
(define (server:receive rep)
  (let ((instr (nmsg:recv rep)))
    (if (string? instr)
	(with-input-from-string instr read)
	instr)))

(define (server:shutdown)
  (let ((conn (area-conn    *area-info*))
	(pktf (area-pktfile *area-info*))
	(port (area-port    *area-info*)))
    (if conn
	(begin

    (print "msg: " msg)
    (if (and port host)
	(begin
	  (print "sending " msg " to " addr)
	  (nmsg:open-send-receive addr msg))
	#f)))

(define (server:get-my-best-address)
  (ip->string (car (filter (lambda (x)
			     (not (eq? (u8vector-ref x 0) 127)))
			   (vector->list (hostinfo-addresses (hostname->hostinfo "zeus")))))))
;; get the response

;; whoami? I am my pkt
;;
(define (server:receive rep)
  (let ((instr (nmsg:recv rep)))
(define (server:whoami? area)
  (hash-table-ref/default (area-hosts area)(area-pktid area) #f))

    (if (string? instr)
	(with-input-from-string instr read)
	instr)))
	 
;;======================================================================
;; "Client side" operations
;;======================================================================

;; is the server alive?
;;
(define (server:ping servpkt)
  (let* ((start-time (current-milliseconds))
	 (res        (server:send servpkt "ping" "t")))
    (cons (- (current-milliseconds) start-time)
	  (equal? res "got ping"))))
	  res))) ;; (equal? res "got ping"))))

;; look up all pkts and get the server id (the hash), port, host/ip
;; store this info in the global struct *area-info*
;;
(define (server:get-all)
  ;; readll all pkts
  ;; foreach pkt; if it isn't me ping the server; if alive, add to hosts hash, else rm the pkt
  (let ((all-pkts (server:get-all-server-pkts *area-info*)))
    (for-each
     (lambda (servpkt)
       (let* ((res (server:ping servpkt)))
	 (print "Got " res " from server " servpkt)))
     all-pkts)))

;; send out an "I'm about to exit notice to all known servers"
;;
(define (server:imminent-death)
  '())

(define (server:get-my-best-address)
  (ip->string (car (filter (lambda (x)
			     (not (eq? (u8vector-ref x 0) 127)))
			   (vector->list (hostinfo-addresses (hostname->hostinfo "zeus")))))))

;; whoami? I am my pkt
;;
(define (server:whoami? area)
  (hash-table-ref/default (area-hosts area)(area-pktid area) #f))

;;======================================================================
;; S E R V E R   U T I L I T I E S 
;;======================================================================

;; get a signature for identifing this process
(define (server:get-process-signature)
  (cons (get-host-name)(current-process-id)))