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

add DHE and ECDHE support, and TLS versions 1.1 and 1.2

Browse Source 
Thanks for Edward Lee for this patch.

The DH params file is identical to apps/dh4096.pem from openssl source.
This commit is contained in:
Ryan Culpepper 2014-04-11 23:22:31 -04:00
parent e8529ac30a
commit 5c11e6211c
2 changed files with 140 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
racket/collects/openssl/dh4096.pem Normal file
View File

@ -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.

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

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