Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -107,12 +107,12 @@ mofiles/stml2.o : mofiles/cookie.o mofiles/dbi.o mofiles/tasksmod.o : mofiles/pgdb.o mofiles/dbmod.o mofiles/testsmod.o : mofiles/commonmod.o mofiles/testsmod.o : mofiles/itemsmod.o mofiles/rmtmod.o mofiles/tasksmod.o -# split modules -mofiles/ulex.o : ulex/ulex.scm +# split modules. Note: we can switch between ulex and ulex simple. +mofiles/ulex.o : ulex/ulex.scm ulex-simple/ulex.scm dashboard.o megatest.o : db_records.scm megatest-fossil-hash.scm ADTLSCR=mt_laststep mt_runstep mt_ezstep ADDED ulex-trials/Makefile Index: ulex-trials/Makefile ================================================================== --- /dev/null +++ ulex-trials/Makefile @@ -0,0 +1,8 @@ +ulex-test : ulex-test.scm + csc ulex-test.scm + +test : ulex-test + ./ulex-test do-test + +clean : + rm -f .runners/* NBFAKE* ADDED ulex-trials/ulex-test.scm Index: ulex-trials/ulex-test.scm ================================================================== --- /dev/null +++ ulex-trials/ulex-test.scm @@ -0,0 +1,157 @@ +(module nng-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 + ) + +(define help "Usage: nng-test COMMAND + where COMMAND is one of: + do-test : run the basic req/rep test + run tcp://host:port : start test server - start several in same dir +") + +(define address-tcp-1 "tcp://localhost:5555") +(define address-tcp-2 "tcp://localhost:6666") + +(define address-inproc-1 "inproc://local1") +(define address-inproc-2 "inproc://local2") + +;;; +;;; Req-Rep +;;; +(define (make-listening-reply-socket address) + (let ((socket (make-rep-socket))) + (socket-set! socket 'nng/recvtimeo 2000) + (nng-listen socket address) + socket)) + +(define (make-dialed-request-socket address) + (let ((socket (make-req-socket))) + (socket-set! socket 'nng/recvtimeo 2000) + (nng-dial socket address) + socket)) + +(define (req-rep-test address) + (let ((rep (make-listening-reply-socket address)) + (req (make-dialed-request-socket address))) + (nng-send req "message 1") + (nng-recv rep) + (nng-send rep "message") + (begin0 + (nng-recv req) + (nng-close! rep)))) + +(define (do-test) + (test-group "nng" + (test "tcp req-rep" + "message" + (req-rep-test address-tcp-1)) + (test "inproc req-rep" + "message" + (req-rep-test address-inproc-1))) + (test-exit)) + +;; this should be run in a thread +(define (run-listener-responder socket myaddr) + (let loop ((status 'running)) + (let* ((msg (nng-recv socket)) + (response (process-message msg))) + (if (not (eq? response 'done)) + (begin + (nng-send socket response) + (loop status)))))) + +(define *channels* (make-hash-table)) + +(define (call channels msg addr) + (let* ((csocket (hash-table-ref/default channels addr #f)) + (socket (or csocket (make-dialed-request-socket addr)))) + (nng-send socket msg) + (print "Sent: "msg", received: "(nng-recv socket)) + (if (not (hash-table-exists? channels addr)) + (hash-table-set! channels addr socket)))) + +;; start => hello 0 +;; hello 0 => hello 1 +;; hello 1 => hello 2 +;; ... +;; hello 11 => 'done +;; +(define (process-message mesg) + (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) + (match + (command-line-arguments) + (("do-test")(do-test)) + ((run myaddr) + ;; start listener + ;; put myaddr into file by host-pid in .runners + ;; for 1 minute + ;; get all in .runners + ;; call each with a message + ;; + (let* ((endtimes (+ (current-seconds) 20)) ;; run for 20 seconds + (socket (make-listening-reply-socket myaddr)) + (rfile (conc ".runners/"(get-host-name)"-"(current-process-id))) + (th1 (make-thread (lambda () + (run-listener-responder socket myaddr) + ) + "responder"))) + (if (not (and (file-exists? ".runners") + (directory? ".runners"))) + (create-directory ".runners" #t)) + (with-output-to-file rfile + (lambda () + (print myaddr))) + (thread-start! th1) + (let loop ((entries '())) + (if (> (current-seconds) endtimes) + (begin + (delete-file* rfile) + (sleep 1) + (exit)) + (if (null? entries) + (loop (glob ".runners/*")) + (let* ((entry (car entries)) + (destaddr (with-input-from-file entry read-line))) + (call *channels* (conc "hello-from-"destaddr) destaddr) + ;; (thread-sleep! 0.025) + (loop (cdr entries)))))))) + ((cmd)(print "ERROR: command "cmd", not recognised.\n\n"help)) + (else + (print help)))) + +) ;; end module + +(import nng-test) +(main) + + Index: ulex.scm ================================================================== --- ulex.scm +++ ulex.scm @@ -19,5 +19,6 @@ ;;====================================================================== (declare (unit ulex)) (include "ulex/ulex.scm") +;; (include "ulex-simple/ulex.scm") Index: ulex/ulex.scm ================================================================== --- ulex/ulex.scm +++ ulex/ulex.scm @@ -175,10 +175,12 @@ (tcp-close (udat-socket uconn))) ;;====================================================================== ;; peers and connections ;;====================================================================== + +(define *send-mutex* (make-mutex)) ;; send structured data to recipient ;; ;; NOTE: qrykey is what was called the "cookie" previously ;; @@ -198,10 +200,12 @@ (if isme (ulex-handler udata dat) ;; no transmission needed (handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC? exn #f + (begin + ; (mutex-lock! *send-mutex*) (let-values (((inp oup)(tcp-connect host-port))) (let ((res (if (and inp oup) (begin (serialize dat oup) (deserialize inp)) ;; yes, we always want an ack @@ -208,11 +212,12 @@ (begin (print "ERROR: send called but no receiver has been setup. Please call setup first!") #f)))) (close-input-port inp) (close-output-port oup) - res)))))) ;; res will always be 'ack + ; (mutex-unlock! *send-mutex*) + res))))))) ;; res will always be 'ack ;; 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) @@ -238,12 +243,12 @@ (begin (print "WARNING: mbox timed out for query "cmd", with data "data) #f) ;; convert to raising exception? res)) (begin - (print "ERROR: Communication failed? Got "sres) - #f)))))) ;; #f means failed to communicate + ;; (print "ERROR: Communication failed? Got "sres) + #f)))))) ;;====================================================================== ;; responder side ;;======================================================================