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

docs and tests for DHE and ECDHE support; simplify curve name code

Browse Source
This commit is contained in:
Ryan Culpepper 2014-04-12 00:54:42 -04:00
parent 5c11e6211c
commit 4f6f3a35da
3 changed files with 164 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,6 @@
#lang scribble/doc
@(require scribble/manual
racket/list
(for-label openssl
racket
openssl/sha1
@ -65,7 +66,9 @@ using the functions described in @secref["cert-procs"].
'sslv2-or-v3
'sslv2
'sslv3
'tls)
'tls
'tls11
'tls12)
'sslv2-or-v3])
(values input-port? output-port?)]{
@ -79,8 +82,9 @@ 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],
or @racket['tls]; see @racket[ssl-make-client-context] for further
details (including the meanings of the protocol symbols).
@racket['tls], @racket['tls11], or @racket['tls12]; 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,7 +114,8 @@ whether the other end is supposed to be sending or reading data.
[hostname string?]
[port-no (integer-in 1 65535)]
[client-protocol
(or/c ssl-client-context? 'sslv2-or-v3 'sslv2 'sslv3 'tls)
(or/c ssl-client-context?
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'sslv2-or-v3])
(values input-port? output-port?)]{
@ -149,7 +154,7 @@ The context is cached, so different calls to
@defproc[(ssl-make-client-context
[protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls) 'sslv2-or-v3])
[protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12) 'sslv2-or-v3])
ssl-client-context?]{
Creates a context to be supplied to @racket[ssl-connect]. The context
@ -166,6 +171,8 @@ The @racket[protocol] must be one of the following:
@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}
]
Note that SSL protocol version 2 is deprecated on some platforms and may not be
@ -190,7 +197,8 @@ Returns @racket[#t] if @racket[v] is a value produced by
[reuse? any/c #f]
[hostname-or-#f (or/c string? #f) #f]
[server-protocol
(or/c ssl-server-context? 'sslv2-or-v3 'sslv2 'sslv3 'tls)
(or/c ssl-server-context?
'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)
'sslv2-or-v3])
ssl-listener?]{
@ -256,7 +264,7 @@ 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)])
@defproc[(ssl-make-server-context [protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)])
ssl-server-context?]{
Like @racket[ssl-make-client-context], but creates a server context.}
@ -281,7 +289,7 @@ Returns @racket[#t] if @racket[v] is a value produced by
ssl-make-server-context
ssl-make-client-context)
protocol)]
[#:encrypt protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls) 'sslv2-or-v3]
[#:encrypt protocol (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12) 'sslv2-or-v3]
[#:close-original? close-original? boolean? #f]
[#:shutdown-on-close? shutdown-on-close? boolean? #f]
[#:error/ssl error procedure? error]
@ -522,6 +530,41 @@ You can use the file @filepath{test.pem} of the @filepath{openssl}
collection for testing purposes where the peer identifies itself using
@filepath{test.pem}.}
@deftogether[[
@defproc[(ssl-server-context-enable-dhe!
[context ssl-server-context?]
[dh-param-path path-string? ssl-dh4096-param-path])
void?]
@defproc[(ssl-server-context-enable-ecdhe!
[context ssl-server-context?]
[curve-name symbol? 'secp521r1])
void?]
]]{
Enables cipher suites that provide
@hyperlink["http://en.wikipedia.org/wiki/Forward_secrecy"]{perfect
forward secrecy} via ephemeral Diffie-Hellman (DHE) or ephemeral
elliptic-curve Diffie-Hellman (ECDHE) key exchange, respectively.
For DHE, the @racket[dh-param-path] must be a path to a PEM file
containing DH parameters.
For ECDHE, the @racket[curve-name] must be one of the following
symbols naming a standard elliptic curve:
@(add-between
(map (lambda (s) (racket '@#,(racketvalfont (symbol->string s))))
'(sect163k1 sect163r1 sect163r2 sect193r1 sect193r2 sect233k1 sect233r1
sect239k1 sect283k1 sect283r1 sect409k1 sect409r1 sect571k1 sect571r1
secp160k1 secp160r1 secp160r2 secp192k1 secp224k1 secp224r1 secp256k1
secp384r1 secp521r1 prime192v prime256v))
", ").
}
@defthing[ssl-dh4096-param-path path?]{
Path for 4096-bit Diffie-Hellman parameters.
}
@; ----------------------------------------------------------------------
@section[#:tag "peer-verif"]{Peer Verification}

70
pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt Normal file
View File

@ -0,0 +1,70 @@
#lang racket
(require openssl
rackunit)
;; Test DHE, ECDHE
(define pem (build-path (collection-path "openssl") "test.pem"))
(define (test-ephemeral server-enable! client-ciphers)
(let-values ([(r1 w2) (make-pipe 10)]
[(r2 w1) (make-pipe 10)])
(define server-thread
(thread (lambda ()
(define server-ctx (ssl-make-server-context 'tls12))
(ssl-load-certificate-chain! server-ctx pem)
(ssl-load-private-key! server-ctx pem)
(server-enable! server-ctx)
(define-values (r w)
(ports->ssl-ports r2 w2
#:context server-ctx
#:mode 'accept
#:close-original? #t
#:shutdown-on-close? #t))
(check-equal? (read-bytes 5 r) #"abcde")
(check-equal? (write-string "hello" w) 5)
(close-output-port w))))
(define client-ctx (ssl-make-client-context 'tls12))
;; Set client to only accept ephemeral ciphers
(ssl-set-ciphers! client-ctx client-ciphers)
(define-values (r w)
(ports->ssl-ports r1 w1
#:context client-ctx
#:mode 'connect
#:close-original? #t
#:shutdown-on-close? #t))
(file-stream-buffer-mode w 'none)
(check-equal? (write-bytes #"abcde" w) 5)
(flush-output w)
(check-equal? (read-string 5 r) "hello")
(check-equal? (read-string 5 r) eof)
(close-input-port r)
(close-output-port w)
(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")
;; 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 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"))))

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

@ -43,14 +43,35 @@ TO DO:
(define protocol-symbol/c
(or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12))
(define curves/c
(or/c 'sect163k1
'sect163r1 'sect163r2 'sect193r1 'sect193r2
'sect233k1 'sect233r1 'sect239k1 'sect283r1
'sect283k1 'sect409k1 'sect409r1 'sect571k1 'sect571r1
'secp160k1 'secp160r1 'secp160r2 'secp192k1 'secp224k1 'secp224r1
'secp256k1 'secp384r1 'secp521r1
'prime192v1 'prime256v1))
(define curve-nid-alist
'((sect163k1 . 721)
(sect163r1 . 722)
(sect163r2 . 723)
(sect193r1 . 724)
(sect193r2 . 725)
(sect233k1 . 726)
(sect233r1 . 727)
(sect239k1 . 728)
(sect283k1 . 729)
(sect283r1 . 730)
(sect409k1 . 731)
(sect409r1 . 732)
(sect571k1 . 733)
(sect571r1 . 734)
(secp160k1 . 708)
(secp160r1 . 709)
(secp160r2 . 710)
(secp192k1 . 711)
(secp224k1 . 712)
(secp224r1 . 713)
(secp256k1 . 714)
(secp384r1 . 715)
(secp521r1 . 716)
(prime192v1 . 409)
(prime256v1 . 415)))
(define curve/c (apply or/c (map car curve-nid-alist)))
(define verify-source/c
(or/c path-string?
@ -59,7 +80,7 @@ TO DO:
(list/c 'macosx-keychain path-string?)))
(provide
ssl-dh-param-path
ssl-dh4096-param-path
(contract-out
[ssl-available? boolean?]
[ssl-load-fail-reason (or/c #f string?)]
@ -72,7 +93,7 @@ TO DO:
[ssl-server-context-enable-dhe!
(->* (ssl-server-context?) (path-string?) void?)]
[ssl-server-context-enable-ecdhe!
(->* (ssl-server-context?) (curves/c) void?)]
(->* (ssl-server-context?) (curve/c) void?)]
[ssl-client-context?
(c-> any/c boolean?)]
[ssl-server-context?
@ -358,7 +379,6 @@ TO DO:
(define NID_commonName 13)
(define GEN_DNS 2)
(define SSL_CTRL_SET_ECDH_AUTO 94)
(define SSL_CTRL_OPTIONS 32)
(define SSL_CTRL_SET_TMP_DH 3)
(define SSL_CTRL_SET_TMP_ECDH 4)
@ -366,37 +386,9 @@ TO DO:
(define SSL_OP_SINGLE_ECDH_USE #x00080000)
(define SSL_OP_SINGLE_DH_USE #x00100000)
(define NID_sect163k1 721)
(define NID_sect163r1 722)
(define NID_sect163r2 723)
(define NID_sect193r1 724)
(define NID_sect193r2 725)
(define NID_sect233k1 726)
(define NID_sect233r1 727)
(define NID_sect239k1 728)
(define NID_sect283k1 729)
(define NID_sect283r1 730)
(define NID_sect409k1 731)
(define NID_sect409r1 732)
(define NID_sect571k1 733)
(define NID_sect571r1 734)
(define NID_secp160k1 708)
(define NID_secp160r1 709)
(define NID_secp160r2 710)
(define NID_secp192k1 711)
(define NID_secp224k1 712)
(define NID_secp224r1 713)
(define NID_secp256k1 714)
(define NID_secp384r1 715)
(define NID_secp521r1 716)
(define NID_prime192v1 409)
(define NID_prime256v1 415)
(define-mzscheme scheme_make_custodian (_fun _pointer -> _scheme))
(define-runtime-path ssl-dh-param-path "dh4096.pem")
(define-runtime-path ssl-dh4096-param-path "dh4096.pem")
;; Make this bigger than 4096 to accommodate at least
;; 4096 of unencrypted data
@ -586,53 +578,31 @@ TO DO:
(define (ssl-server-context-enable-ecdhe! context [name 'secp521r1])
(define (symbol->nid name)
(case name
[(sect163k1) NID_sect163k1]
[(sect163r1) NID_sect163r1]
[(sect163r2) NID_sect163r2]
[(sect193r1) NID_sect193r1]
[(sect193r2) NID_sect193r2]
[(sect233k1) NID_sect233k1]
[(sect233r1) NID_sect233r1]
[(sect239k1) NID_sect239k1]
[(sect283k1) NID_sect283k1]
[(sect283r1) NID_sect283r1]
[(sect409k1) NID_sect409k1]
[(sect409r1) NID_sect409r1]
[(sect571k1) NID_sect571k1]
[(sect571r1) NID_sect571r1]
[(secp160k1) NID_secp160k1]
[(secp160r1) NID_secp160r1]
[(secp160r2) NID_secp160r2]
[(secp192k1) NID_secp192k1]
[(secp224k1) NID_secp224k1]
[(secp224r1) NID_secp224r1]
[(secp256k1) NID_secp256k1]
[(secp384r1) NID_secp384r1]
[(secp521r1) NID_secp521r1]
[(prime192v1) NID_prime192v1]
[(prime256v1) NID_prime256v1]
[else NID_secp521r1]))
(cond [(assq name curve-nid-alist)
=> cdr]
[else
(error 'ssl-server-context-enable-ecdhe!
"bad curve name\n curve name: ~e" name)]))
(define ctx (extract-ctx 'ssl-server-context-enable-ecdhe! #t context))
(define key (EC_KEY_new_by_curve_name (symbol->nid name)))
(check-valid key 'ssl-server-context-enable-ecdhe! "Could not enable ECDH(E)")
(check-valid key 'ssl-server-context-enable-ecdhe! "enabling ECDHE")
(unless (= 1 (SSL_CTX_ctrl ctx SSL_CTRL_SET_TMP_ECDH 0 key))
(error 'ssl-server-context-enable-ecdhe! "Could not enable ECDH(E)"))
(error 'ssl-server-context-enable-ecdhe! "enabling ECDHE"))
(SSL_CTX_ctrl ctx SSL_CTRL_OPTIONS SSL_OP_SINGLE_ECDH_USE #f)
(void))
(define (ssl-server-context-enable-dhe! context [path ssl-dh-param-path])
(define (ssl-server-context-enable-dhe! context [path ssl-dh4096-param-path])
(define params (call-with-input-file path port->bytes))
(define params-bio (BIO_new_mem_buf params (bytes-length params)))
(check-valid params-bio 'ssl-server-context-enable-dhe! "Diffie-Hellman parameters")
(check-valid params-bio 'ssl-server-context-enable-dhe! "loading Diffie-Hellman parameters")
(with-failure
(lambda ()
(BIO_free params-bio))
(define ctx (extract-ctx 'ssl-server-context-enable-dhe! #t context))
(define dh (PEM_read_bio_DHparams params-bio #f #f #f))
(check-valid dh 'ssl-server-context-enable-dhe "Diffie-Hellman parameters")
(check-valid dh 'ssl-server-context-enable-dhe! "loading Diffie-Hellman parameters")
(unless (= 1 (SSL_CTX_ctrl ctx SSL_CTRL_SET_TMP_DH 0 dh))
(error 'ssl-server-context-enable-dhe "Could not enable DHE"))
(error 'ssl-server-context-enable-dhe! "failed to enable DHE"))
(SSL_CTX_ctrl ctx SSL_CTRL_OPTIONS SSL_OP_SINGLE_DH_USE #f)
(void)))