146 lines
4.4 KiB
Racket
146 lines
4.4 KiB
Racket
;; 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])))
|