Megatest

Check-in [167b804135]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added work and notification mailboxes to tcp-server demo stuff
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001
Files: files | file ages | folders
SHA1: 167b8041354abe503658667b77c5f58c4b63b4c0
User & Date: jmoon18 on 2022-01-13 16:38:50
Other Links: branch diff | manifest | tags
Context
2022-01-13
18:50
Merged fork check-in: 6bbd0fa9a2 user: matt tags: v2.0001, ulex-smoketest
16:38
Added work and notification mailboxes to tcp-server demo stuff check-in: 167b804135 user: jmoon18 tags: v2.0001
11:26
Test servers for tcp-server check-in: 0ccade1059 user: jmoon18 tags: v2.0001
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified ulex-trials/server-one.scm from [aaab534b38] to [dc113b1a00]. 

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

(require-extension tcp-server format (chicken tcp) (chicken io) (chicken string) sql-de-lite srfi-18 simple-exceptions)


(let* ((th1 (make-thread (lambda ()

((make-tcp-server
  (tcp-listen 6505)
  (lambda ()
    (let* ((db (open-database "test.db"))
           (rec-data (read-line)))

    (exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") rec-data (conc "Server One Response: " rec-data))


    (format (current-error-port) rec-data)
    (write-line (conc "Response to: " rec-data))
    (close-database db)
    )))
#t))
"Ulex command loop"))
(th2 (make-thread (lambda () 
         (print "Jeff is here")  
         (let loop ((entries 0))  
         (thread-sleep! 0.05)
         (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" 6504))
         (write-line (conc "entries" entries) o)
         (print (read-line i))
         (close-input-port i)
         (close-output-port o))
         (loop (+ entries 1)))) "jeff")))





















(thread-start! th1)
(thread-start! th2)


(thread-join! th2)
)

(print "Done here")

|
>
>
|




|
|
>
|
>
>
|
|
|


|



|



|



|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>





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 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 6505)
  (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" 6504))
         (serialize (list "localhost:6505" "from-server-one") 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))
           (mailbox-send! notify-mailbox (list 'ack))
           (thread-sleep! 0.01)
         (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" 6504))
           (serialize (list 'ack "from-server-one") 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")

Modified ulex-trials/server-two.scm from [d6dd6aa922] to [385cb5b500]. 

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

(require-extension tcp-server format (chicken tcp) (chicken io) (chicken string) sql-de-lite srfi-18 simple-exceptions)


(let* ((th1 (make-thread (lambda ()

((make-tcp-server
  (tcp-listen 6504)
  (lambda ()
    (let* ((db (open-database "test.db"))
           (rec-data (read-line)))

    (exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") rec-data (conc "Server Two Response: " rec-data))


    (format (current-error-port) rec-data)
    (write-line (conc "Response to: " rec-data))
    (close-database db)
    )))
#t))
"Ulex command loop"))
(th2 (make-thread (lambda () 
         (print "Jeff is here")  
         (let loop ((entries 500))  
         (thread-sleep! 0.01)
         (print "Preparing to send entries" entries)
         (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) 
         (define-values (i o) (tcp-connect "localhost" 6505))
         (write-line (conc "entries" entries) o)

         (print (read-line i))
         (close-input-port i)
         (close-output-port o))
         (loop (+ entries 1)))) "jeff")))





















(thread-start! th1)
(thread-start! th2)


(thread-join! th2)
)

(print "Done here")

|
|
>
|




|
|
>
|
>
>
|
|
|


|


|

|


<
>



|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>





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 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 6504)
  (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" 6505))

         (serialize (list "localhost:6505" "from-server-two") 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))
           (mailbox-send! notify-mailbox (list 'ack))
           (thread-sleep! 0.01)
         (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" 6505))
           (serialize (list 'ack "from-server-two") 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")

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