Many thanks Matt!<div><br></div><div><br></div><div>-Curtis</div><div><br><div class="gmail_quote">On Thu, Mar 3, 2011 at 9:36 AM, <span dir="ltr"><<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">mflatt has updated `master' from 4afd36c9fd to 8ea32d675c.<br>
<a href="http://git.racket-lang.org/plt/4afd36c9fd..8ea32d675c" target="_blank">http://git.racket-lang.org/plt/4afd36c9fd..8ea32d675c</a><br>
<br>
=====[ 4 Commits ]======================================================<br>
<br>
Directory summary:<br>
20.3% collects/openssl/<br>
79.1% collects/tests/openssl/<br>
<br>
~~~~~~~~~~<br>
<br>
107b349 Matthew Flatt <<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>> 2011-03-03 05:48<br>
:<br>
| cocoa: fix `play-sound' handling of async flag<br>
:<br>
M collects/mred/private/wx/cocoa/sound.rkt | 4 ++--<br>
<br>
~~~~~~~~~~<br>
<br>
7a33c9c Curtis Dutton <<a href="mailto:curtdutt@gmail.com">curtdutt@gmail.com</a>> 2011-02-28 07:47<br>
:<br>
| Adds ssl-try-verify! to the openssl package along with supporting procedures.<br>
|<br>
| This enables an ssl server the option to communicate with both verified and unverified peers with the same listener.<br>
|<br>
| Supporting API calls...<br>
|<br>
| ssl-peer-verified? -> returns #t if an ssl-port's peer has presented a valid and verified certificate<br>
| ssl-peer-subject-name -> returns the subject field of the certificate presented by an ssl-port's peer<br>
| ssl-peer-issuer-name -> returns the issuer field of the certificate presented by an ssl-port's peer<br>
:<br>
M collects/openssl/mzssl.rkt | 69 ++++++++++++++++++++++++++++++++++++++--<br>
<br>
~~~~~~~~~~<br>
<br>
ff6da2e Matthew Flatt <<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>> 2011-03-03 07:18<br>
:<br>
| add docs for openssl additions<br>
:<br>
M collects/openssl/mzssl.rkt | 2 --<br>
M collects/openssl/openssl.scrbl | 22 ++++++++++++++++++++++<br>
<br>
~~~~~~~~~~<br>
<br>
8ea32d6 Matthew Flatt <<a href="mailto:mflatt@racket-lang.org">mflatt@racket-lang.org</a>> 2011-03-03 07:24<br>
:<br>
| add tests from Curtis Dutton<br>
:<br>
A collects/tests/openssl/cacert.pem<br>
A collects/tests/openssl/client_crt.pem<br>
A collects/tests/openssl/client_key.pem<br>
A collects/tests/openssl/peer-verif.rkt<br>
A collects/tests/openssl/server_crt.pem<br>
A collects/tests/openssl/server_key.pem<br>
<br>
=====[ Overall Diff ]===================================================<br>
<br>
collects/mred/private/wx/cocoa/sound.rkt<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- OLD/collects/mred/private/wx/cocoa/sound.rkt<br>
+++ NEW/collects/mred/private/wx/cocoa/sound.rkt<br>
@@ -30,7 +30,7 @@<br>
(tellv s retain) ; don't use `retain', because we dont' want auto-release<br>
(tellv s play)<br>
(if async?<br>
+ #t<br>
(begin<br>
(semaphore-wait sema)<br>
- (get-ivar s result))<br>
- #t)))<br>
+ (get-ivar s result)))))<br>
<br>
collects/openssl/mzssl.rkt<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- OLD/collects/openssl/mzssl.rkt<br>
+++ NEW/collects/openssl/mzssl.rkt<br>
@@ -33,9 +33,20 @@<br>
ssl-load-private-key!<br>
ssl-load-verify-root-certificates!<br>
ssl-load-suggested-certificate-authorities!<br>
- ssl-set-verify!<br>
<br>
- ports->ssl-ports<br>
+ ssl-set-verify!<br>
+<br>
+ ;sets the ssl server to try an verify certificates<br>
+ ;it does not require verification though.<br>
+ ssl-try-verify!<br>
+<br>
+ ;call on an ssl port, this will return true if the peer<br>
+ ;presented a valid certificate and was verified<br>
+ ssl-peer-verified?<br>
+ ssl-peer-subject-name<br>
+ ssl-peer-issuer-name<br>
+<br>
+ ports->ssl-ports<br>
<br>
ssl-listen<br>
ssl-close<br>
@@ -90,6 +101,7 @@<br>
(typedef _SSL_CTX* _pointer)<br>
(typedef _SSL* _pointer)<br>
(typedef _X509_NAME* _pointer)<br>
+ (typedef _X509* _pointer)<br>
<br>
(define-ssl SSLv2_client_method (-> _SSL_METHOD*))<br>
(define-ssl SSLv2_server_method (-> _SSL_METHOD*))<br>
@@ -120,6 +132,7 @@<br>
(define-ssl SSL_CTX_use_certificate_chain_file (_SSL_CTX* _bytes -> _int))<br>
(define-ssl SSL_CTX_load_verify_locations (_SSL_CTX* _bytes _pointer -> _int))<br>
(define-ssl SSL_CTX_set_client_CA_list (_SSL_CTX* _X509_NAME* -> _int))<br>
+ (define-ssl SSL_CTX_set_session_id_context (_SSL_CTX* _bytes _int -> _int))<br>
(define-ssl SSL_CTX_use_RSAPrivateKey_file (_SSL_CTX* _bytes _int -> _int))<br>
(define-ssl SSL_CTX_use_PrivateKey_file (_SSL_CTX* _bytes _int -> _int))<br>
(define-ssl SSL_load_client_CA_file (_bytes -> _X509_NAME*))<br>
@@ -132,6 +145,12 @@<br>
(define-ssl SSL_read (_SSL* _bytes _int -> _int))<br>
(define-ssl SSL_write (_SSL* _bytes _int -> _int))<br>
(define-ssl SSL_shutdown (_SSL* -> _int))<br>
+ (define-ssl SSL_get_verify_result (_SSL* -> _long))<br>
+ (define-ssl SSL_get_peer_certificate (_SSL* -> _X509*))<br>
+<br>
+ (define-crypto X509_get_subject_name ( _X509* -> _X509_NAME*))<br>
+ (define-crypto X509_get_issuer_name ( _X509* -> _X509_NAME*))<br>
+ (define-crypto X509_NAME_oneline (_X509_NAME* _bytes _int -> _bytes))<br>
<br>
(define-ssl SSL_get_error (_SSL* _int -> _int))<br>
<br>
@@ -140,6 +159,8 @@<br>
<br>
(define-ssl SSL_library_init (-> _void))<br>
(define-ssl SSL_load_error_strings (-> _void))<br>
+<br>
+ (define X509_V_OK 0)<br>
<br>
(define SSL_ERROR_WANT_READ 2)<br>
(define SSL_ERROR_WANT_WRITE 3)<br>
@@ -390,7 +411,23 @@<br>
SSL_VERIFY_FAIL_IF_NO_PEER_CERT)<br>
SSL_VERIFY_NONE)<br>
#f)))<br>
-<br>
+<br>
+ (define (ssl-try-verify! ssl-context-or-listener on?)<br>
+ (let ([ctx (get-context/listener 'ssl-set-verify!<br>
+ ssl-context-or-listener)])<br>
+<br>
+ ;required by openssl. This is more for when calling i2d_SSL_SESSION/d2i_SSL_SESSION<br>
+ ;for instance if we were saving sessions in a database etc... We aren't using that<br>
+ ;so a generic session name should be fine.<br>
+ (let ([bytes #"racket"])<br>
+ (SSL_CTX_set_session_id_context ctx bytes (bytes-length bytes)))<br>
+<br>
+ (SSL_CTX_set_verify ctx<br>
+ (if on?<br>
+ SSL_VERIFY_PEER<br>
+ SSL_VERIFY_NONE)<br>
+ #f)))<br>
+<br>
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br>
;; SSL ports<br>
<br>
@@ -932,6 +969,28 @@<br>
(when input?<br>
(raise-type-error 'ssl-abandon-port "SSL output port" p))<br>
(set-mzssl-shutdown-on-close?! mzssl #f)))<br>
+<br>
+ (define (ssl-peer-verified? p)<br>
+ (let-values ([(mzssl input?) (lookup 'ssl-peer-verified? "SSL port" p)])<br>
+ (and (eq? X509_V_OK (SSL_get_verify_result (mzssl-ssl mzssl)))<br>
+ (SSL_get_peer_certificate (mzssl-ssl mzssl))<br>
+ #t)))<br>
+<br>
+ (define (ssl-peer-subject-name p)<br>
+ (let-values ([(mzssl input?) (lookup 'ssl-peer-subject-name "SSL port" p)])<br>
+ (let ([cert (SSL_get_peer_certificate (mzssl-ssl mzssl))])<br>
+ (if cert<br>
+ (let ([bytes (make-bytes 1024 0)])<br>
+ (X509_NAME_oneline (X509_get_subject_name cert) bytes (bytes-length bytes)))<br>
+ #f))))<br>
+<br>
+ (define (ssl-peer-issuer-name p)<br>
+ (let-values ([(mzssl input?) (lookup 'ssl-peer-subject-name "SSL port" p)])<br>
+ (let ([cert (SSL_get_peer_certificate (mzssl-ssl mzssl))])<br>
+ (if cert<br>
+ (let ([bytes (make-bytes 1024 0)])<br>
+ (X509_NAME_oneline (X509_get_issuer_name cert) bytes (bytes-length bytes)))<br>
+ #f))))<br>
<br>
(define (ssl-port? v)<br>
(and (hash-ref ssl-ports v #f) #t))<br>
@@ -977,7 +1036,7 @@<br>
<br>
(define (ssl-accept/enable-break ssl-listener)<br>
(do-ssl-accept 'ssl-accept/enable-break tcp-accept/enable-break ssl-listener))<br>
-<br>
+<br>
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br>
;; SSL connect<br>
<br>
<br>
collects/openssl/openssl.scrbl<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- OLD/collects/openssl/openssl.scrbl<br>
+++ NEW/collects/openssl/openssl.scrbl<br>
@@ -364,6 +364,28 @@ collection for testing purposes where the peer identifies itself using<br>
@filepath{test.pem}.}<br>
<br>
@; ----------------------------------------------------------------------<br>
+@section[#:tag "peer-verif"]{Peer Verification}<br>
+<br>
+@defproc[(ssl-peer-verified? [p ssl-port?]) boolean?]{<br>
+<br>
+Returns @racket[#t] if the peer of SSL port @racket[p] has presented a<br>
+valid and verified certificate, @racket[#f] otherwise.}<br>
+<br>
+@defproc[(ssl-peer-subject-name [p ssl-port?]) (or/c bytes? #f)]{<br>
+<br>
+If @racket[ssl-peer-verified?] would return @racket[#t] for<br>
+@racket[p], the result is a byte string for the subject field of<br>
+the certificate presented by the SSL port's peer, otherwise the result<br>
+is @racket[#f].}<br>
+<br>
+@defproc[(ssl-peer-issuer-name [p ssl-port?]) (or/c bytes? #f)]{<br>
+<br>
+If @racket[ssl-peer-verified?] would return @racket[#t] for<br>
+@racket[p], the result is a byte string for the issuer field of<br>
+the certificate presented by the SSL port's peer, otherwise the result<br>
+is @racket[#f].}<br>
+<br>
+@; ----------------------------------------------------------------------<br>
<br>
@section{SHA-1 Hashing}<br>
<br>
<br>
collects/tests/openssl/cacert.pem<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- /dev/null<br>
+++ NEW/collects/tests/openssl/cacert.pem<br>
@@ -0,0 +1,22 @@<br>
+-----BEGIN CERTIFICATE-----<br>
+MIIDnTCCAoWgAwIBAgIJAI1o0DxhqPigMA0GCSqGSIb3DQEBBAUAMIGEMRQwEgYD<br>
+VQQDEwtva2NvbXBzLmNvbTELMAkGA1UECBMCT0gxCzAJBgNVBAYTAlVTMR8wHQYJ<br>
+KoZIhvcNAQkBFhByb290QG9rY29tcHMuY29tMRkwFwYDVQQKExBPSyBDb21wdXRl<br>
+cnMgTExDMRYwFAYDVQQLEw1JVCBEZXBhcnRtZW50MB4XDTExMDEyMTEzMTEwNloX<br>
+DTE2MDEyMDEzMTEwNlowgYQxFDASBgNVBAMTC29rY29tcHMuY29tMQswCQYDVQQI<br>
+EwJPSDELMAkGA1UEBhMCVVMxHzAdBgkqhkiG9w0BCQEWEHJvb3RAb2tjb21wcy5j<br>
+b20xGTAXBgNVBAoTEE9LIENvbXB1dGVycyBMTEMxFjAUBgNVBAsTDUlUIERlcGFy<br>
+dG1lbnQwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDTouNqzEoG/eof<br>
+H75hyNEd7VFRjbBddbu1194eCzfqmiNYacTx8Xhphf9fRNkR5Bznz5dfIrzFqvBJ<br>
+dv4H5BZrZ4cGqDLOdYQtxPdgq5DzfsjIxtck9XKEyZSfV/K2gm1mnqtJ/fYiL2Wm<br>
+Oawrjgtvm3rS/3p0kk/vlS74VfuUX68/S+DgfUX3dvrKXqJn4skcxy1cEt+8GBsH<br>
+CsfwZC3oh+Oi2HO9bmMatp0OgxvuEyc3cwTbdR9JWOs/7eQeGIp6zYwChJqpajSM<br>
+WfwBfY+oQazZrZGbVY+MDPHGD7QTdHn8P0RPCqZpz3f7RnL3Emc1XXGuZBnRa7sv<br>
+KWUsCiP9AgMBAAGjEDAOMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEEBQADggEB<br>
+AF6ifcd9/uawOKBAvhMrAS7gTFHXSdc+KoVlPp4SM6+6rllrmxGoGrvXv2NQKjiG<br>
+4Vz0AENCk5vd/i8U2+wkBXnDQFE2ckZwiao33Z4FBq1BYtOP3+mxcg9DDuz2fywn<br>
+LCRBVVVeTXEdoAs3kzMjArPGCP4nXzyGD8zQDv9pcSHJfafPf45Sf1QHhPIm8DdL<br>
+Z2uQQ9aZwMPQwWjVEhPIbB2eXLnRMEMH9JE9mKEhN+epKljyLDADXs+bSkg3QMaT<br>
+d3Bqv9wjBrH2tztqVkq0os0tRFUlVPB6g0ave0Dgp99LolbQJbYlGas6CISS6ueD<br>
+plEJK3Mrw7v832Wqnjx8vhE=<br>
+-----END CERTIFICATE-----<br>
<br>
collects/tests/openssl/client_crt.pem<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- /dev/null<br>
+++ NEW/collects/tests/openssl/client_crt.pem<br>
@@ -0,0 +1,67 @@<br>
+Certificate:<br>
+ Data:<br>
+ Version: 3 (0x2)<br>
+ Serial Number: 4 (0x4)<br>
+ Signature Algorithm: md5WithRSAEncryption<br>
+ Issuer: CN=<a href="http://okcomps.com" target="_blank">okcomps.com</a>, ST=OH, C=US/emailAddress=<a href="mailto:root@okcomps.com">root@okcomps.com</a>, O=OK Computers LLC, OU=IT Department<br>
+ Validity<br>
+ Not Before: Jan 22 16:49:23 2011 GMT<br>
+ Not After : Jan 21 16:49:23 2016 GMT<br>
+ Subject: CN=<a href="http://testclient.okcomps.com" target="_blank">testclient.okcomps.com</a>, ST=OH, C=US/emailAddress=<a href="mailto:root@okcomps.com">root@okcomps.com</a>, O=OK Computers LLC, OU=IT<br>
+ Subject Public Key Info:<br>
+ Public Key Algorithm: rsaEncryption<br>
+ RSA Public Key: (1024 bit)<br>
+ Modulus (1024 bit):<br>
+ 00:e3:a1:8c:40:df:26:a5:52:31:f2:65:94:fa:f3:<br>
+ 32:1a:a1:d1:06:e3:32:f4:ae:17:27:38:49:c4:8f:<br>
+ f0:6a:61:4a:b1:12:a8:ff:22:5e:a8:b8:d2:be:24:<br>
+ 83:1d:48:e4:62:8d:b8:a3:a0:b7:68:d2:dc:53:11:<br>
+ fd:cd:87:67:7e:30:76:41:18:d4:97:7d:4f:75:8c:<br>
+ b3:17:6a:d4:5f:e2:fa:4c:c3:e0:a5:2b:d5:b2:f0:<br>
+ 9a:fc:8c:ec:fb:99:8c:51:b0:62:54:91:c2:64:d1:<br>
+ 79:41:da:8f:88:40:76:81:29:d0:0a:f7:63:51:76:<br>
+ 7a:23:f1:ca:57:d1:0e:1b:b5<br>
+ Exponent: 65537 (0x10001)<br>
+ X509v3 extensions:<br>
+ X509v3 Subject Alternative Name:<br>
+ DNS:<a href="http://alt.tradeshowhell.com" target="_blank">alt.tradeshowhell.com</a><br>
+ X509v3 Basic Constraints:<br>
+ CA:FALSE<br>
+ Netscape Cert Type:<br>
+ SSL Client<br>
+ Signature Algorithm: md5WithRSAEncryption<br>
+ d0:1c:c8:74:87:06:0b:96:3d:05:4e:19:e4:19:9e:0a:12:76:<br>
+ 57:c7:a3:24:34:dd:af:e9:67:cd:99:2a:43:d7:e6:b6:18:eb:<br>
+ b4:b0:63:be:e6:d8:ff:99:95:81:a7:88:b9:68:b9:0e:2f:cb:<br>
+ 2b:2b:7c:0e:c4:66:d3:f4:89:91:ba:03:0a:35:e1:6b:19:0e:<br>
+ 41:c8:f3:3c:bf:47:c1:60:ee:88:74:0a:41:08:4e:82:be:ae:<br>
+ 46:b0:31:8d:f8:10:84:1a:af:03:52:39:87:b7:46:2f:7f:2e:<br>
+ f1:a6:03:4e:3c:bb:ea:0c:08:8f:77:17:b7:c8:d2:a5:a7:a0:<br>
+ 56:9b:c8:5b:53:d1:36:01:96:85:46:c9:73:e5:cf:40:8c:fa:<br>
+ b2:c1:be:3e:8f:24:97:c3:35:ec:45:59:b3:f4:9b:3f:b0:50:<br>
+ 5d:2b:d3:19:11:c6:5d:c1:61:26:db:34:4a:69:46:5a:c1:f2:<br>
+ 43:f9:5a:4d:71:44:2a:62:28:c0:ac:51:63:35:88:cc:6d:9a:<br>
+ db:7b:d1:a1:a2:e4:86:96:83:48:73:7f:c9:a3:05:e6:46:82:<br>
+ 1c:b4:99:9e:7a:b6:1e:87:08:e6:1d:b1:04:0f:ed:19:a6:b1:<br>
+ ce:71:47:ce:73:de:8c:d8:13:aa:a8:6f:b0:04:0c:9b:b7:d1:<br>
+ 61:da:90:e3<br>
+-----BEGIN CERTIFICATE-----<br>
+MIIDQzCCAiugAwIBAgIBBDANBgkqhkiG9w0BAQQFADCBhDEUMBIGA1UEAxMLb2tj<br>
+b21wcy5jb20xCzAJBgNVBAgTAk9IMQswCQYDVQQGEwJVUzEfMB0GCSqGSIb3DQEJ<br>
+ARYQcm9vdEBva2NvbXBzLmNvbTEZMBcGA1UEChMQT0sgQ29tcHV0ZXJzIExMQzEW<br>
+MBQGA1UECxMNSVQgRGVwYXJ0bWVudDAeFw0xMTAxMjIxNjQ5MjNaFw0xNjAxMjEx<br>
+NjQ5MjNaMIGEMR8wHQYDVQQDExZ0ZXN0Y2xpZW50Lm9rY29tcHMuY29tMQswCQYD<br>
+VQQIEwJPSDELMAkGA1UEBhMCVVMxHzAdBgkqhkiG9w0BCQEWEHJvb3RAb2tjb21w<br>
+cy5jb20xGTAXBgNVBAoTEE9LIENvbXB1dGVycyBMTEMxCzAJBgNVBAsTAklUMIGf<br>
+MA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDjoYxA3yalUjHyZZT68zIaodEG4zL0<br>
+rhcnOEnEj/BqYUqxEqj/Il6ouNK+JIMdSORijbijoLdo0txTEf3Nh2d+MHZBGNSX<br>
+fU91jLMXatRf4vpMw+ClK9Wy8Jr8jOz7mYxRsGJUkcJk0XlB2o+IQHaBKdAK92NR<br>
+dnoj8cpX0Q4btQIDAQABo0IwQDAgBgNVHREEGTAXghVhbHQudHJhZGVzaG93aGVs<br>
+bC5jb20wCQYDVR0TBAIwADARBglghkgBhvhCAQEEBAMCB4AwDQYJKoZIhvcNAQEE<br>
+BQADggEBANAcyHSHBguWPQVOGeQZngoSdlfHoyQ03a/pZ82ZKkPX5rYY67SwY77m<br>
+2P+ZlYGniLlouQ4vyysrfA7EZtP0iZG6Awo14WsZDkHI8zy/R8Fg7oh0CkEIToK+<br>
+rkawMY34EIQarwNSOYe3Ri9/LvGmA048u+oMCI93F7fI0qWnoFabyFtT0TYBloVG<br>
+yXPlz0CM+rLBvj6PJJfDNexFWbP0mz+wUF0r0xkRxl3BYSbbNEppRlrB8kP5Wk1x<br>
+RCpiKMCsUWM1iMxtmtt70aGi5IaWg0hzf8mjBeZGghy0mZ56th6HCOYdsQQP7Rmm<br>
+sc5xR85z3ozYE6qob7AEDJu30WHakOM=<br>
+-----END CERTIFICATE-----<br>
<br>
collects/tests/openssl/client_key.pem<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- /dev/null<br>
+++ NEW/collects/tests/openssl/client_key.pem<br>
@@ -0,0 +1,15 @@<br>
+-----BEGIN RSA PRIVATE KEY-----<br>
+MIICXAIBAAKBgQDjoYxA3yalUjHyZZT68zIaodEG4zL0rhcnOEnEj/BqYUqxEqj/<br>
+Il6ouNK+JIMdSORijbijoLdo0txTEf3Nh2d+MHZBGNSXfU91jLMXatRf4vpMw+Cl<br>
+K9Wy8Jr8jOz7mYxRsGJUkcJk0XlB2o+IQHaBKdAK92NRdnoj8cpX0Q4btQIDAQAB<br>
+AoGAPgUF8abbILAEa8bBkJ4ySI9OJFJCz+ee51CuyJ9vIYzgjN5IrTrwD4hL4wKP<br>
+tqrljvSOGgbv8d+BqCB+xkDeMT/mFBOyCKrrOX7TSSvVfu9ihRtiy7v2vjodwTNq<br>
+L82JKscJXTwgR3QrJv6JPb/iZItbweFE4/UWMFDEd7J+dQECQQD5WzSmGTxWdvjx<br>
+l+jhdVQmA6O87txBPAJP+hAfq/ViAIwVxEeDTBDYKHXBAzIjSpigerG6WkW8AeCQ<br>
+2aDJOnRHAkEA6bIo+1xwwhZb42kPWiLKhW4bwKM7K7Y3uetQMehu8BOubr6QMHKb<br>
+QCjz3/e+ldQ3tV9AgcFmp0juZ4YoBTcaIwJAPVZjIAyLHBXN7NfaUENlPKieiWYU<br>
+RfO1+ehgOPo6tS2/R8dtc+2tIw7o0F6x4Z6C5s7nkxiLmNC5Zcgy1e0MFwJBAIwP<br>
+WPx9RJ8uI1hCKQ9Odq5NdZiYu+fQx8lHvMKMmaCNSyfYUjaXGXD0mmUK6FCH5fNv<br>
+6QtbTBjKXwfwoZ+ujJ0CQHAOCJY1vtycRYFh7B+A6Emp/w5aJAqJqS4A79FjCf3N<br>
+w8MwJrAPTXvKILEnvhuW5uxg5VXqndK/gz+6z/eZyS4=<br>
+-----END RSA PRIVATE KEY-----<br>
<br>
collects/tests/openssl/peer-verif.rkt<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- /dev/null<br>
+++ NEW/collects/tests/openssl/peer-verif.rkt<br>
@@ -0,0 +1,72 @@<br>
+#lang racket<br>
+<br>
+(require openssl<br>
+ ffi/unsafe<br>
+ racket/tcp)<br>
+<br>
+(define (check fmt got expect)<br>
+ (unless (equal? got expect)<br>
+ (error 'check fmt got)))<br>
+<br>
+(define ssl-server-context (ssl-make-server-context 'sslv3))<br>
+<br>
+<br>
+(ssl-load-private-key! ssl-server-context "server_key.pem")<br>
+(ssl-load-certificate-chain! ssl-server-context "server_crt.pem")<br>
+(ssl-load-verify-root-certificates! ssl-server-context "cacert.pem")<br>
+(ssl-try-verify! ssl-server-context #t)<br>
+<br>
+(define ssl-listener (ssl-listen 55000<br>
+ 4<br>
+ #f<br>
+ "127.0.0.1"<br>
+ ssl-server-context))<br>
+<br>
+(define listener-main<br>
+ (thread<br>
+ (lambda()<br>
+ (let-values ([(in out) (ssl-accept ssl-listener)])<br>
+ (check "Server: Accepted connection.~n" #t #t)<br>
+ (check "Server: Verified ~v~n" (ssl-peer-verified? in) #t)<br>
+ (check "Server: Verified ~v~n" (ssl-peer-verified? out) #t)<br>
+ (check "Server: Verified Peer Subject Name ~v~n" (ssl-peer-subject-name in)<br>
+ #"/CN=<a href="http://testclient.okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK" target="_blank">testclient.okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK</a> Computers LLC/OU=IT")<br>
+ (check "Server: Verified Peer Issuer Name ~v~n" (ssl-peer-issuer-name in)<br>
+ #"/CN=<a href="http://okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK" target="_blank">okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK</a> Computers LLC/OU=IT Department")<br>
+ (ssl-close ssl-listener)<br>
+ (check "Server: From Client: ~a~n" (read-line in) "yay the connection was made")<br>
+ (close-input-port in)<br>
+ (close-output-port out)))))<br>
+<br>
+<br>
+(define ssl-client-context (ssl-make-client-context 'sslv3))<br>
+<br>
+(ssl-load-private-key! ssl-client-context "client_key.pem")<br>
+<br>
+;connection will still proceed if these methods aren't called<br>
+;change to #f to try it<br>
+(when #t<br>
+ (ssl-load-certificate-chain! ssl-client-context "client_crt.pem")<br>
+ (ssl-load-verify-root-certificates! ssl-client-context "cacert.pem")<br>
+ (ssl-set-verify! ssl-client-context #t))<br>
+<br>
+<br>
+(let-values ([(in out) (ssl-connect "127.0.0.1"<br>
+ 55000<br>
+ ssl-client-context)])<br>
+ (check "Client: Made connection.~n" #t #t)<br>
+ (check "Client: Verified ~v~n" (ssl-peer-verified? in) #t)<br>
+ (check "Client: Verified ~v~n" (ssl-peer-verified? out) #t)<br>
+ (check "Client: Verified Peer Subject Name ~v~n" (ssl-peer-subject-name in)<br>
+ #"/CN=<a href="http://test.okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK" target="_blank">test.okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK</a> Computers LLC/OU=IT")<br>
+ (check "Client: Verified Peer Issuer Name ~v~n" (ssl-peer-issuer-name in)<br>
+ #"/CN=<a href="http://okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK" target="_blank">okcomps.com/ST=OH/C=US/emailAddress=root@okcomps.com/O=OK</a> Computers LLC/OU=IT Department")<br>
+ (write-string (format "yay the connection was made~n") out)<br>
+ (close-input-port in)<br>
+ (close-output-port out))<br>
+<br>
+<br>
+(thread-wait listener-main)<br>
+<br>
+;certificate revocation list<br>
+;enables denial of connections that provide a certificate on the given certificate revocation list<br>
<br>
collects/tests/openssl/server_crt.pem<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- /dev/null<br>
+++ NEW/collects/tests/openssl/server_crt.pem<br>
@@ -0,0 +1,67 @@<br>
+Certificate:<br>
+ Data:<br>
+ Version: 3 (0x2)<br>
+ Serial Number: 1 (0x1)<br>
+ Signature Algorithm: md5WithRSAEncryption<br>
+ Issuer: CN=<a href="http://okcomps.com" target="_blank">okcomps.com</a>, ST=OH, C=US/emailAddress=<a href="mailto:root@okcomps.com">root@okcomps.com</a>, O=OK Computers LLC, OU=IT Department<br>
+ Validity<br>
+ Not Before: Jan 21 13:19:20 2011 GMT<br>
+ Not After : Jan 20 13:19:20 2016 GMT<br>
+ Subject: CN=<a href="http://test.okcomps.com" target="_blank">test.okcomps.com</a>, ST=OH, C=US/emailAddress=<a href="mailto:root@okcomps.com">root@okcomps.com</a>, O=OK Computers LLC, OU=IT<br>
+ Subject Public Key Info:<br>
+ Public Key Algorithm: rsaEncryption<br>
+ RSA Public Key: (1024 bit)<br>
+ Modulus (1024 bit):<br>
+ 00:ca:d0:a2:7c:5d:0c:bc:df:3b:1c:d2:b7:d4:b3:<br>
+ 68:12:1b:3a:df:5e:75:f6:9f:71:1a:b2:29:76:e7:<br>
+ 55:eb:2d:d2:cf:c1:a7:2f:54:91:68:cc:f0:ce:10:<br>
+ 42:d4:d2:82:0d:56:f0:16:aa:a8:a4:f3:4f:c3:f7:<br>
+ 55:3c:a0:90:c3:a9:04:63:86:90:7f:64:49:77:0d:<br>
+ 9b:7b:02:e2:04:ec:52:08:c4:01:72:e4:e6:89:18:<br>
+ f6:fc:cc:8d:b6:9b:24:f4:c6:a9:78:67:e4:15:d4:<br>
+ 68:1e:da:67:4f:d9:40:48:44:f0:9a:ae:5a:87:24:<br>
+ 2a:b5:2e:83:d6:ad:f4:e5:9b<br>
+ Exponent: 65537 (0x10001)<br>
+ X509v3 extensions:<br>
+ X509v3 Subject Alternative Name:<br>
+ DNS:<a href="http://alt.tradeshowhell.com" target="_blank">alt.tradeshowhell.com</a><br>
+ X509v3 Basic Constraints:<br>
+ CA:FALSE<br>
+ Netscape Cert Type:<br>
+ SSL Server<br>
+ Signature Algorithm: md5WithRSAEncryption<br>
+ ab:c9:75:73:f9:79:31:34:b9:3b:83:2f:3f:9e:4e:33:01:98:<br>
+ 37:9b:bd:08:d6:14:ea:d9:a1:fa:7a:0d:ae:dc:00:fd:a6:01:<br>
+ ba:3e:d6:ed:8b:8d:43:ba:41:51:08:c6:c5:db:84:34:34:07:<br>
+ 17:19:35:5d:8c:7f:37:b8:c1:02:c3:22:d9:dc:f4:85:4d:1c:<br>
+ 6e:44:43:0d:7a:5a:de:4c:ba:a3:4b:a3:9b:07:3a:dd:f0:69:<br>
+ 3d:89:65:e4:0d:f6:0d:04:58:00:74:b6:11:5e:e2:a7:1c:8d:<br>
+ d4:83:e3:9b:93:85:f7:d1:7c:5f:67:0c:38:02:1f:d6:44:0d:<br>
+ 73:22:5f:d2:ff:e1:ef:be:11:e4:e7:1c:b7:d6:8b:b6:78:bb:<br>
+ 09:e1:46:94:48:24:98:88:b2:6d:27:2a:85:5a:cd:34:b5:c4:<br>
+ 74:1b:58:97:f8:4a:aa:13:e1:13:4d:86:80:36:b2:9a:31:3a:<br>
+ be:3f:c7:1b:76:71:e9:b5:7d:4b:61:9b:59:ad:c7:1b:2e:b8:<br>
+ 7c:bd:6f:f8:06:44:eb:7b:fd:53:45:b0:fa:a4:37:b4:56:e2:<br>
+ 87:ba:d4:5c:49:db:7d:31:a4:42:d3:d7:47:a3:6f:cb:e3:9d:<br>
+ 5c:be:2e:eb:1b:0a:06:e2:ce:d6:c4:81:c2:c1:85:36:dc:4c:<br>
+ 03:5b:b3:14<br>
+-----BEGIN CERTIFICATE-----<br>
+MIIDPDCCAiSgAwIBAgIBATANBgkqhkiG9w0BAQQFADCBhDEUMBIGA1UEAxMLb2tj<br>
+b21wcy5jb20xCzAJBgNVBAgTAk9IMQswCQYDVQQGEwJVUzEfMB0GCSqGSIb3DQEJ<br>
+ARYQcm9vdEBva2NvbXBzLmNvbTEZMBcGA1UEChMQT0sgQ29tcHV0ZXJzIExMQzEW<br>
+MBQGA1UECxMNSVQgRGVwYXJ0bWVudDAeFw0xMTAxMjExMzE5MjBaFw0xNjAxMjAx<br>
+MzE5MjBaMH4xGTAXBgNVBAMTEHRlc3Qub2tjb21wcy5jb20xCzAJBgNVBAgTAk9I<br>
+MQswCQYDVQQGEwJVUzEfMB0GCSqGSIb3DQEJARYQcm9vdEBva2NvbXBzLmNvbTEZ<br>
+MBcGA1UEChMQT0sgQ29tcHV0ZXJzIExMQzELMAkGA1UECxMCSVQwgZ8wDQYJKoZI<br>
+hvcNAQEBBQADgY0AMIGJAoGBAMrQonxdDLzfOxzSt9SzaBIbOt9edfafcRqyKXbn<br>
+Vest0s/Bpy9UkWjM8M4QQtTSgg1W8BaqqKTzT8P3VTygkMOpBGOGkH9kSXcNm3sC<br>
+4gTsUgjEAXLk5okY9vzMjbabJPTGqXhn5BXUaB7aZ0/ZQEhE8JquWockKrUug9at<br>
+9OWbAgMBAAGjQjBAMCAGA1UdEQQZMBeCFWFsdC50cmFkZXNob3doZWxsLmNvbTAJ<br>
+BgNVHRMEAjAAMBEGCWCGSAGG+EIBAQQEAwIGQDANBgkqhkiG9w0BAQQFAAOCAQEA<br>
+q8l1c/l5MTS5O4MvP55OMwGYN5u9CNYU6tmh+noNrtwA/aYBuj7W7YuNQ7pBUQjG<br>
+xduENDQHFxk1XYx/N7jBAsMi2dz0hU0cbkRDDXpa3ky6o0ujmwc63fBpPYll5A32<br>
+DQRYAHS2EV7ipxyN1IPjm5OF99F8X2cMOAIf1kQNcyJf0v/h774R5Occt9aLtni7<br>
+CeFGlEgkmIiybScqhVrNNLXEdBtYl/hKqhPhE02GgDaymjE6vj/HG3Zx6bV9S2Gb<br>
+Wa3HGy64fL1v+AZE63v9U0Ww+qQ3tFbih7rUXEnbfTGkQtPXR6Nvy+OdXL4u6xsK<br>
+BuLO1sSBwsGFNtxMA1uzFA==<br>
+-----END CERTIFICATE-----<br>
<br>
collects/tests/openssl/server_key.pem<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- /dev/null<br>
+++ NEW/collects/tests/openssl/server_key.pem<br>
@@ -0,0 +1,15 @@<br>
+-----BEGIN RSA PRIVATE KEY-----<br>
+MIICXQIBAAKBgQDK0KJ8XQy83zsc0rfUs2gSGzrfXnX2n3Easil251XrLdLPwacv<br>
+VJFozPDOEELU0oINVvAWqqik80/D91U8oJDDqQRjhpB/ZEl3DZt7AuIE7FIIxAFy<br>
+5OaJGPb8zI22myT0xql4Z+QV1Gge2mdP2UBIRPCarlqHJCq1LoPWrfTlmwIDAQAB<br>
+AoGAN2HRfPRLzieHFM/Vsxdqi8czxFsfC0FuuUN9XyK8q4PP1TukU6BcNKoB98Mo<br>
+/MSfDtV2qjnf42stlO2tMOkHnmkx6Kz/aoiG7rfPjVqRVOy+LZ6HZj5bxaIC0WkF<br>
+2RbuHB2pLmrZGfQI0F/aFQpUQCqM4S4e1SDBxAyygtzkaUECQQD7pqWpXQ+VjejK<br>
+/Gd8hNPQk71vziJsXn3fVVa0aYxh8WapbvQODC6aMvow4ows6oJgMJdsfjBfBDbd<br>
+KNtcTCbHAkEAzlHtfH+o6dVuAaURUfhDj4Ld25/ZQepKMsI3CJaS3eP5+efVbjhr<br>
+yedC+p7moN9oTLPxee+EqoB8921MWa4mjQJAI/upNnVrFAxtnBDJT2HC09E8Ri9o<br>
+dqxwPS37ruJkw2B8OH/3/8Y4J65gXfsW5hlGOTDZhhbpHb0Bh1AfRaxR4wJBALn+<br>
+EWFSlCt4RBsne12xuPX+u5HpoClT1F+9xW7wjqWJhyhKXpVmN4Vj/XWBGdecjqHW<br>
+9bE+wxIRkpZa6aFO5WECQQChsZbIQ3Oa5D5cjmImzmhWS7pYB/hTt3RZODiB35Ec<br>
+0tDEkEYz3kx2WmVQdXnlP3/JS8F9FrDJX+y2YxLhvQ75<br>
+-----END RSA PRIVATE KEY-----<br>
</blockquote></div><br></div>