Megatest

Check-in [4faf3cbddf]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added some testing scripts for ulex and standalone tcp-server
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v2.0001-ulex-testing-jm
Files: files | file ages | folders
SHA1: 4faf3cbddf04f56d7628d5d2c33aecef4ca2d806
User & Date: jmoon18 on 2022-01-14 16:24:09
Other Links: branch diff | manifest | tags
Context
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
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
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

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

︙
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31

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

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
	  ;;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

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

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




︙


278
279
280
281
282
283
284

285
286
287
288
289
290
291

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




︙












This page was generated in about
0.123s by
Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00