diff --git a/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl b/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl index 6288e653ef..e3802d248b 100644 --- a/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl +++ b/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl @@ -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. diff --git a/pkgs/racket-pkgs/racket-test/tests/openssl/test-protocols.rkt b/pkgs/racket-pkgs/racket-test/tests/openssl/test-protocols.rkt new file mode 100644 index 0000000000..5dbda9295b --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/openssl/test-protocols.rkt @@ -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))) diff --git a/racket/collects/openssl/mzssl.rkt b/racket/collects/openssl/mzssl.rkt index f73b5611ad..5ecb8b1b93 100644 --- a/racket/collects/openssl/mzssl.rkt +++ b/racket/collects/openssl/mzssl.rkt @@ -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]