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

load certificates from macosx keychains

Browse Source
This commit is contained in:
Ryan Culpepper 2012-11-29 15:43:38 -05:00
parent f2621a5ea9
commit 10a348815b
4 changed files with 184 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/openssl/mzssl.rkt
View File

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

21
collects/openssl/openssl.scrbl
View File

@ -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")].}
]
}

145
collects/openssl/private/macosx.rkt Normal file
View File

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

6
collects/openssl/private/win32.rkt
View File

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