Thanks for catching the typo. I don't have a good answer to your second question; I really don't know if they should.
--Edward On Thu, Apr 10, 2014 at 02:54:36PM -0400, Stephen Chang wrote: > Ok thanks. Sorry, I think one more is missing from curve/c (sect283r1)? > > Another question: Should BIO_new_mem_buf have an additional "#:wrap > (allocator BIO_free)" argument, similar to other allocating functions? > > More generally, should BIO_new and BIO_free have #:wrap arguments like > the other allocating/deallocating functions? > > On Thu, Apr 10, 2014 at 2:11 PM, Edward Lee <e45...@uwaterloo.ca> wrote: > > Those are accidental omissions; I've attached a patch that should fix > > the contract and symbol->nid. > > > > --Edward > > > > On Thu, Apr 10, 2014 at 01:39:13AM -0400, Stephen Chang wrote: > >> I checked out the patch and have a few questions. (I'm a non-expert.) > >> > >> How come some curves are omitted from the curve/c contract (eg > >> sect163k1 and sect193r2)? > >> > >> Is there also a curve missing from symbol->nid (eg sect571r1)? > >> > >> > >> On Wed, Apr 9, 2014 at 7:52 PM, Neil Van Dyke <n...@neilvandyke.org> wrote: > >> > Edward, your patch sounds OK to me, FWIW. > >> > > >> > Neil V. > >> > > >> > > >> > _________________________ > >> > Racket Developers list: > >> > http://lists.racket-lang.org/dev
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..f9d3faf 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,15 @@ 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 '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 verify-source/c (or/c path-string? @@ -50,6 +59,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 +69,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 +199,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 +211,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 +285,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 +358,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 +532,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 +584,58 @@ 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] + [(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])) + (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
