OpenSSL more compatible with tcp unit

This commit is contained in:
Jay McCarthy 2010-10-06 10:20:11 -06:00
parent 85f38415bc
commit e847632456
2 changed files with 9 additions and 6 deletions

View File

@ -941,8 +941,10 @@
(values (car p) (cdr p)))))
(define (ssl-addresses p [port-numbers? #f])
(let-values ([(mzssl input?) (lookup 'ssl-addresses "SSL port" p)])
(tcp-addresses (if input? (mzssl-i mzssl) (mzssl-o mzssl))
(let-values ([(mzssl input?) (lookup 'ssl-addresses "SSL port or listener" p)])
(tcp-addresses (if (eq? 'listener input?)
(ssl-listener-l mzssl)
(if input? (mzssl-i mzssl) (mzssl-o mzssl)))
port-numbers?)))
(define (ssl-abandon-port p)
@ -960,12 +962,13 @@
(define (ssl-listen port-k
[queue-k 5] [reuse? #f] [hostname-or-#f #f]
[protocol-symbol-or-context default-encrypt])
(let ([ctx (if (ssl-server-context? protocol-symbol-or-context)
(let* ([ctx (if (ssl-server-context? protocol-symbol-or-context)
protocol-symbol-or-context
(make-context 'ssl-listen protocol-symbol-or-context
"server context, " #f))]
[l (tcp-listen port-k queue-k reuse? hostname-or-#f)])
(make-ssl-listener l ctx)))
[l (tcp-listen port-k queue-k reuse? hostname-or-#f)]
[ssl-l (make-ssl-listener l ctx)])
(register ssl-l ssl-l 'listener)))
(define (ssl-close l)
(unless (ssl-listener? l)

View File

@ -180,7 +180,7 @@ The @scheme[ssl-accept/enable-break] procedure is analogous to
Analogous to @racket[tcp-abandon-port].}
@defproc[(ssl-addresses [p ssl-port?][port-numbers? any/c #f]) void?]{
@defproc[(ssl-addresses [p (or/c ssl-port? ssl-listener?)][port-numbers? any/c #f]) void?]{
Analogous to @racket[tcp-addresses].}