openssl: add 'secure protocol shortcut
The 'secure protocol symbol is just a shorthand for `(ssl-secure-client-context)`, but it helps highlight that the default 'auto isn't secure, and having a plain symbol smooths the connection to native Win32 and OS X implementations of SSL.
This commit is contained in:
parent
1e5da68b88
commit
92f1bfa4d2
|
@ -12,7 +12,7 @@
|
|||
|
||||
(define collection 'multi)
|
||||
|
||||
(define version "6.3.0.11")
|
||||
(define version "6.3.0.12")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
@ -66,7 +66,9 @@ using the functions described in @secref["cert-procs"].
|
|||
[port-no (integer-in 1 65535)]
|
||||
[client-protocol
|
||||
(or/c ssl-client-context?
|
||||
'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'secure
|
||||
'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'auto])
|
||||
(values input-port? output-port?)]{
|
||||
|
||||
|
@ -75,6 +77,10 @@ Connect to the host given by @racket[hostname], on the port given by
|
|||
return values are as for @racket[tcp-connect]: an input port and an
|
||||
output port.
|
||||
|
||||
The default @racket['auto] protocol is @bold{insecure}. Use
|
||||
@racket['secure] for a secure connection. See
|
||||
@racket[ssl-secure-client-context] for details.
|
||||
|
||||
The optional @racket[client-protocol] argument determines which
|
||||
encryption protocol is used, whether the server's certificate is
|
||||
checked, etc. The argument can be either a client context created by
|
||||
|
@ -104,14 +110,16 @@ well-defined communication pattern, where theres no question of
|
|||
whether the other end is supposed to be sending or reading data.
|
||||
}
|
||||
|
||||
}
|
||||
@history[#:changed "6.3.0.12" @elem{Added @racket['secure] for
|
||||
@racket[client-protocol].}]}
|
||||
|
||||
@defproc[(ssl-connect/enable-break
|
||||
[hostname string?]
|
||||
[port-no (integer-in 1 65535)]
|
||||
[client-protocol
|
||||
(or/c ssl-client-context?
|
||||
'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'secure 'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'auto])
|
||||
(values input-port? output-port?)]{
|
||||
|
||||
|
@ -149,11 +157,13 @@ The context is cached, so different calls to
|
|||
|
||||
|
||||
@defproc[(ssl-make-client-context
|
||||
[protocol (or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12) 'auto])
|
||||
[protocol (or/c 'secure 'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'auto])
|
||||
ssl-client-context?]{
|
||||
|
||||
Creates a context to be supplied to @racket[ssl-connect]. The context
|
||||
is @bold{insecure} unless additional steps are taken; see
|
||||
is @bold{insecure} unless @racket['secure] is supplied or additional steps are taken; see
|
||||
@racket[ssl-secure-client-context] for details.
|
||||
|
||||
The client context identifies a communication protocol (as selected by
|
||||
|
@ -164,6 +174,7 @@ certificates.
|
|||
|
||||
The @racket[protocol] should be one of the following:
|
||||
@itemize[
|
||||
@item{@racket['secure] : Equivalent to @racket[(ssl-secure-client-context)].}
|
||||
@item{@racket['auto] : Automatically negotiates the protocol version
|
||||
from those that this library considers sufficiently secure---currently
|
||||
TLS versions 1.0 and higher, but subject to change.}
|
||||
|
@ -182,27 +193,29 @@ Note that SSL 2.0 support has been removed from many platforms.}
|
|||
]
|
||||
|
||||
Not all protocol versions are supported by all servers. The
|
||||
@racket['auto] option offers broad compatibility at a reasonable level
|
||||
@racket['secure] and @racket['auto] options offer broad compatibility at a reasonable level
|
||||
of security. Note that the security of connections depends on more
|
||||
than the protocol version; see @racket[ssl-secure-client-context] for
|
||||
details.
|
||||
|
||||
Not all protocol versions are available on all platforms. See also
|
||||
details. See also
|
||||
@racket[supported-client-protocols] and
|
||||
@racket[supported-server-protocols].
|
||||
|
||||
@history[
|
||||
#:changed "6.1" @elem{Added @racket['tls11] and @racket['tls12].}
|
||||
#:changed "6.1.1.3" @elem{Default to new @racket['auto] and disabled SSL
|
||||
2.0 and 3.0 by default.}
|
||||
2.0 and 3.0 by default.}
|
||||
#:changed "6.3.0.12" @elem{Added @racket['secure].}
|
||||
]}
|
||||
|
||||
|
||||
@defproc[(supported-client-protocols)
|
||||
(listof (or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))]{
|
||||
(listof (or/c 'secure 'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))]{
|
||||
|
||||
Returns a list of symbols representing protocols that are supported
|
||||
for clients on the current platform.}
|
||||
for clients on the current platform.
|
||||
|
||||
@history[#:changed "6.3.0.12" @elem{Added @racket['secure].}]}
|
||||
|
||||
|
||||
@defproc[(ssl-client-context? [v any/c]) boolean?]{
|
||||
|
@ -212,7 +225,7 @@ Returns @racket[#t] if @racket[v] is a value produced by
|
|||
|
||||
@history[#:added "6.0.1.3"]}
|
||||
|
||||
@defproc[(ssl-max-client-protocol) (or/c 'sslv2 sslv3 'tls 'tls11 'tls12 #f)]{
|
||||
@defproc[(ssl-max-client-protocol) (or/c 'sslv2 'sslv3 'tls 'tls11 'tls12 #f)]{
|
||||
|
||||
Returns the most recent SSL/TLS protocol version supported by the
|
||||
current platform for client connections.
|
||||
|
@ -231,13 +244,15 @@ current platform for client connections.
|
|||
[hostname-or-#f (or/c string? #f) #f]
|
||||
[server-protocol
|
||||
(or/c ssl-server-context?
|
||||
'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'secure 'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'auto])
|
||||
ssl-listener?]{
|
||||
|
||||
Like @racket[tcp-listen], but the result is an SSL listener. The extra optional
|
||||
@racket[server-protocol] is as for @racket[ssl-connect], except that a
|
||||
context must be a server context instead of a client context.
|
||||
context must be a server context instead of a client context, and
|
||||
@racket['secure] is simply an alias for @racket['auto].
|
||||
|
||||
Call @racket[ssl-load-certificate-chain!] and
|
||||
@racket[ssl-load-private-key!] to avoid a @emph{no shared cipher}
|
||||
|
@ -250,7 +265,9 @@ An SSL listener is a synchronizable value (see @racket[sync]). It is
|
|||
ready---with itself as its value---when the underlying TCP listener is
|
||||
ready. At that point, however, accepting a connection with
|
||||
@racket[ssl-accept] may not complete immediately, because
|
||||
further communication is needed to establish the connection.}
|
||||
further communication is needed to establish the connection.
|
||||
|
||||
@history[#:changed "6.3.0.12" @elem{Added @racket['secure].}]}
|
||||
|
||||
|
||||
@deftogether[(
|
||||
|
@ -298,11 +315,16 @@ Returns @racket[#t] of @racket[v] is an SSL port produced by
|
|||
|
||||
|
||||
@defproc[(ssl-make-server-context
|
||||
[protocol (or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
[protocol (or/c 'secure 'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'auto])
|
||||
ssl-server-context?]{
|
||||
|
||||
Like @racket[ssl-make-client-context], but creates a server context.}
|
||||
Like @racket[ssl-make-client-context], but creates a server context.
|
||||
For a server context, the @racket['secure] protocol is the same as
|
||||
@racket['auto].
|
||||
|
||||
@history[#:changed "6.3.0.12" @elem{Added @racket['secure].}]}
|
||||
|
||||
|
||||
@defproc[(ssl-server-context? [v any/c]) boolean?]{
|
||||
|
@ -311,14 +333,16 @@ Returns @racket[#t] if @racket[v] is a value produced by
|
|||
@racket[ssl-make-server-context], @racket[#f] otherwise.}
|
||||
|
||||
@defproc[(supported-server-protocols)
|
||||
(listof (or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))]{
|
||||
(listof (or/c 'secure 'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))]{
|
||||
|
||||
Returns a list of symbols representing protocols that are supported
|
||||
for servers on the current platform.
|
||||
|
||||
@history[#:added "6.0.1.3"]}
|
||||
@history[#:added "6.0.1.3"
|
||||
#:changed "6.3.0.12" @elem{Added @racket['secure].}]}
|
||||
|
||||
@defproc[(ssl-max-server-protocol) (or/c 'sslv2 sslv3 'tls 'tls11 'tls12 #f)]{
|
||||
@defproc[(ssl-max-server-protocol) (or/c 'sslv2 'sslv3 'tls 'tls11 'tls12 #f)]{
|
||||
|
||||
Returns the most recent SSL/TLS protocol version supported by the
|
||||
current platform for server connections.
|
||||
|
@ -340,7 +364,8 @@ current platform for server connections.
|
|||
ssl-make-server-context
|
||||
ssl-make-client-context)
|
||||
protocol)]
|
||||
[#:encrypt protocol (or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
[#:encrypt protocol (or/c 'secure 'auto
|
||||
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
|
||||
'auto]
|
||||
[#:close-original? close-original? boolean? #f]
|
||||
[#:shutdown-on-close? shutdown-on-close? boolean? #f]
|
||||
|
|
|
@ -6,6 +6,9 @@
|
|||
'(("racket-win32-i386-2" #:platform "win32\\i386")
|
||||
("racket-win32-x86_64-2" #:platform "win32\\x86_64")
|
||||
("racket-x86_64-linux-natipkg-2" #:platform "x86_64-linux-natipkg")
|
||||
("racket-x86_64-macosx-2" #:platform "x86_64-macosx")
|
||||
("racket-i386-macosx-2" #:platform "i386-macosx")
|
||||
("racket-ppc-macosx-2" #:platform "ppc-macosx")
|
||||
("db-ppc-macosx" #:platform "ppc-macosx")
|
||||
("db-win32-i386" #:platform "win32\\i386")
|
||||
("db-win32-x86_64" #:platform "win32\\x86_64")
|
||||
|
|
|
@ -18,7 +18,7 @@
|
|||
win32-ssl-port?
|
||||
win32-ssl-available?)
|
||||
|
||||
(define (win32-ssl-connect host port [protocol'sslv2-or-v3])
|
||||
(define (win32-ssl-connect host port [protocol 'sslv2-or-v3])
|
||||
(define-values (i o) (tcp-connect host port))
|
||||
(ports->win32-ssl-ports i o #:encrypt protocol))
|
||||
|
||||
|
@ -287,7 +287,7 @@
|
|||
0 #f ; mappers
|
||||
0 #f ; algs
|
||||
(case protocol
|
||||
[(auto sslv2-or-v3)
|
||||
[(secure auto sslv2-or-v3)
|
||||
(bitwise-ior SP_PROT_TLS1)]
|
||||
[(sslv2) SP_PROT_SSL2]
|
||||
[(sslv3) SP_PROT_SSL3]
|
||||
|
|
|
@ -42,7 +42,7 @@ TO DO:
|
|||
["private/macosx.rkt" (load-macosx-keychain)])
|
||||
|
||||
(define protocol-symbol/c
|
||||
(or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))
|
||||
(or/c 'secure 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))
|
||||
|
||||
(define curve-nid-alist
|
||||
'((sect163k1 . 721)
|
||||
|
@ -545,7 +545,7 @@ TO DO:
|
|||
(define (encrypt->method who e client?)
|
||||
(define f
|
||||
(case e
|
||||
[(auto sslv2-or-v3)
|
||||
[(secure auto sslv2-or-v3)
|
||||
(if client? SSLv23_client_method SSLv23_server_method)]
|
||||
[(sslv2)
|
||||
(if client? SSLv2_client_method SSLv2_server_method)]
|
||||
|
@ -579,7 +579,8 @@ TO DO:
|
|||
;; Keep symbols in best-last order for ssl-max-{client,server}-protocol.
|
||||
(define (supported-client-protocols)
|
||||
(filter-available
|
||||
(list 'auto SSLv23_client_method
|
||||
(list 'secure SSLv23_client_method
|
||||
'auto SSLv23_client_method
|
||||
'sslv2-or-v3 SSLv23_client_method
|
||||
'sslv2 SSLv2_client_method
|
||||
'sslv3 SSLv3_client_method
|
||||
|
@ -588,7 +589,8 @@ TO DO:
|
|||
'tls12 TLSv1_2_client_method)))
|
||||
(define (supported-server-protocols)
|
||||
(filter-available
|
||||
(list 'auto SSLv23_server_method
|
||||
(list 'secure SSLv23_server_method
|
||||
'auto SSLv23_server_method
|
||||
'sslv2-or-v3 SSLv23_server_method
|
||||
'sslv2 SSLv2_server_method
|
||||
'sslv3 SSLv3_server_method
|
||||
|
@ -609,17 +611,26 @@ TO DO:
|
|||
((if client? make-ssl-client-context make-ssl-server-context) ctx #f #f))
|
||||
|
||||
(define (make-raw-context who protocol-symbol client?)
|
||||
(define meth (encrypt->method who protocol-symbol client?))
|
||||
(define ctx
|
||||
(atomically ;; connect SSL_CTX_new to subsequent check-valid (ERR_get_error)
|
||||
(let ([ctx (SSL_CTX_new meth)])
|
||||
(check-valid ctx who "context creation")
|
||||
ctx)))
|
||||
(unless (memq protocol-symbol '(sslv2 sslv3))
|
||||
(SSL_CTX_set_options ctx (bitwise-ior SSL_OP_NO_SSLv2 SSL_OP_NO_SSLv3)))
|
||||
(SSL_CTX_set_mode ctx (bitwise-ior SSL_MODE_ENABLE_PARTIAL_WRITE
|
||||
SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER))
|
||||
ctx)
|
||||
(cond
|
||||
[(and (eq? protocol-symbol 'secure)
|
||||
client?)
|
||||
(ssl-context-ctx (ssl-secure-client-context))]
|
||||
[else
|
||||
(define meth (encrypt->method who protocol-symbol client?))
|
||||
(define ctx
|
||||
(atomically ;; connect SSL_CTX_new to subsequent check-valid (ERR_get_error)
|
||||
(let ([ctx (SSL_CTX_new meth)])
|
||||
(check-valid ctx who "context creation")
|
||||
ctx)))
|
||||
(unless (memq protocol-symbol '(sslv2 sslv3))
|
||||
(SSL_CTX_set_options ctx (bitwise-ior SSL_OP_NO_SSLv2 SSL_OP_NO_SSLv3)))
|
||||
(SSL_CTX_set_mode ctx (bitwise-ior SSL_MODE_ENABLE_PARTIAL_WRITE
|
||||
SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER))
|
||||
ctx]))
|
||||
|
||||
(define (need-ctx-free? context-or-encrypt-method)
|
||||
(and (symbol? context-or-encrypt-method)
|
||||
(not (eq? context-or-encrypt-method 'secure))))
|
||||
|
||||
(define (ssl-make-client-context [protocol-symbol default-encrypt])
|
||||
(make-context 'ssl-make-client-context protocol-symbol #t))
|
||||
|
@ -1353,7 +1364,8 @@ TO DO:
|
|||
(let ([ctx (get-context who context-or-encrypt-method connect?)])
|
||||
(check-valid ctx who "context creation")
|
||||
(with-failure
|
||||
(lambda () (when (and ctx (symbol? context-or-encrypt-method))
|
||||
(lambda () (when (and ctx
|
||||
(need-ctx-free? context-or-encrypt-method))
|
||||
(SSL_CTX_free ctx)))
|
||||
(let ([r-bio (BIO_new (BIO_s_mem))]
|
||||
[w-bio (BIO_new (BIO_s_mem))]
|
||||
|
@ -1365,7 +1377,7 @@ TO DO:
|
|||
(let ([ssl (SSL_new ctx)])
|
||||
(check-valid ssl who "ssl setup")
|
||||
;; ssl has a ref count on ctx, so release:
|
||||
(when (symbol? context-or-encrypt-method)
|
||||
(when (need-ctx-free? context-or-encrypt-method)
|
||||
(SSL_CTX_free ctx)
|
||||
(set! ctx #f))
|
||||
(with-failure
|
||||
|
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "6.3.0.11"
|
||||
#define MZSCHEME_VERSION "6.3.0.12"
|
||||
|
||||
#define MZSCHEME_VERSION_X 6
|
||||
#define MZSCHEME_VERSION_Y 3
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 11
|
||||
#define MZSCHEME_VERSION_W 12
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
Loading…
Reference in New Issue
Block a user