From d7f2c869b6b245e0cd238ee311ad4c7953ebb02c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 16 Jul 2014 12:52:43 +0100 Subject: [PATCH] openssl: add `supported-{client,server}-protocols` Use the new functions to avoid running a test that requires 'tls12 to succeed. --- .../racket-doc/openssl/openssl.scrbl | 35 +++++--- .../tests/openssl/test-ephemeral.rkt | 51 ++++++----- racket/collects/openssl/mzssl.rkt | 90 +++++++++++++------ 3 files changed, 115 insertions(+), 61 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl b/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl index 2afd2bc5ad..aef7001664 100644 --- a/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl +++ b/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl @@ -62,13 +62,8 @@ using the functions described in @secref["cert-procs"]. @defproc[(ssl-connect [hostname string?] [port-no (integer-in 1 65535)] [client-protocol - (or/c ssl-client-context? - 'sslv2-or-v3 - 'sslv2 - 'sslv3 - 'tls - 'tls11 - 'tls12) + (or/c ssl-client-context? + 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12) 'sslv2-or-v3]) (values input-port? output-port?)]{ @@ -177,14 +172,26 @@ The @racket[protocol] must be one of the following: 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. -} +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 +@racket[supported-server-protocols]. + +@history[#:changed "6.1" @elem{Added @racket['tls11] and @racket['tls12].}]} + + +@defproc[(supported-client-protocols) + (listof (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))]{ + +Returns a list of symbols representing protocols that are supported +for clients on the current platform.} @defproc[(ssl-client-context? [v any/c]) boolean?]{ Returns @racket[#t] if @racket[v] is a value produced by -@racket[ssl-make-client-context], @racket[#f] otherwise.} +@racket[ssl-make-client-context], @racket[#f] otherwise. + +@history[#:added "6.0.1.3"]} @; ---------------------------------------------------------------------- @@ -269,11 +276,19 @@ Returns @racket[#t] of @racket[v] is an SSL port produced by Like @racket[ssl-make-client-context], but creates a server context.} + @defproc[(ssl-server-context? [v any/c]) boolean?]{ 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))]{ + +Returns a list of symbols representing protocols that are supported +for servers on the current platform. + +@history[#:added "6.0.1.3"]} @; ---------------------------------------------------------------------- diff --git a/pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt b/pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt index cab9e115eb..8e81f312c7 100644 --- a/pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt @@ -8,7 +8,7 @@ (define (test-ephemeral server-enable! client-ciphers) (let-values ([(r1 w2) (make-pipe 10)] - [(r2 w1) (make-pipe 10)]) + [(r2 w1) (make-pipe 10)]) (define server-thread (thread (lambda () (define server-ctx (ssl-make-server-context 'tls12)) @@ -43,28 +43,33 @@ (thread-wait server-thread) (void))) -;; Test DHE ciphers (note: cipher spec is "EDH", contrary to openssl ciphers docs) -(test-ephemeral (lambda (server-ctx) - (ssl-server-context-enable-dhe! server-ctx ssl-dh4096-param-path)) - "AES+EDH") +(cond + [(memq 'tls12 (supported-server-protocols)) + ;; Test DHE ciphers (note: cipher spec is "EDH", contrary to openssl ciphers docs) + (test-ephemeral (lambda (server-ctx) + (ssl-server-context-enable-dhe! server-ctx ssl-dh4096-param-path)) + "AES+EDH") -;; Test ECDHE ciphers -(test-ephemeral (lambda (server-ctx) - (ssl-server-context-enable-ecdhe! server-ctx 'secp192k1)) - "ECDHE-RSA-AES128-SHA256") + ;; Test ECDHE ciphers + (test-ephemeral (lambda (server-ctx) + (ssl-server-context-enable-ecdhe! server-ctx 'secp192k1)) + "ECDHE-RSA-AES128-SHA256") -;; Sanity check for DHE: connection fails when enable! not called -(check-exn - #rx"connect failed" - (lambda () - ;; for DrDr, suppress accept error printing - (parameterize ((current-error-port (open-output-string))) - (test-ephemeral void "AES+EDH")))) + ;; Sanity check for DHE: connection fails when enable! not called + (check-exn + #rx"connect failed" + (lambda () + ;; for DrDr, suppress accept error printing + (parameterize ((current-error-port (open-output-string))) + (test-ephemeral void "AES+EDH")))) + + ;; Sanity check for ECDHE: connection fails when enable! not called + (check-exn + #rx"connect failed" + (lambda () + ;; for DrDr, suppress accept error printing + (parameterize ((current-error-port (open-output-string))) + (test-ephemeral void "ECDHE-RSA-AES128-SHA256"))))] + [else + (printf "TLS 1.2 not supported; skipping tests\n")]) -;; Sanity check for ECDHE: connection fails when enable! not called -(check-exn - #rx"connect failed" - (lambda () - ;; for DrDr, suppress accept error printing - (parameterize ((current-error-port (open-output-string))) - (test-ephemeral void "ECDHE-RSA-AES128-SHA256")))) diff --git a/racket/collects/openssl/mzssl.rkt b/racket/collects/openssl/mzssl.rkt index 0943826343..14571f4856 100644 --- a/racket/collects/openssl/mzssl.rkt +++ b/racket/collects/openssl/mzssl.rkt @@ -190,7 +190,9 @@ TO DO: [ssl-abandon-port (c-> ssl-port? void?)] [ssl-port? - (c-> any/c boolean?)])) + (c-> any/c boolean?)]) + supported-client-protocols + supported-server-protocols) (define ssl-load-fail-reason (or libssl-load-fail-reason @@ -223,18 +225,18 @@ TO DO: (define-cpointer-type _EC_KEY*) (define-cstruct _GENERAL_NAME ([type _int] [d _ASN1_STRING*])) -(define-ssl SSLv2_client_method (_fun -> _SSL_METHOD*)) -(define-ssl SSLv2_server_method (_fun -> _SSL_METHOD*)) -(define-ssl SSLv3_client_method (_fun -> _SSL_METHOD*)) -(define-ssl SSLv3_server_method (_fun -> _SSL_METHOD*)) -(define-ssl SSLv23_client_method (_fun -> _SSL_METHOD*)) -(define-ssl SSLv23_server_method (_fun -> _SSL_METHOD*)) -(define-ssl TLSv1_client_method (_fun -> _SSL_METHOD*)) -(define-ssl TLSv1_server_method (_fun -> _SSL_METHOD*)) -(define-ssl TLSv1_1_client_method (_fun -> _SSL_METHOD*)) -(define-ssl TLSv1_1_server_method (_fun -> _SSL_METHOD*)) -(define-ssl TLSv1_2_client_method (_fun -> _SSL_METHOD*)) -(define-ssl TLSv1_2_server_method (_fun -> _SSL_METHOD*)) +(define-ssl SSLv2_client_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl SSLv2_server_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl SSLv3_client_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl SSLv3_server_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl SSLv23_client_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl SSLv23_server_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl TLSv1_client_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl TLSv1_server_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl TLSv1_1_client_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl TLSv1_1_server_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl TLSv1_2_client_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) +(define-ssl TLSv1_2_server_method (_fun -> _SSL_METHOD*) #:fail (lambda () #f)) (define-crypto DH_free (_fun _DH* -> _void) #:wrap (deallocator)) (define-crypto EC_KEY_free (_fun _EC_KEY* -> _void) #:wrap (deallocator)) @@ -518,21 +520,53 @@ TO DO: (define default-encrypt 'sslv2-or-v3) (define (encrypt->method who e client?) - ((case e - [(sslv2-or-v3) - (if client? SSLv23_client_method SSLv23_server_method)] - [(sslv2) - (if client? SSLv2_client_method SSLv2_server_method)] - [(sslv3) - (if client? SSLv3_client_method SSLv3_server_method)] - [(tls) - (if client? TLSv1_client_method TLSv1_server_method)] - [(tls11) - (if client? TLSv1_1_client_method TLSv1_1_server_method)] - [(tls12) - (if client? TLSv1_2_client_method TLSv1_2_server_method)] - [else - (error 'encrypt->method "internal error, unknown encrypt: ~e" e)]))) + (define f + (case e + [(sslv2-or-v3) + (if client? SSLv23_client_method SSLv23_server_method)] + [(sslv2) + (if client? SSLv2_client_method SSLv2_server_method)] + [(sslv3) + (if client? SSLv3_client_method SSLv3_server_method)] + [(tls) + (if client? TLSv1_client_method TLSv1_server_method)] + [(tls11) + (if client? TLSv1_1_client_method TLSv1_1_server_method)] + [(tls12) + (if client? TLSv1_2_client_method TLSv1_2_server_method)] + [else + (error 'encrypt->method "internal error, unknown encrypt: ~e" e)])) + (unless f + (raise (exn:fail:unsupported + (format "~a: requested protocol not supported\n requested: ~e" + who + e) + (current-continuation-marks)))) + (f)) + +(define (filter-available l) + (cond + [(null? l) null] + [(cadr l) (cons (car l) (filter-available (cddr l)))] + [else (filter-available (cddr l))])) + +(define (supported-client-protocols) + (filter-available + (list '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 + 'sslv2 SSLv2_server_method + 'sslv3 SSLv3_server_method + 'tls TLSv1_server_method + 'tls11 TLSv1_1_server_method + 'tls12 TLSv1_2_server_method))) (define (make-context who protocol-symbol client?) (let ([meth (encrypt->method who protocol-symbol client?)])