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:
Matthew Flatt 2016-01-06 07:45:10 -07:00
parent 1e5da68b88
commit 92f1bfa4d2
6 changed files with 84 additions and 44 deletions

View File

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

View File

@ -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]

View File

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

View File

@ -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]

View File

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

View File

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