a976c56cb9
Fix an error message broken by earlier debugging, and also fix long-standing shutdown problems. Move basic tests to more standard location.
86 lines
2.3 KiB
Racket
86 lines
2.3 KiB
Racket
#lang racket
|
|
(require openssl/mzssl)
|
|
|
|
(define pem (build-path (collection-path "openssl")
|
|
"test.pem"))
|
|
|
|
(define errs? #f)
|
|
(define (test expect f . args)
|
|
(printf "~s ~s => " f args)
|
|
(define v (apply f args))
|
|
(printf "~s\n" v)
|
|
(unless (equal? expect v)
|
|
(printf "BUT EXPECTED ~s\n" expect)
|
|
(set! errs? #t)))
|
|
|
|
(define-syntax-rule (err/rt-test e exn?)
|
|
(test 'ok values (with-handlers ([exn? (lambda (x) 'ok)])
|
|
e)))
|
|
|
|
(define (test-ssl limit buffer? close?)
|
|
;; Test SSL communication using a limited pipe.
|
|
;; (Using a pipe limited to a small buffer helps make sure
|
|
;; that race conditions and deadlocks are eliminated in the
|
|
;; implementation.)
|
|
(let-values ([(r1 w2) (make-pipe limit)]
|
|
[(r2 w1) (make-pipe limit)])
|
|
(define t1
|
|
(thread (lambda ()
|
|
(let-values ([(r w) (ports->ssl-ports
|
|
r1 w1
|
|
#:mode 'connect
|
|
#:close-original? close?
|
|
#:shutdown-on-close? #t)])
|
|
(unless buffer?
|
|
(file-stream-buffer-mode w 'none))
|
|
(test 5 write-bytes #"abcde" w)
|
|
(when buffer?
|
|
(flush-output w))
|
|
(test "hello" read-string 5 r)
|
|
(test eof read-string 5 r)
|
|
(close-input-port r)
|
|
(close-output-port w)))))
|
|
(define t2
|
|
(thread (lambda ()
|
|
(define ctx (ssl-make-server-context 'sslv2-or-v3))
|
|
(ssl-load-certificate-chain! ctx pem)
|
|
(ssl-load-private-key! ctx pem)
|
|
(let-values ([(r w) (ports->ssl-ports
|
|
r2 w2
|
|
#:context ctx
|
|
#:mode 'accept
|
|
#:close-original? close?
|
|
#:shutdown-on-close? #t)])
|
|
(test #"abcde" read-bytes 5 r)
|
|
(test 5 write-string "hello" w)
|
|
(close-output-port w)))))
|
|
(thread-wait t1)
|
|
(thread-wait t2)
|
|
;; Check that ports were closed or not:
|
|
(if close?
|
|
(begin
|
|
(err/rt-test (read-byte r1) exn:fail?)
|
|
(err/rt-test (write-byte 0 w1) exn:fail?))
|
|
(let ([v (random 256)]
|
|
[v2 (random 256)])
|
|
(test (void) write-byte v w2)
|
|
(test v read-byte r1)
|
|
(test (void) write-byte v2 w1)
|
|
(test v2 read-byte r2)))
|
|
(void)))
|
|
|
|
(test-ssl 1 #t #t)
|
|
(test-ssl 10 #t #t)
|
|
(test-ssl 100 #t #t)
|
|
(test-ssl 1 #f #t)
|
|
(test-ssl 10 #f #t)
|
|
(test-ssl 100 #f #t)
|
|
|
|
(test-ssl 100 #t #f)
|
|
(test-ssl 100 #f #f)
|
|
|
|
(newline)
|
|
(when errs?
|
|
(error "There were test failures"))
|
|
(printf "All tests passed.\n")
|