diff --git a/collects/openssl/mzssl.rkt b/collects/openssl/mzssl.rkt index 9a93deba11..13e7cb5fda 100644 --- a/collects/openssl/mzssl.rkt +++ b/collects/openssl/mzssl.rkt @@ -37,11 +37,18 @@ TO DO: "libcrypto.rkt" "libssl.rkt") (lazy-require - ["private/win32.rkt" (load-win32-root-certificates)]) + ["private/win32.rkt" (load-win32-store)] + ["private/macosx.rkt" (load-macosx-keychain)]) (define protocol-symbol/c (or/c 'sslv2-or-v3 'sslv2 'sslv3 'tls)) +(define verify-source/c + (or/c path-string? + (list/c 'directory path-string?) + (list/c 'win32-store string?) + (list/c 'macosx-keychain path-string?))) + (provide (contract-out [ssl-available? boolean?] @@ -70,9 +77,7 @@ TO DO: void?)] [ssl-load-verify-source! (c-> ssl-context? - (or/c path-string? - (list/c 'directory path-string?) - (list/c 'win32-store string?)) + verify-source/c void?)] [ssl-load-suggested-certificate-authorities! (c-> (or/c ssl-context? ssl-listener?) @@ -83,11 +88,7 @@ TO DO: [ssl-seal-context! (c-> ssl-context? void?)] [ssl-default-verify-sources - (parameter/c - (listof - (or/c path-string? - (list/c 'directory path-string?) - (list/c 'win32-store string?))))] + (parameter/c (listof verify-source/c))] [ssl-load-default-verify-sources! (c-> ssl-context? void?)] [ssl-set-verify! @@ -301,8 +302,7 @@ TO DO: ;; aren't useful. So just skip them. '((win32-store "ROOT"))] [(macosx) - ;; FIXME: load from keyring - (x509-root-sources)] + '((macosx-keychain "/System/Library/Keychains/SystemRootCertificates.keychain"))] [else (x509-root-sources)]))) @@ -566,10 +566,10 @@ TO DO: (define (ssl-load-verify-source! context src #:try? [try? #f]) (define (bad-source) - (error 'ssl-load-verify-root-certificates! + (error 'ssl-load-verify-source! "internal error: bad source: ~e" src)) (cond [(path-string? src) - (ssl-load-... 'ssl-load-verify-root-certificates! + (ssl-load-... 'ssl-load-verify-source! (lambda (a b) (SSL_CTX_load_verify_locations a b #f)) context src #:try? try?)] [(and (list? src) (= (length src) 2)) @@ -577,15 +577,18 @@ TO DO: [val (cadr src)]) (case tag [(directory) - (ssl-load-... 'ssl-load-verify-root-certificates! + (ssl-load-... 'ssl-load-verify-source! (lambda (a b) (SSL_CTX_load_verify_locations a #f b)) context val #:try? try?)] [(win32-store) - (let ([ctx (get-context/listener 'ssl-load-verify-root-certificates! context + (let ([ctx (get-context/listener 'ssl-load-verify-source! context #:need-unsealed? #t)]) - (unless (path-string? val) (bad-source)) - (load-win32-root-certificates 'ssl-load-verify-root-certificates! - ctx val try?))] + (load-win32-store 'ssl-load-verify-source! + ctx val try?))] + [(macosx-keychain) + (let ([ctx (get-context/listener 'ssl-load-verify-source! context + #:need-unsealed? #t)]) + (load-macosx-keychain 'ssl-load-verify-source! ctx val try?))] [else (bad-source)]))] [else (bad-source)])) diff --git a/collects/openssl/openssl.scrbl b/collects/openssl/openssl.scrbl index c7311049f9..c195f92e43 100644 --- a/collects/openssl/openssl.scrbl +++ b/collects/openssl/openssl.scrbl @@ -344,7 +344,8 @@ against @racket[hostname]. [context (or/c ssl-client-context? ssl-server-context?)] [src (or/c path-string? (list/c 'directory path-string?) - (list/c 'win32-store string?))] + (list/c 'win32-store string?) + (list/c 'macosx-keychain path-string?))] [#:try? try? any/c #f]) void?]{ @@ -371,6 +372,10 @@ needs verification.} certificates from the store named @racket[_store] are loaded immediately. Only supported on Windows.} +@item{If @racket[src] is @racket[(list 'macosx-keychain _path)], then +the certificates from the keychain stored at @racket[_path] are loaded +immediately. Only supported on Mac OS X.} + ] If @racket[try?] is @racket[#f] and loading @racket[src] fails (for @@ -386,7 +391,8 @@ such a test configuration obviously provides no security. @defparam[ssl-default-verify-sources srcs (let ([source/c (or/c path-string? (list/c 'directory path-string?) - (list/c 'win32-store string?))]) + (list/c 'win32-store string?) + (list/c 'macosx-keychain path-string?))]) (listof source/c))]{ Holds a list of verification sources, used by @@ -395,12 +401,17 @@ on the platform: @itemlist[ -@item{On Mac OS X and Linux, the default sources are determined by the +@item{On Linux, the default sources 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.} -@item{On Windows, the default source is @racket['(win32-store -"ROOT")], the system certificate store for root certificates.} +@item{On Mac OS X, the default sources consist of the system keychain +for root certificates: @racket['(macosx-keychain +"/System/Library/Keychains/SystemRootCertificates.keychain")].} + +@item{On Windows, the default sources consist of the system +certificate store for root certificates: @racket['(win32-store +"ROOT")].} ] } diff --git a/collects/openssl/private/macosx.rkt b/collects/openssl/private/macosx.rkt new file mode 100644 index 0000000000..321c5aa3e0 --- /dev/null +++ b/collects/openssl/private/macosx.rkt @@ -0,0 +1,145 @@ +;; Support for loading root cerficates from Mac OS X keychains. + +#lang racket/base +(require ffi/unsafe + ffi/unsafe/objc + ffi/unsafe/define + "add-cert.rkt") +(provide load-macosx-keychain) + +;; TO DO: +;; - better error handling +;; - reliable mem management +;; - alternatives to deprecated functions + +;; Alternative: generate PEM file with +;; security export -k /System/Library/Keychains/... -t certs -f pemseq -o foo.pem + +(define libcf + (case (system-type) + [(macosx) (ffi-lib "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation")] + [else #f])) + +(define-ffi-definer define-cf libcf + #:default-make-fail make-not-available) + +(define _fourchar _uint32) +(define _OSStatus _sint32) +(define _CFIndex _slong) + +(define-cpointer-type _CFDataRef) + +(define-cf CFRelease (_fun _pointer -> _void)) + +(define-cf CFDataGetLength + (_fun _CFDataRef -> _CFIndex)) + +(define-cf CFDataGetBytePtr + (_fun _CFDataRef -> _pointer)) + +(define (CFData->bytes data) + (let* ([len (CFDataGetLength data)] + [buf (make-bytes len)] + [data-ptr (CFDataGetBytePtr data)]) + (memcpy buf data-ptr len) + buf)) + +;; ---- + +(define libsec + (case (system-type) + [(macosx) (ffi-lib "/System/Library/Frameworks/Security.framework/Security")] + [else #f])) +(define-ffi-definer define-sec libsec + #:default-make-fail make-not-available) + +(define CSSM_DB_RECORDTYPE_APP_DEFINED_START #x80000000) +(define kSecCertificateItemClass + (+ CSSM_DB_RECORDTYPE_APP_DEFINED_START #x1000)) +(define kSecFormatX509Cert 9) + +(define _SecExternalFormat _int) +(define-cpointer-type _SecKeychainRef) +(define-cpointer-type _SecKeychainSearchRef) +(define-cpointer-type _SecKeychainAttributeListRef) + +(define-sec SecKeychainOpen + (_fun _path + (ref : (_ptr o _SecKeychainRef/null)) + -> (result : _OSStatus) + -> (values result ref))) + +(define-sec SecKeychainSearchCreateFromAttributes + (_fun _SecKeychainRef/null ;; FIXME: or array of keychains + _fourchar + _SecKeychainAttributeListRef/null + (ref : (_ptr o _SecKeychainSearchRef/null)) + -> (result : _OSStatus) + -> (values result ref))) + +(define-sec SecKeychainSearchCopyNext ;; deprecated in 10.7 + (_fun _SecKeychainSearchRef + (next : (_ptr o _id)) + -> (result : _OSStatus) + -> (values result next))) + +(define item-export-type + (_fun (item) :: + (item : _id) ;; FIXME: SecCertificateRef or array + (_SecExternalFormat = kSecFormatX509Cert) ;; DER + (_int = 0) + (_pointer = #f) + (ref : (_ptr o _CFDataRef)) + -> (result : _OSStatus) + -> (values result ref))) + +(define-sec SecKeychainItemExport #| deprecated in 10.7 |# item-export-type) +(define-sec SecItemExport #|since 10.7|# item-export-type + #:fail (lambda () SecKeychainItemExport)) + +;; ---- + +(define (load-macosx-keychain who ssl-ctx path try?) + (define ders (keychain-path->ders who path try?)) + (define xstore (SSL_CTX_get_cert_store ssl-ctx)) + (for ([der (in-list ders)]) + (let ([x509 (d2i_X509 der)]) + (cond [x509 + ;; FIXME: check result for errors (?) + (X509_STORE_add_cert xstore x509)] + [try? (void)] + [else + (error who "retrieved invalid certificate from keychain: ~e" path)])))) + +(define (keychain-path->ders who path try?) + (define path* (path->complete-path (cleanse-path path))) + (define-values (status keychain) + (SecKeychainOpen path*)) + (begin0 (cond [(= status 0) + (keychain->ders who keychain try?)] + [try? (void)] + [else + (error who "failed to open keychain: ~e" path)]) + (CFRelease keychain))) + +(define (keychain->ders who keychain try?) + (define-values (status search) + (SecKeychainSearchCreateFromAttributes keychain kSecCertificateItemClass #f)) + (begin0 (cond [(= status 0) + (keychain-search->ders who search try?)] + [try? (void)] + [else (error "internal error: failed to open keychain search")]) + (CFRelease search))) + +(define (keychain-search->ders who search try?) + (let loop () + (define-values (status next) + (SecKeychainSearchCopyNext search)) + (cond [(= status 0) + (let-values ([(status* data) (SecItemExport next)]) + (let ([der (CFData->bytes data)]) + (CFRelease next) + (CFRelease data) + (cons der (loop))))] + ;; FIXME: other error codes? + [else null]))) diff --git a/collects/openssl/private/win32.rkt b/collects/openssl/private/win32.rkt index e4e4feefef..02e7cda5d1 100644 --- a/collects/openssl/private/win32.rkt +++ b/collects/openssl/private/win32.rkt @@ -4,10 +4,8 @@ (require ffi/unsafe ffi/unsafe/define ffi/unsafe/alloc - "../libssl.rkt" - "../libcrypto.rkt" "add-cert.rkt") -(provide load-win32-root-certificates) +(provide load-win32-store) ;; -- Windows CryptoAPI @@ -49,7 +47,7 @@ ;; FIXME: also load CRLs? -(define (load-win32-root-certificates who ssl-ctx storename try?) +(define (load-win32-store who ssl-ctx storename try?) (define cstore (CertOpenSystemStoreW storename)) (cond [cstore (define xstore (SSL_CTX_get_cert_store ssl-ctx))