get default CA cert locations (when available)
This probably doesn't work on Windows or Mac OS X.
This commit is contained in:
parent
c632a84a95
commit
4b4113d528
|
@ -40,6 +40,9 @@
|
||||||
ssl-load-suggested-certificate-authorities!
|
ssl-load-suggested-certificate-authorities!
|
||||||
ssl-seal-context!
|
ssl-seal-context!
|
||||||
|
|
||||||
|
ssl-default-root-certificate-locations
|
||||||
|
ssl-load-default-verify-root-certificates!
|
||||||
|
|
||||||
ssl-set-verify!
|
ssl-set-verify!
|
||||||
ssl-try-verify!
|
ssl-try-verify!
|
||||||
ssl-set-verify-hostname!
|
ssl-set-verify-hostname!
|
||||||
|
@ -127,7 +130,7 @@
|
||||||
|
|
||||||
(define-ssl SSL_CTX_set_verify (_fun _SSL_CTX* _int _pointer -> _void))
|
(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_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_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_set_session_id_context (_fun _SSL_CTX* _bytes _int -> _int))
|
||||||
(define-ssl SSL_CTX_use_RSAPrivateKey_file (_fun _SSL_CTX* _bytes _int -> _int))
|
(define-ssl SSL_CTX_use_RSAPrivateKey_file (_fun _SSL_CTX* _bytes _int -> _int))
|
||||||
|
@ -174,6 +177,39 @@
|
||||||
#:c-id sk_value)
|
#:c-id sk_value)
|
||||||
(define-crypto sk_pop_free (_fun _STACK* _fpointer -> _void))
|
(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 X509_V_OK 0)
|
||||||
|
|
||||||
|
@ -462,9 +498,23 @@
|
||||||
|
|
||||||
(define (ssl-load-verify-root-certificates! ssl-context-or-listener pathname)
|
(define (ssl-load-verify-root-certificates! ssl-context-or-listener pathname)
|
||||||
(ssl-load-... 'ssl-load-verify-root-certificates!
|
(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))
|
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)
|
(define (ssl-load-suggested-certificate-authorities! ssl-listener pathname)
|
||||||
(ssl-load-... 'ssl-load-suggested-certificate-authorities!
|
(ssl-load-... 'ssl-load-suggested-certificate-authorities!
|
||||||
(lambda (ctx path)
|
(lambda (ctx path)
|
||||||
|
|
|
@ -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
|
to verify the certificates of a connection peer. Call this procedure
|
||||||
multiple times to load multiple sets of trusted certificates.
|
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}
|
You can use the file @filepath{test.pem} of the @filepath{openssl}
|
||||||
collection for testing purposes. Since @filepath{test.pem} is public,
|
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!
|
@defproc[(ssl-load-suggested-certificate-authorities!
|
||||||
(context-or-listener (or/c ssl-client-context? ssl-server-context?
|
(context-or-listener (or/c ssl-client-context? ssl-server-context?
|
||||||
|
|
Loading…
Reference in New Issue
Block a user