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