Megatest

Changes On Branch 4faf3cbddf04f56d
Login

Changes In Branch v2.0001-ulex-testing-jm Excluding Merge-Ins

This is equivalent to a diff from b4ff9e2f1d to 4faf3cbddf

2022-01-14
16:24
Added some testing scripts for ulex and standalone tcp-server Leaf check-in: 4faf3cbddf user: jmoon18 tags: v2.0001-ulex-testing-jm
05:49
Move close-output-port to right after sending serialize data Leaf check-in: ec82c7ffc8 user: matt tags: v2.0001-blocking-fix
2022-01-12
16:40
wip, misc cleanup and reduce some messages. check-in: 20b4054f76 user: matt tags: v2.0001
12:23
Added additional cleanup for ulex-tests check-in: f012b3cc77 user: jmoon18 tags: v2.0001
2022-01-11
09:00
Go back to single log for a server. The splitting of the logs was not proving useful check-in: b4ff9e2f1d user: matt tags: v2.0001
2022-01-10
17:46
Just randomly tried mailbox/mailbox and it seems to be working pretty well. Wierd. check-in: 3d29ed0bb1 user: matt tags: v2.0001

Modified megatest.scm from [b7fe71f476] to [b63a7b05a0].

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
;;

(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))







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
;;

(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))
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
	  srfi-98
	  srfi-69

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







|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
	  srfi-98
	  srfi-69

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

Modified ulex-trials/Makefile from [cec464a43d] to [e184d26602].

1
2
3



4
5
6
7
8
ulex-test : ulex-test.scm ../ulex/ulex.scm
	csc ulex-test.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*



>
>
>





1
2
3
4
5
6
7
8
9
10
11
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*

Added ulex-trials/a.scm version [4280e836f1].





































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
(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)


Added ulex-trials/server-generic.scm version [d4c70e5b0d].



























































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
(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")

Added ulex-trials/server-one.inc.scm version [bbf8c2a727].







>
>
>
1
2
3
(set! myport 6505)
(set! yourport 6504)
(set! mymessage "from-server-one")

Added ulex-trials/server-one.scm version [8e85b987b3].





>
>
1
2
(include "server-one.inc.scm")
(include "server-generic.scm")

Added ulex-trials/server-two.inc.scm version [83195f04a4].







>
>
>
1
2
3
(set! myport 6504)
(set! yourport 6505)
(set! mymessage "from-server-two")

Added ulex-trials/server-two.scm version [62f1a11665].





>
>
1
2
(include "server-two.inc.scm")
(include "server-generic.scm")

Modified ulex/ulex.scm from [70c15d4319] to [94952cc174].

230
231
232
233
234
235
236

237
238
239
240
241
242
243
244
245
246
247
248
249
	  #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))
			   (begin
			     (print "ERROR: send called but no receiver has been setup. Please call setup first!")
			     #f))))
	      (close-input-port inp)
	      (close-output-port oup)
	      ;; (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)







>





<







230
231
232
233
234
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
	  #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)
278
279
280
281
282
283
284

285
286
287
288
289
290
291
	    #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

	 (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)))







>







278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
	    #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)))