suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

openssl: disable old SSL protocols by default

Browse Source 
Add 'auto alias for 'sslv2-or-v3, both of which now mean
"negotiate a reasonably secure protocol version", where
"secure" excludes SSL 2.0 and 3.0 (since POODLE).
This commit is contained in:
Ryan Culpepper 2014-10-29 21:08:38 -04:00
parent 2d38b089cd
commit 933a71ce71
3 changed files with 210 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl
View File

@ -63,8 +63,8 @@ using the functions described in @secref["cert-procs"].
[port-no (integer-in 1 65535)]
[client-protocol
(or/c ssl-client-context?
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'sslv2-or-v3])
'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'auto])
(values input-port? output-port?)]{
Connect to the host given by @racket[hostname], on the port given by
@ -75,11 +75,9 @@ output port.
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
@racket[ssl-make-client-context], or one of the following symbols:
@racket['sslv2-or-v3] (the default), @racket['sslv2], @racket['sslv3],
@racket['tls], @racket['tls11], or @racket['tls12]; see
@racket[ssl-make-client-context] for further details (including the
meanings of the protocol symbols).
@racket[ssl-make-client-context] a symbol specifying the protocol to
use; see @racket[ssl-make-client-context] for further details,
including the meanings of the protocol symbols.
Closing the resulting output port does not send a shutdown message to
the server. See also @racket[ports->ssl-ports].
@ -110,8 +108,8 @@ whether the other end is supposed to be sending or reading data.
[port-no (integer-in 1 65535)]
[client-protocol
(or/c ssl-client-context?
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'sslv2-or-v3])
'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'auto])
(values input-port? output-port?)]{
Like @racket[ssl-connect], but breaking is enabled while trying to
@ -121,14 +119,13 @@ connect.}
@defproc[(ssl-secure-client-context)
ssl-client-context?]{
Returns a client context (using the @racket['tls] protocol) that
verifies certificates using the default verification sources from
@racket[(ssl-default-verify-sources)], verifies hostnames, and avoids
using weak ciphers. The result is essentially equivalent to the
following:
Returns a client context that verifies certificates using the default
verification sources from @racket[(ssl-default-verify-sources)],
verifies hostnames, and avoids using weak ciphers. The result is
essentially equivalent to the following:
@racketblock[
(let ([ctx (ssl-make-client-context 'tls)])
(let ([ctx (ssl-make-client-context 'auto)])
(code:comment "Load default verification sources (root certificates)")
(ssl-load-default-verify-sources! ctx)
(code:comment "Require certificate verification")
@ -149,38 +146,57 @@ The context is cached, so different calls to
@defproc[(ssl-make-client-context
[protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12) 'sslv2-or-v3])
[protocol (or/c '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
identifies a communication protocol (as selected by
is @bold{insecure} unless additional steps are taken; see
@racket[ssl-secure-client-context] for details.
The client context identifies a communication protocol (as selected by
@racket[protocol]), and also holds certificate information (i.e., the
client's identity, its trusted certificate authorities, etc.). See the
section @secref["cert-procs"] below for more information on
certificates.
The @racket[protocol] must be one of the following:
The @racket[protocol] should be one of the following:
@itemize[
@item{@racket['sslv2-or-v3] : SSL protocol versions 2 or 3, as
appropriate (this is the default)}
@item{@racket['sslv2] : SSL protocol version 2}
@item{@racket['sslv3] : SSL protocol version 3}
@item{@racket['tls] : the TLS protocol version 1}
@item{@racket['tls11] : the TLS protocol version 1.1}
@item{@racket['tls12] : the TLS protocol version 1.2}
@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.}
@item{@racket['tls] : Only TLS protocol version 1.0.}
@item{@racket['tls11] : Only TLS protocol version 1.1.}
@item{@racket['tls12] : Only TLS protocol version 1.2.}
]
The following @racket[protocol] symbols are deprecated but still supported:
@itemlist[
@item{@racket['sslv2-or-v3] : Alias for @racket['auto]. Note that
despite the name, neither SSL 2.0 nor 3.0 are considered sufficiently
secure, so this @racket[protocol] no longer allows either of them.}
@item{@racket['sslv2] : SSL protocol version 2.0. @bold{Insecure.}
Note that SSL 2.0 support has been removed from many platforms.}
@item{@racket['sslv3] : SSL protocol version 3.0. @bold{Insecure.}}
]
Note that SSL protocol version 2 is deprecated on some platforms and may not be
present in your system libraries. The use of SSLv2 may also compromise security;
thus, using SSLv3 is recommended. TLS 1.1 and 1.2 are relatively new and not
always available. See also @racket[supported-client-protocols] and
Not all protocol versions are supported by all servers. The
@racket['auto] option offers 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
@racket[supported-client-protocols] and
@racket[supported-server-protocols].
@history[#:changed "6.1" @elem{Added @racket['tls11] and @racket['tls12].}]}
@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.}
]}
@defproc[(supported-client-protocols)
(listof (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))]{
(listof (or/c '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.}
@ -193,6 +209,13 @@ 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)]{
Returns the most recent SSL/TLS protocol version supported by the
current platform for client connections.
@history[#:added "6.1.1.3"]
}
@; ----------------------------------------------------------------------
@ -205,8 +228,8 @@ Returns @racket[#t] if @racket[v] is a value produced by
[hostname-or-#f (or/c string? #f) #f]
[server-protocol
(or/c ssl-server-context?
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'sslv2-or-v3])
'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
@ -271,7 +294,9 @@ Returns @racket[#t] of @racket[v] is an SSL port produced by
@racket[ports->ssl-ports].}
@defproc[(ssl-make-server-context [protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)])
@defproc[(ssl-make-server-context
[protocol (or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'auto])
ssl-server-context?]{
Like @racket[ssl-make-client-context], but creates a server context.}
@ -283,13 +308,21 @@ 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 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))]{
(listof (or/c '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"]}
@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.
@history[#:added "6.1.1.3"]
}
@; ----------------------------------------------------------------------
@section{SSL-wrapper Interface}
@ -304,7 +337,8 @@ for servers on the current platform.
ssl-make-server-context
ssl-make-client-context)
protocol)]
[#:encrypt protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12) 'sslv2-or-v3]
[#:encrypt protocol (or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'auto]
[#:close-original? close-original? boolean? #f]
[#:shutdown-on-close? shutdown-on-close? boolean? #f]
[#:error/ssl error procedure? error]
@ -331,7 +365,7 @@ mode. If it is not supplied, a context is created using the protocol
specified by a @racket[protocol] argument.
If the @racket[protocol] argument is not supplied, it defaults to
@racket['sslv2-or-v3]. See @racket[ssl-make-client-context] for
@racket['auto]. See @racket[ssl-make-client-context] for
further details (including all options and the meanings of the
protocol symbols). This argument is ignored if a @racket[context]
argument is supplied.

98
pkgs/racket-pkgs/racket-test/tests/openssl/test-protocols.rkt Normal file
View File

@ -0,0 +1,98 @@
#lang racket
(require openssl
rackunit
racket/runtime-path)
;; Test protocol version compatibility
;; In particular, test 'auto doesn't include SSL 3.
(define PROTOCOLS '(auto sslv2 sslv3 tls tls11 tls12))
(define (compatible? client-p server-p)
(or (eq? client-p server-p)
(and (eq? client-p 'auto) (memq server-p '(tls tls11 tls12)))
(and (eq? server-p 'auto) (memq client-p '(tls tls11 tls12)))))
(define pem (build-path (collection-path "openssl") "test.pem"))
(define MSG:C->S "Hello. This is Racket speaking.")
(define MSG:S->C "Yes, this is Racket too. Hello, Racket.")
;; check whether client-p can connect to server-p
;; raises error unless ( succeeds iff expect-ok? )
(define (test-connect client-p server-p expect-ok?)
(parameterize ((current-custodian (make-custodian)))
(define-values (r1 w2) (make-pipe 10))
(define-values (r2 w1) (make-pipe 10))
(define server-thread
(thread
(lambda ()
(define server-ctx (ssl-make-server-context server-p))
(ssl-load-certificate-chain! server-ctx pem)
(ssl-load-private-key! server-ctx pem)
(define-values (r w)
(with-handlers ([values
(lambda (e)
(cond [expect-ok?
(raise e)]
[else
(values #f #f)]))])
(ports->ssl-ports r2 w2
#:context server-ctx
#:mode 'accept
#:close-original? #t
#:shutdown-on-close? #t)))
(when (or r w)
(check-equal? (read-line r) MSG:C->S)
(fprintf w "~a\n" MSG:S->C)
(close-output-port w)
(unless expect-ok?
(error 'test-connect
"should not have worked (accept): ~s connecting to ~s"
client-p server-p))))))
(define client-ctx (ssl-make-client-context client-p))
(define-values (r w)
(with-handlers ([values
(lambda (e)
(cond [expect-ok?
(raise e)]
[else
(values #f #f)]))])
(ports->ssl-ports r1 w1
#:context client-ctx
#:mode 'connect
#:close-original? #t
#:shutdown-on-close? #t)))
(when (or r w)
(fprintf w "~a\n" MSG:C->S)
(flush-output w)
(check-equal? (read-line r) MSG:S->C)
(check-equal? (read-byte r) eof)
(close-input-port r)
(close-output-port w)
(unless expect-ok?
(custodian-shutdown-all (current-custodian))
(error 'test-connect "should not have worked (connect): ~s connecting to ~s"
client-p server-p)))
(custodian-shutdown-all (current-custodian))
(void)))
(for ([client-p PROTOCOLS]
#:when (memq client-p (supported-client-protocols)))
(for ([server-p PROTOCOLS]
#:when (memq server-p (supported-server-protocols)))
(define ok? (compatible? client-p server-p))
(printf "** Testing ~s connecting to ~s (expect ~a)\n"
client-p server-p (if ok? "ok" "fail"))
(test-case (format "~s connecting to ~s (expect ~a)"
client-p server-p (if ok? "ok" "fail"))
(test-connect client-p server-p ok?))))
(for ([client-p PROTOCOLS])
(unless (memq client-p (supported-client-protocols))
(printf "** Skipped unsupported client protocol ~s\n" client-p)))
(for ([server-p PROTOCOLS])
(unless (memq server-p (supported-server-protocols))
(printf "** Skipped unsupported server protocol ~s\n" server-p)))

55
racket/collects/openssl/mzssl.rkt
View File

@ -29,6 +29,7 @@ TO DO:
ffi/unsafe/atomic
ffi/unsafe/alloc
ffi/file
racket/list
racket/port
racket/tcp
racket/string
@ -41,7 +42,7 @@ TO DO:
["private/macosx.rkt" (load-macosx-keychain)])
(define protocol-symbol/c
(or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))
(or/c 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))
(define curve-nid-alist
'((sect163k1 . 721)
@ -193,6 +194,8 @@ TO DO:
(c-> ssl-port? void?)]
[ssl-port?
(c-> any/c boolean?)])
ssl-max-client-protocol
ssl-max-server-protocol
supported-client-protocols
supported-server-protocols)
@ -267,6 +270,8 @@ TO DO:
(define-ssl SSL_CTX_ctrl (_fun _SSL_CTX* _int _long _pointer -> _long))
(define (SSL_CTX_set_mode ctx m)
(SSL_CTX_ctrl ctx SSL_CTRL_MODE m #f))
(define (SSL_CTX_set_options ctx opts)
(SSL_CTX_ctrl ctx SSL_CTRL_OPTIONS opts #f))
(define-ssl SSL_CTX_set_verify (_fun _SSL_CTX* _int _pointer -> _void))
(define-ssl SSL_CTX_use_certificate_chain_file (_fun _SSL_CTX* _bytes -> _int))
@ -395,6 +400,12 @@ TO DO:
(define SSL_CTRL_SET_TMP_DH 3)
(define SSL_CTRL_SET_TMP_ECDH 4)
(define SSL_OP_NO_SSLv2 #x01000000)
(define SSL_OP_NO_SSLv3 #x02000000)
(define SSL_OP_NO_TLSv1 #x04000000)
(define SSL_OP_NO_TLSv1_2 #x08000000)
(define SSL_OP_NO_TLSv1_1 #x10000000)
(define SSL_OP_SINGLE_ECDH_USE #x00080000)
(define SSL_OP_SINGLE_DH_USE #x00100000)
@ -529,12 +540,12 @@ TO DO:
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Contexts, certificates, etc.
(define default-encrypt 'sslv2-or-v3)
(define default-encrypt 'auto)
(define (encrypt->method who e client?)
(define f
(case e
[(sslv2-or-v3)
[(auto sslv2-or-v3)
(if client? SSLv23_client_method SSLv23_server_method)]
[(sslv2)
(if client? SSLv2_client_method SSLv2_server_method)]
@ -562,32 +573,50 @@ TO DO:
[(cadr l) (cons (car l) (filter-available (cddr l)))]
[else (filter-available (cddr l))]))
;; Keep symbols in best-last order for ssl-max-{client,server}-protocol.
(define (supported-client-protocols)
(filter-available
(list 'sslv2-or-v3 SSLv23_client_method
(list 'auto SSLv23_client_method
'sslv2-or-v3 SSLv23_client_method
'sslv2 SSLv2_client_method
'sslv3 SSLv3_client_method
'tls TLSv1_client_method
'tls11 TLSv1_1_client_method
'tls12 TLSv1_2_client_method)))
(define (supported-server-protocols)
(filter-available
(list 'sslv2-or-v3 SSLv23_server_method
(list 'auto SSLv23_server_method
'sslv2-or-v3 SSLv23_server_method
'sslv2 SSLv2_server_method
'sslv3 SSLv3_server_method
'tls TLSv1_server_method
'tls11 TLSv1_1_server_method
'tls12 TLSv1_2_server_method)))
(define (ssl-max-client-protocol)
(let ([protocols (supported-client-protocols)])
(and (pair? protocols) (last protocols))))
(define (ssl-max-server-protocol)
(let ([protocols (supported-server-protocols)])
(and (pair? protocols) (last protocols))))
(define (make-context who protocol-symbol client?)
(let ([meth (encrypt->method who protocol-symbol client?)])
(define ctx (make-raw-context who protocol-symbol client?))
((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")
(SSL_CTX_set_mode ctx (bitwise-ior SSL_MODE_ENABLE_PARTIAL_WRITE
SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER))
((if client? make-ssl-client-context make-ssl-server-context) ctx #f #f)))))
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 (ssl-make-client-context [protocol-symbol default-encrypt])
(make-context 'ssl-make-client-context protocol-symbol #t))
@ -599,9 +628,7 @@ TO DO:
#:need-unsealed? [need-unsealed? #f])
(if (ssl-context? context-or-encrypt-method)
(extract-ctx who need-unsealed? context-or-encrypt-method)
(let ([ctx (SSL_CTX_new (encrypt->method who context-or-encrypt-method client?))])
(SSL_CTX_set_mode ctx SSL_MODE_ENABLE_PARTIAL_WRITE)
ctx)))
(make-raw-context who context-or-encrypt-method client?)))
(define (get-context/listener who ssl-context-or-listener [fail? #t]
#:need-unsealed? [need-unsealed? #f])
@ -862,7 +889,7 @@ TO DO:
(let ([locs (ssl-default-verify-sources)])
(define (reset)
(let* ([now (current-seconds)]
[ctx (ssl-make-secure-client-context 'tls)])
[ctx (ssl-make-secure-client-context default-encrypt)])
(set! context-cache (list (make-weak-box ctx) locs now))
ctx))
(let* ([cached context-cache]