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

openssl: add supported-{client,server}-protocols

Browse Source 
Use the new functions to avoid running a test that requires 'tls12
to succeed.
This commit is contained in:
Matthew Flatt 2014-07-16 12:52:43 +01:00
parent 70c2f72166
commit d7f2c869b6
3 changed files with 115 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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"]}
@; ----------------------------------------------------------------------

51
pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt
View File

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

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

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