Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Tests! Not working yet, though. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
0c6903729fc0edc0afbeaa4992d1aa7b |
| User & Date: | alaric 2018-02-28 21:17:47 |
Context
|
2020-05-28
| ||
| 15:32 | Merge check-in: 16df45c616 user: alaric tags: trunk | |
|
2018-02-28
| ||
| 21:17 | Tests! Not working yet, though. check-in: 0c6903729f user: alaric tags: trunk | |
|
2017-12-29
| ||
| 00:32 | Tidied up error handling, added separate client and server demos. check-in: 986d72288b user: alaric tags: trunk | |
Changes
Changes to bokbok.scm.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 | (use matchable) (use tweetnacl) (use socket) (use srfi-27) (use moa) ;; from srfi-27 (use entropy-unix) ;; from srfi-27 ;; FIXME: Accept a hostname for open-connection, and look it up ;; FIXME: Support sending creds over a unix-domain socket instead of a username. ;; FIXME: User data field in a connection | > > > > > > > > > > > > | 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 | (use matchable) (use tweetnacl) (use socket) (use srfi-27) (use moa) ;; from srfi-27 (use entropy-unix) ;; from srfi-27 ;; FIXME: Log handler exceptions - and call (get-call-chain) for details ;; FIXME: Try-again-later responses to requests, caused by a ;; configurable concurrent request limit or a special condition ;; type. CLient sleeps and retries (sleep time is listed in the ;; try-again-later response). ;; FIXME: TCP connection handshake to include option to redirect to ;; another server IP:port, controlled by the open handlers ;; open-connection gets all A records and tries until it gets in ;; FIXME: Accept a hostname for open-connection, and look it up ;; FIXME: Support sending creds over a unix-domain socket instead of a username. ;; FIXME: User data field in a connection |
| ︙ | ︙ |
Added tests/run.scm.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 |
(use bokbok)
(use srfi-18)
(use test)
(define (make-test-client addr user key)
(let ((callback-max 0)
(close-count 0)
(mutex (make-mutex)))
(values
;; get counts closure
(lambda ()
(mutex-lock! mutex)
(let ((cm callback-max)
(cc close-count))
(mutex-unlock! mutex)
(values cm cc)))
;; connection object
(open-connection addr user key
(lambda (con request)
(match request
(("count" numstr)
(let ((num (string->number numstr)))
(mutex-lock! mutex)
(when (> num callback-max)
(set! callback-max num))
(mutex-unlock! mutex)))))
(lambda (con)
(mutex-lock! mutex)
(set! close-count (+ close-count 1))
(mutex-unlock! mutex))))))
(define (make-test-server addr backlog user->key)
(let ((total 0)
(close-count 0)
(mutex (make-mutex)))
(values
;; get counts closure
(lambda ()
(mutex-lock! mutex)
(let ((t total)
(cc close-count))
(mutex-unlock! mutex)
(values t cc)))
;; connection object
(start-server addr backlog user->key
(lambda (con)
(mutex-lock! mutex)
(let ((total-copy total))
(mutex-unlock! mutex)
(request! con (list "count"
(number->string total-copy)))))
(lambda (con request)
(match request
(("add" numstr)
(let ((num (string->number numstr)))
(mutex-lock! mutex)
(set! total (+ total num))
(let ((total-copy total))
(mutex-unlock! mutex)
(request! con (list "count"
(number->string total-copy))))))))
(lambda (con)
(mutex-lock! mutex)
(set! close-count (+ close-count 1))
(mutex-unlock! mutex))))))
(define (run-test client-addr server-addr backlog encrypt?)
(receive
(get-server-counts server)
(make-test-server server-addr backlog
(if encrypt? (lambda (username)
(match username
("myuser" (passphrase->key "mypassphrase"))
(else #f)))
#f))
(receive
(get-client-counts client)
(make-test-client
client-addr
(if encrypt? "myuser" #f)
(if encrypt? (passphrase->key "mypassphrase") #f))
;; Send test load: 10 threads sending 1..10 each
(let ((threads
(map
(lambda (thread-number)
(let ((thread
(make-thread
(lambda ()
(for-each
(lambda (idx)
(request! client
(list "add" (number->string idx))))
(iota 10))))))
(thread-start! thread)
thread))
(iota 10))))
;; Wait for them all to finish
(for-each
thread-join!
threads))
;; Wait to make sure all callbacks have come back
(thread-sleep! 1)
;; Close client
(close-connection! client)
;; Close server
(stop-server! server)
(wait-until-server-stopped server)
;; Check everything is as expected
;; 450 = number of threads * sum of 1..number of iterations
;; = 10 * sum of 1..10
;; = 10 * 45
;; = 450
(let-values (((client-total client-closes) (get-client-counts))
((server-total server-closes) (get-server-counts)))
(test "Client total" 450 client-total)
(test "Client closes" 0 client-closes)
(test "Server total" 450 server-total)
(test "Server closes" 1 server-closes)))))
(run-test '(tcp "localhost" 9988) '(tcp #f 9988) 1 #f)
|