Megatest

test-rpc.scm at [b7dc85fea2]
Login

File ulex/test-rpc.scm artifact 307b9d1376 part of check-in b7dc85fea2


(use rpc posix srfi-1 pkts)

(define *usage* "Usage: test-rpc") ;;  myportnum [port-nums...]")

#;(define *portnums* (let ((args (command-line-arguments)))
		     (if (null? args)
			 (begin
			   (print *usage*)
			   (exit))
			 (map string->number args))))

#;(if (not (null? (filter (lambda (x)(not x)) *portnums*)))
    (begin
      (print "ERROR: portnumbers must all be integers, you gave " *portnums*)
      (exit)))


(define (find-free-port-and-open port)
  (handle-exceptions
   exn
   (begin
     (print "Failed to bind to port " (rpc:default-server-port) ", trying next port")
     (find-free-port-and-open (+ port 1)))
   (rpc:default-server-port port)
   (tcp-read-timeout 120000)
   (tcp-listen (rpc:default-server-port) )
   port))

#;(define *myportnum* (car *portnums*))
#;(define *clients*   (cdr *portnums*))

#;(print "Setting up server on " *myportnum*)
;; (rpc:default-server-port *myportnum*)
(define *myportnum* (find-free-port-and-open 20000)) ;; *myportnum*))



;;;; server.scm
(rpc:publish-procedure!
 'foo
 (lambda (x)
   (print "foo: " x)
   (conc "response from " *myportnum*)))

(define *queue* (make-queue))

(rpc:publish-procedure!
 'queue-add
 (lambda (dbfname qrystr raddr rport . params)
   (queue-add! *queue* (list dbfname qrystr raddr rport params))))

;;;; client.scm
(define (call n)
  (let ((port (list-ref *clients* (random (length *clients*)))))
    (print "calling to " port)
    ((rpc:procedure 'foo "localhost" port) n)))

(rpc:publish-procedure!
 'fini
 (lambda () (print "fini") (thread-start! (lambda () (thread-sleep! 3) (print "terminate") (exit))) #f))

(let* ((server-th (make-thread (lambda ()
				 ((rpc:make-server (tcp-listen *myportnum*)) #t)) ;; (rpc:default-server-port))) #t))
			       "server thread"))
       (timer-th  (make-thread (lambda ()
				 (thread-sleep! 30)
				 (print "Node " *myportnum* ", 30 seconds up. Exiting.")
				 (exit)))))
  (thread-start! server-th)
  (thread-start! timer-th)
  (thread-sleep! 1)
  (do ((i 10000 (sub1 i)))
      ((zero? i))
    (print "-> " (call (random 100)))))