Megatest

;;

(declare (uses dbi))
(declare (uses pkts))
(declare (uses stml2))
(declare (uses cookie))
(declare (uses csv-xml))
;;(declare (uses hostinfo))

(declare (uses adjutant))
(declare (uses archivemod))
(declare (uses apimod))
(declare (uses autoload))
(declare (uses bigmod))
(declare (uses commonmod))

	  srfi-98
	  srfi-69

	  ;; local modules
	  autoload
	  adjutant
	  csv-xml
	  ;;hostinfo
	  mtver
	  mutils
	  cookie
	  csv-xml
	  ducttape-lib
	  (prefix mtargs args:)
	  pkts

ulex-test : ulex-test.scm ../ulex/ulex.scm
	csc ulex-test.scm

ab : a b ../ulex/ulex.scm
	csc a.scm
	csc b.scm
test : ulex-test
	for x in $$(seq 9);do export NBFAKE_LOG=NBFAKE_$$x;sleep 1;nbfake ./ulex-test run 828$$x;echo $$cmd;$$cmd;done

clean :
	rm -f .runners/* NBFAKE*

(include "../ulex/ulex.scm")

(module ulex-test *
	
(import scheme
	(chicken io)
	(chicken base)
	(chicken time)
	(chicken file)
	(chicken file posix)
        (chicken string)
	(chicken process-context)
	(chicken process-context posix)
        miscmacros
;;         nng
        srfi-18
	srfi-69
        test
	matchable
	typed-records
	system-information
	directory-utils

	ulex
	)

(define help "Usage: ulex-test COMMAND
  where COMMAND is one of:
    run host:port  : start test server - start several in same dir
")

(define (call uconn msg addr)
  (print "Call for : " addr)
  (print "Sent: "msg" to " addr ", received: "
	 (send-receive uconn addr 'hello msg)))

;; start    => hello 0
;; hello 0  => hello 1
;; hello 1  => hello 2
;;  ...
;; hello 11 => 'done
;;
(define (process-message mesg)
  (print "In process-message")
  (let ((parts (string-split mesg)))
    (match
     parts
     ((msg c)
      (let ((count (string->number c)))
	(if (> count 10)
	    'done
	    (conc msg " " (if count count 0)))))
     ((msg)
      (conc msg " 0"))
     (else
      "hello 0"))))

(define (main)
(let* ((th1 (make-thread (lambda ()
  (match
   (command-line-arguments)
   ((run myport newport)
      (print "New stuff for IPC")
      (let* ((port (string->number myport))
              (endtimes (+ (current-seconds) 60))
              (handler (lambda (rem-host-port qrykey cmd params)
                   (process-message params)
                   ;;"hello1"
               ))
              (uconn (run-listener handler port)))
      (print "Listener up")
      ;;(thread-sleep! 8.0)
      (call uconn (conc "hello-from-"myport"-to-"newport) (conc newport))
      (let loop ((entries 0))  
        (call uconn (conc "hello-from-"myport"-to-"newport) (conc newport))
        (thread-sleep! 0.1)
      (loop 1))
      )
   )
   ((cmd)(print "ERROR: command "cmd", not recognised.\n\n"help))
   (else
    (print help))))
))
(th2 (make-thread (lambda()
  (let loop2 ((entries 1))
      (loop2 1)))))
)
(thread-start! th1)
(thread-start! th2)
(thread-join! th2)
))

) ;; end module

(import ulex-test)
(main)

(import tcp-server format (chicken random) (chicken tcp) (chicken io) (chicken string) (prefix sqlite3 sqlite3:) sql-de-lite srfi-18 simple-exceptions mailbox s11n)
(let* ((work-mailbox (make-mailbox))
       (notify-mailbox (make-mailbox))
(th1 (make-thread (lambda ()

((make-tcp-server
  (tcp-listen myport)
  (lambda ()
    (let* ((db (sqlite3:open-database "test.db"))
           (rec-data (deserialize)))
    (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
    ;;(exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") "something" (conc "Server One Response: " "something else"))
    (sqlite3:execute db "INSERT INTO entries (received,send) VALUES (?,?);" "something" (conc "Server One Response: " "something else"))
    (mailbox-send! work-mailbox rec-data)
    (format (current-error-port) (conc rec-data))
    (write-line (conc "Response to: " (conc rec-data)))
    ;;(close-database db)
    )))
#t))
"receive"))
(th2 (make-thread (lambda () 
         (print "Jeff is here")  
         (let loop ((entries 0))  
         (thread-sleep! 0.01)
         (print "Preparding to send entries" entries)
         (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) 
         (define-values (i o) (tcp-connect "localhost" yourport))
         (serialize (list "localhost:6505" mymessage (random-bytes) (random-bytes) (random-bytes) (random-bytes)) o)
         (print (read-line i))
         (close-input-port i)
         (close-output-port o))
         (loop (+ entries 1)))) "send"))
(th3 (make-thread (lambda ()
         (print "In mailbox thread")
         (let loop2 ((entries2 0))
           (print "Processing: " (mailbox-receive! work-mailbox))
           (thread-sleep! (* 10 (pseudo-random-real)))
           (mailbox-send! notify-mailbox (list 'ack))
         (loop2 1))) "processing"))
(th4 (make-thread (lambda ()
         (print "In notify-mailbox thread")
         (let loop3 ((entries3 0))
           (print "Notifying: " (mailbox-receive! notify-mailbox))
           (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) 
           (define-values (i o) (tcp-connect "localhost" yourport))
           (serialize (list 'ack mymessage) o)
           (print (read-line i))
           (close-input-port i)
           (close-output-port o))
           ;;(thread-sleep! 1)
         (loop3 1))) "notify"))

)
(thread-start! th1)
(thread-start! th2)
(thread-start! th3)
(thread-start! th4)
(thread-join! th2)
)

(print "Done here")

(set! myport 6505)
(set! yourport 6504)
(set! mymessage "from-server-one")

(include "server-one.inc.scm")
(include "server-generic.scm")

(set! myport 6504)
(set! yourport 6505)
(set! mymessage "from-server-two")

(include "server-two.inc.scm")
(include "server-generic.scm")

	  #f
	(begin
	  ;; (mutex-lock! *send-mutex*)
	  (let-values (((inp oup)(tcp-connect host-port)))
	    (let ((res (if (and inp oup)
			   (begin
			     (serialize dat oup)
	             (close-output-port oup)
			     (deserialize inp))
			   (begin
			     (print "ERROR: send called but no receiver has been setup. Please call setup first!")
			     #f))))
	      (close-input-port inp)

	      ;; (mutex-unlock! *send-mutex*)
	      res)))))))) ;; res will always be 'ack unless return-method is direct
  
;; send a request to the given host-port and register a mailbox in udata
;; wait for the mailbox data and return it
;;
(define (send-receive uconn host-port cmd data)

	    #f))))
      ((mailbox) 
       (let* ((cmbox     (get-cmbox uconn)) ;; would it be better to keep a stack of mboxes to reuse?
	      (qrykey    (car cmbox))
	      (mbox      (cdr cmbox))
	      (mbox-time (current-milliseconds))
	      (sres      (send uconn host-port qrykey cmd data))) ;; short res
          ;;(thread-sleep! 1)
	 (if (eq? sres 'ack)
	     (let* ((mbox-timeout-secs    120 #;(if (eq? 'primordial (thread-name (current-thread)))
					  #f
					  120)) ;; timeout)
		    (mbox-timeout-result 'MBOX_TIMEOUT)
		    (res                  (mailbox-receive! mbox mbox-timeout-secs mbox-timeout-result))
		    (mbox-receive-time    (current-milliseconds)))