I previously submitted this patch in late January; I've not received any progress updates with regards to this patch recently - did this patch get lost between then and now?
This patch adds Perfect Forward Secrecy to Racket's OpenSSL bindings. This patch has been tested on Ubuntu 12.04 (and appears to work correctly in a production environment).
diff --git a/racket/collects/openssl/dh4096.pem b/racket/collects/openssl/dh4096.pem new file mode 100644 index 0000000..1b35ad8 --- /dev/null +++ b/racket/collects/openssl/dh4096.pem @@ -0,0 +1,18 @@ +-----BEGIN DH PARAMETERS----- +MIICCAKCAgEA+hRyUsFN4VpJ1O8JLcCo/VWr19k3BCgJ4uk+d+KhehjdRqNDNyOQ +l/MOyQNQfWXPeGKmOmIig6Ev/nm6Nf9Z2B1h3R4hExf+zTiHnvVPeRBhjdQi81rt +Xeoh6TNrSBIKIHfUJWBh3va0TxxjQIs6IZOLeVNRLMqzeylWqMf49HsIXqbcokUS +Vt1BkvLdW48j8PPv5DsKRN3tloTxqDJGo9tKvj1Fuk74A+Xda1kNhB7KFlqMyN98 +VETEJ6c7KpfOo30mnK30wqw3S8OtaIR/maYX72tGOno2ehFDkq3pnPtEbD2CScxc +alJC+EL7RPk5c/tgeTvCngvc1KZn92Y//EI7G9tPZtylj2b56sHtMftIoYJ9+ODM +sccD5Piz/rejE3Ome8EOOceUSCYAhXn8b3qvxVI1ddd1pED6FHRhFvLrZxFvBEM9 +ERRMp5QqOaHJkM+Dxv8Cj6MqrCbfC4u+ZErxodzuusgDgvZiLF22uxMZbobFWyte +OvOzKGtwcTqO/1wV5gKkzu1ZVswVUQd5Gg8lJicwqRWyyNRczDDoG9jVDxmogKTH +AaqLulO7R8Ifa1SwF2DteSGVtgWEN8gDpN3RBmmPTDngyF2DHb5qmpnznwtFKdTL +KWbuHn491xNO25CQWMtem80uKw+pTnisBRF/454n1Jnhub144YRBoN8CAQI= +-----END DH PARAMETERS----- + +These are the 4096 bit DH parameters from "Assigned Number for SKIP Protocols" +(http://www.skip-vpn.org/spec/numbers.html). +See there for how they were generated. +Note that g is not a generator, but this is not a problem since p is a safe prime. diff --git a/racket/collects/openssl/mzssl.rkt b/racket/collects/openssl/mzssl.rkt index 2f16517..31bc8c9 100644 --- a/racket/collects/openssl/mzssl.rkt +++ b/racket/collects/openssl/mzssl.rkt @@ -34,6 +34,7 @@ TO DO: racket/tcp racket/string racket/lazy-require + racket/runtime-path "libcrypto.rkt" "libssl.rkt") (lazy-require @@ -41,7 +42,13 @@ TO DO: ["private/macosx.rkt" (load-macosx-keychain)]) (define protocol-symbol/c - (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls)) + (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)) +(define curves/c + (or/c 'sect163r1 'sect163r2 'sect193r1 'sect233k1 'sect233r1 'sect239k1 + 'sect283k1 'sect409k1 'sect409r1 'sect571k1 'sect571r1 + 'secp160k1 'secp160r1 'secp160r2 'secp192k1 'secp224k1 'secp224r1 + 'secp256k1 'secp384r1 'secp521r1 + 'prime192v1 'prime256v1)) (define verify-source/c (or/c path-string? @@ -50,6 +57,7 @@ TO DO: (list/c 'macosx-keychain path-string?))) (provide + ssl-dh-param-path (contract-out [ssl-available? boolean?] [ssl-load-fail-reason (or/c #f string?)] @@ -59,6 +67,10 @@ TO DO: (c-> ssl-client-context?)] [ssl-make-server-context (->* () (protocol-symbol/c) ssl-server-context?)] + [ssl-server-context-enable-dhe! + (->* (ssl-server-context?) (path-string?) void?)] + [ssl-server-context-enable-ecdhe! + (->* (ssl-server-context?) (curves/c) void?)] [ssl-client-context? (c-> any/c boolean?)] [ssl-server-context? @@ -185,6 +197,8 @@ TO DO: (define-cpointer-type _X509*) (define-cpointer-type _ASN1_STRING*) (define-cpointer-type _STACK*) +(define-cpointer-type _DH*) +(define-cpointer-type _EC_KEY*) (define-cstruct _GENERAL_NAME ([type _int] [d _ASN1_STRING*])) (define-ssl SSLv2_client_method (_fun -> _SSL_METHOD*)) @@ -195,9 +209,19 @@ TO DO: (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-crypto DH_free (_fun _DH* -> _void) #:wrap (deallocator)) +(define-crypto EC_KEY_free (_fun _EC_KEY* -> _void) #:wrap (deallocator)) + +(define-crypto EC_KEY_new_by_curve_name (_fun _int -> _EC_KEY*) #:wrap (allocator EC_KEY_free)) (define-crypto BIO_s_mem (_fun -> _BIO_METHOD*)) (define-crypto BIO_new (_fun _BIO_METHOD* -> _BIO*/null)) +(define-crypto BIO_new_mem_buf (_fun _pointer _int -> _BIO*)) (define-crypto BIO_free (_fun _BIO* -> _void)) (define-crypto BIO_read (_fun _BIO* _bytes _int -> _int)) @@ -259,6 +283,7 @@ TO DO: (define-ssl SSL_load_error_strings (_fun -> _void)) (define-crypto GENERAL_NAME_free _fpointer) +(define-crypto PEM_read_bio_DHparams (_fun _BIO* _pointer _pointer _pointer -> _DH*) #:wrap (allocator DH_free)) (define-crypto ASN1_STRING_length (_fun _ASN1_STRING* -> _int)) (define-crypto ASN1_STRING_data (_fun _ASN1_STRING* -> _pointer)) (define-crypto X509_NAME_get_index_by_NID (_fun _X509_NAME* _int _int -> _int)) @@ -331,8 +356,46 @@ 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) + +(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") + ;; Make this bigger than 4096 to accommodate at least ;; 4096 of unencrypted data (define BUFFER-SIZE 8000) @@ -467,6 +530,10 @@ TO DO: (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)]))) @@ -515,6 +582,57 @@ TO DO: (define (ssl-seal-context! mzctx) (set-ssl-context-sealed?! mzctx #t)) +(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] + [(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])) + (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)") + (unless (= 1 (SSL_CTX_ctrl ctx SSL_CTRL_SET_TMP_ECDH 0 key)) + (error 'ssl-server-context-enable-ecdhe! "Could not enable ECDH(E)")) + (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 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") + (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") + (unless (= 1 (SSL_CTX_ctrl ctx SSL_CTRL_SET_TMP_DH 0 dh)) + (error 'ssl-server-context-enable-dhe "Could not enable DHE")) + (SSL_CTX_ctrl ctx SSL_CTRL_OPTIONS SSL_OP_SINGLE_DH_USE #f) + (void))) + (define (ssl-load-... who load-it ssl-context-or-listener pathname #:try? [try? #f]) (let ([ctx (get-context/listener who ssl-context-or-listener
_________________________ Racket Developers list: http://lists.racket-lang.org/dev
