diff --git a/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl b/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl index 6ea456741b..2afd2bc5ad 100644 --- a/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl +++ b/pkgs/racket-pkgs/racket-doc/openssl/openssl.scrbl @@ -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} diff --git a/pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt b/pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt new file mode 100644 index 0000000000..cab9e115eb --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/openssl/test-ephemeral.rkt @@ -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")))) diff --git a/racket/collects/openssl/mzssl.rkt b/racket/collects/openssl/mzssl.rkt index f9d3faf6ce..17637c322e 100644 --- a/racket/collects/openssl/mzssl.rkt +++ b/racket/collects/openssl/mzssl.rkt @@ -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)))