From 4b4113d5280d71f1a8674220a12bfe270bf43152 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Mon, 19 Nov 2012 19:17:07 -0500 Subject: [PATCH] get default CA cert locations (when available) This probably doesn't work on Windows or Mac OS X. --- collects/openssl/mzssl.rkt | 56 ++++++++++++++++++++++++++++++++-- collects/openssl/openssl.scrbl | 30 +++++++++++++++++- 2 files changed, 82 insertions(+), 4 deletions(-) diff --git a/collects/openssl/mzssl.rkt b/collects/openssl/mzssl.rkt index d3aabdaade..77f5893286 100644 --- a/collects/openssl/mzssl.rkt +++ b/collects/openssl/mzssl.rkt @@ -40,6 +40,9 @@ ssl-load-suggested-certificate-authorities! ssl-seal-context! + ssl-default-root-certificate-locations + ssl-load-default-verify-root-certificates! + ssl-set-verify! ssl-try-verify! ssl-set-verify-hostname! @@ -127,7 +130,7 @@ (define-ssl SSL_CTX_set_verify (_fun _SSL_CTX* _int _pointer -> _void)) (define-ssl SSL_CTX_use_certificate_chain_file (_fun _SSL_CTX* _bytes -> _int)) - (define-ssl SSL_CTX_load_verify_locations (_fun _SSL_CTX* _bytes _pointer -> _int)) + (define-ssl SSL_CTX_load_verify_locations (_fun _SSL_CTX* _bytes _bytes -> _int)) (define-ssl SSL_CTX_set_client_CA_list (_fun _SSL_CTX* _X509_NAME* -> _int)) (define-ssl SSL_CTX_set_session_id_context (_fun _SSL_CTX* _bytes _int -> _int)) (define-ssl SSL_CTX_use_RSAPrivateKey_file (_fun _SSL_CTX* _bytes _int -> _int)) @@ -174,7 +177,40 @@ #:c-id sk_value) (define-crypto sk_pop_free (_fun _STACK* _fpointer -> _void)) - + ;; (define-crypto X509_get_default_cert_area (_fun -> _string)) + (define-crypto X509_get_default_cert_dir (_fun -> _string)) + (define-crypto X509_get_default_cert_file (_fun -> _string)) + (define-crypto X509_get_default_cert_dir_env (_fun -> _string)) + (define-crypto X509_get_default_cert_file_env (_fun -> _string)) + + (define (get-x509-default get-env get-path) + (case (system-type) + ((windows) + ;; On Windows, SSLeay produces paths like "/usr/local/ssl/certs", which + ;; aren't useful. So just skip them. + #f) + (else + (and libcrypto + (let ([result (or (getenv (get-env)) (get-path))]) + (with-handlers ([exn:fail? (lambda (e) #f)]) + (string->path result))))))) + + (define ssl-default-root-certificate-locations + (make-parameter + (filter values + ;; FIXME: openssl treats dir as dir-list w/ platform-specific separator + ;; (see /crypto/x509/by_dir.c) + (list (get-x509-default X509_get_default_cert_dir_env X509_get_default_cert_dir) + (get-x509-default X509_get_default_cert_file_env X509_get_default_cert_file))) + (lambda (v) + (define (bad) + (raise-argument-error 'ssl-default-root-certificate-locations + "(listof path-string?)" + v)) + (unless (list? v) (bad)) + (for ([entry (in-list v)]) (unless (or (eq? v #f) (path-string? v)) (bad))) + v))) + (define X509_V_OK 0) (define SSL_ERROR_SSL 1) @@ -462,9 +498,23 @@ (define (ssl-load-verify-root-certificates! ssl-context-or-listener pathname) (ssl-load-... 'ssl-load-verify-root-certificates! - (lambda (a b) (SSL_CTX_load_verify_locations a b #f)) + (lambda (a b) + (cond [(directory-exists? pathname) + (SSL_CTX_load_verify_locations a #f b)] + [(file-exists? pathname) + (SSL_CTX_load_verify_locations a b #f)] + [else + (error 'ssl-load-verify-root-certificates! + "file or directory does not exist")])) ssl-context-or-listener pathname)) + (define (ssl-load-default-verify-root-certificates! ctx) + (let ([cert-locs (ssl-default-root-certificate-locations)]) + (for ([cert-loc (in-list cert-locs)]) + (cond [(or (file-exists? cert-loc) (directory-exists? cert-loc)) + (ssl-load-verify-root-certificates! ctx cert-loc)] + [else (void)])))) + (define (ssl-load-suggested-certificate-authorities! ssl-listener pathname) (ssl-load-... 'ssl-load-suggested-certificate-authorities! (lambda (ctx path) diff --git a/collects/openssl/openssl.scrbl b/collects/openssl/openssl.scrbl index f7ffb1d6df..c813a61cba 100644 --- a/collects/openssl/openssl.scrbl +++ b/collects/openssl/openssl.scrbl @@ -370,9 +370,37 @@ Loads a PEM-format file containing trusted certificates that are used to verify the certificates of a connection peer. Call this procedure multiple times to load multiple sets of trusted certificates. +If @racket[pathname] is a file, its contents are immediately +loaded. If @racket[pathname] is a directory, it should contain hashed +certificates names (see the @tt{openssl c_rehash} utility); the +directory is searched only when a certificate needs verification. + You can use the file @filepath{test.pem} of the @filepath{openssl} collection for testing purposes. Since @filepath{test.pem} is public, -such a test configuration obviously provides no security.} +such a test configuration obviously provides no security. +} + +@defparam[ssl-default-root-certificate-locations paths + (listof path-string?)]{ + +Holds a list of paths of root certificate authority certificates, used +by @racket[ssl-load-default-verify-root-certificates!]. The list of +paths may refer to both files and directories, and nonexistent paths +are allowed. + +The initial values are determined by the @tt{SSL_CERT_FILE} and +@tt{SSL_CERT_DIR} environment variables, if the variables are set, or +the system-wide default locations otherwise. +} + +@defproc[(ssl-load-default-verify-root-certificates! + [context (or/c ssl-client-context? ssl-server-context?)]) + void?]{ + +Loads the default root certificates, as determined by the +@racket[ssl-default-root-certificate-locations] parameter, into +@racket[context]. Nonexistent paths are skipped. +} @defproc[(ssl-load-suggested-certificate-authorities! (context-or-listener (or/c ssl-client-context? ssl-server-context?