diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,8 @@ +# ChangeLog for crypton-x509-system + +## 1.6.8 + +* Prefer OpenSSL env vars: SSL_CERT_FILE and SSL_CERT_DIR + [#26](https://github.com/kazu-yamamoto/crypton-certificate/pull/26) +* Unix defaultSystemPaths: add new Fedora default cert filepath + [#19](https://github.com/kazu-yamamoto/crypton-certificate/pull/19) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/System/X509.hs b/System/X509.hs --- a/System/X509.hs +++ b/System/X509.hs @@ -1,14 +1,14 @@ {-# LANGUAGE CPP #-} + -- | -- Module : System.X509 -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : good --- -module System.X509 - ( getSystemCertificateStore - ) where +module System.X509 ( + getSystemCertificateStore, +) where #if defined(WINDOWS) import System.X509.Win32 diff --git a/System/X509/Common.hs b/System/X509/Common.hs new file mode 100644 --- /dev/null +++ b/System/X509/Common.hs @@ -0,0 +1,26 @@ +module System.X509.Common ( + maybeSSLCertEnvOr, +) +where + +import Data.Foldable (asum) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Monoid (mconcat) +import Data.X509.CertificateStore +import System.Environment (lookupEnv) + +getOpenSslEnvs :: IO (Maybe String) +getOpenSslEnvs = + asum + <$> traverse + lookupEnv + [ "SSL_CERT_FILE" + , "SSL_CERT_DIR" + ] + +maybeSSLCertEnvOr :: IO CertificateStore -> IO CertificateStore +maybeSSLCertEnvOr defaultStore = do + overrideCertPaths <- getOpenSslEnvs + case overrideCertPaths of + Nothing -> defaultStore + Just certPath -> fromMaybe mempty <$> (readCertificateStore certPath) diff --git a/System/X509/MacOS.hs b/System/X509/MacOS.hs --- a/System/X509/MacOS.hs +++ b/System/X509/MacOS.hs @@ -1,15 +1,16 @@ -module System.X509.MacOS - ( getSystemCertificateStore - ) where +module System.X509.MacOS ( + getSystemCertificateStore, +) where -import Data.PEM (pemParseLBS, PEM(..)) -import System.Process -import qualified Data.ByteString.Lazy as LBS import Control.Applicative +import qualified Data.ByteString.Lazy as LBS import Data.Either +import Data.PEM (PEM (..), pemParseLBS) +import System.Process import Data.X509 import Data.X509.CertificateStore +import System.X509.Common (maybeSSLCertEnvOr) rootCAKeyChain :: FilePath rootCAKeyChain = "/System/Library/Keychains/SystemRootCertificates.keychain" @@ -19,11 +20,20 @@ listInKeyChains :: [FilePath] -> IO [SignedCertificate] listInKeyChains keyChains = do - (_, Just hout, _, ph) <- createProcess (proc "security" ("find-certificate" : "-pa" : keyChains)) { std_out = CreatePipe } + (_, Just hout, _, ph) <- + createProcess + (proc "security" ("find-certificate" : "-pa" : keyChains)) + { std_out = CreatePipe + } pems <- either error id . pemParseLBS <$> LBS.hGetContents hout - let targets = rights $ map (decodeSignedCertificate . pemContent) $ filter ((=="CERTIFICATE") . pemName) pems + let targets = + rights $ + map (decodeSignedCertificate . pemContent) $ + filter ((== "CERTIFICATE") . pemName) pems _ <- targets `seq` waitForProcess ph return targets getSystemCertificateStore :: IO CertificateStore -getSystemCertificateStore = makeCertificateStore <$> listInKeyChains [rootCAKeyChain, systemKeyChain] +getSystemCertificateStore = + maybeSSLCertEnvOr + (makeCertificateStore <$> listInKeyChains [rootCAKeyChain, systemKeyChain]) diff --git a/System/X509/Unix.hs b/System/X509/Unix.hs --- a/System/X509/Unix.hs +++ b/System/X509/Unix.hs @@ -11,13 +11,13 @@ -- the path can be dynamically override using the environment variable -- defined by envPathOverride in the module, which by -- default is SYSTEM_CERTIFICATE_PATH --- -module System.X509.Unix - ( getSystemCertificateStore - ) where +module System.X509.Unix ( + getSystemCertificateStore, +) where -import System.Environment (getEnv) import Data.X509.CertificateStore +import System.Environment (getEnv) +import System.X509.Common (maybeSSLCertEnvOr) import Control.Applicative ((<$>)) import qualified Control.Exception as E @@ -27,20 +27,23 @@ defaultSystemPaths :: [FilePath] defaultSystemPaths = - [ "/etc/ssl/certs/" -- linux - , "/system/etc/security/cacerts/" -- android - , "/usr/local/share/certs/" -- freebsd - , "/etc/ssl/cert.pem" -- openbsd + [ "/etc/pki/ca-trust/extracted/pem/tls-ca-bundle.pem" -- fedora + , "/etc/ssl/certs/" -- linux + , "/system/etc/security/cacerts/" -- android + , "/usr/local/share/certs/" -- freebsd + , "/etc/ssl/cert.pem" -- openbsd ] envPathOverride :: String envPathOverride = "SYSTEM_CERTIFICATE_PATH" getSystemCertificateStore :: IO CertificateStore -getSystemCertificateStore = mconcat . catMaybes <$> (getSystemPaths >>= mapM readCertificateStore) +getSystemCertificateStore = + maybeSSLCertEnvOr + (mconcat . catMaybes <$> (getSystemPaths >>= mapM readCertificateStore)) getSystemPaths :: IO [FilePath] -getSystemPaths = E.catch ((:[]) <$> getEnv envPathOverride) inDefault - where - inDefault :: E.IOException -> IO [FilePath] - inDefault _ = return defaultSystemPaths +getSystemPaths = E.catch ((: []) <$> getEnv envPathOverride) inDefault + where + inDefault :: E.IOException -> IO [FilePath] + inDefault _ = return defaultSystemPaths diff --git a/System/X509/Win32.hs b/System/X509/Win32.hs --- a/System/X509/Win32.hs +++ b/System/X509/Win32.hs @@ -1,25 +1,27 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} -module System.X509.Win32 - ( getSystemCertificateStore - ) where +module System.X509.Win32 ( + getSystemCertificateStore, +) where + +import Data.Word import Foreign.Ptr import Foreign.Storable -import Data.Word -import Control.Monad (when) import Control.Applicative import Control.Exception (catch) +import Control.Monad (when) import qualified Data.ByteString.Internal as B +import Data.ASN1.Error import Data.X509 import Data.X509.CertificateStore -import Data.ASN1.Error import System.Win32.Types +import System.X509.Common (maybeSSLCertEnvOr) type HCertStore = Ptr Word8 type PCCERT_Context = Ptr Word8 @@ -30,7 +32,8 @@ c_CertCloseStore :: HCertStore -> DWORD -> IO () foreign import stdcall unsafe "CertEnumCertificatesInStore" - c_CertEnumCertificatesInStore :: HCertStore -> PCCERT_Context -> IO PCCERT_Context + c_CertEnumCertificatesInStore + :: HCertStore -> PCCERT_Context -> IO PCCERT_Context certOpenSystemStore :: IO HCertStore certOpenSystemStore = withTString "ROOT" $ \cstr -> @@ -38,32 +41,35 @@ certFromContext :: PCCERT_Context -> IO (Either String SignedCertificate) certFromContext cctx = do - ty <- peek (castPtr cctx :: Ptr DWORD) - p <- peek (castPtr (cctx `plusPtr` pbCertEncodedPos) :: Ptr (Ptr BYTE)) + ty <- peek (castPtr cctx :: Ptr DWORD) + p <- peek (castPtr (cctx `plusPtr` pbCertEncodedPos) :: Ptr (Ptr BYTE)) len <- peek (castPtr (cctx `plusPtr` cbCertEncodedPos) :: Ptr DWORD) process ty p len - where process 1 p len = do - b <- B.create (fromIntegral len) $ \dst -> B.memcpy dst p (fromIntegral len) - return $ decodeSignedObject b - process ty _ _ = - return $ Left ("windows certificate store: not supported type: " ++ show ty) - pbCertEncodedPos = alignment (undefined :: Ptr (Ptr BYTE)) - cbCertEncodedPos = pbCertEncodedPos + sizeOf (undefined :: Ptr (Ptr BYTE)) + where + process 1 p len = do + b <- B.create (fromIntegral len) $ \dst -> B.memcpy dst p (fromIntegral len) + return $ decodeSignedObject b + process ty _ _ = + return $ Left ("windows certificate store: not supported type: " ++ show ty) + pbCertEncodedPos = alignment (undefined :: Ptr (Ptr BYTE)) + cbCertEncodedPos = pbCertEncodedPos + sizeOf (undefined :: Ptr (Ptr BYTE)) getSystemCertificateStore :: IO CertificateStore -getSystemCertificateStore = do +getSystemCertificateStore = maybeSSLCertEnvOr $ do store <- certOpenSystemStore when (store == nullPtr) $ error "no store" certs <- loop store nullPtr c_CertCloseStore store 0 return (makeCertificateStore certs) - where loop st ptr = do - r <- c_CertEnumCertificatesInStore st ptr - if r == nullPtr - then return [] - else do + where + loop st ptr = do + r <- c_CertEnumCertificatesInStore st ptr + if r == nullPtr + then return [] + else + do ecert <- certFromContext r case ecert of - Left _ -> loop st r + Left _ -> loop st r Right cert -> (cert :) <$> (loop st r) `catch` \(_ :: ASN1Error) -> loop st r diff --git a/crypton-x509-system.cabal b/crypton-x509-system.cabal --- a/crypton-x509-system.cabal +++ b/crypton-x509-system.cabal @@ -1,43 +1,54 @@ -Name: crypton-x509-system -version: 1.6.7 -Synopsis: Handle per-operating-system X.509 accessors and storage -Description: System X.509 handling for accessing operating system dependents store and other storage methods -License: BSD3 -License-file: LICENSE -Copyright: Vincent Hanquez -Author: Vincent Hanquez -Maintainer: Kazu Yamamoto -Build-Type: Simple -Category: Data -stability: experimental -Homepage: https://github.com/kazu-yamamoto/crypton-certificate -Cabal-Version: >= 1.10 +cabal-version: >=1.10 +name: crypton-x509-system +version: 1.6.8 +license: BSD3 +license-file: LICENSE +copyright: Vincent Hanquez +maintainer: Kazu Yamamoto +author: Vincent Hanquez +stability: experimental +homepage: https://github.com/kazu-yamamoto/crypton-certificate +synopsis: Handle per-operating-system X.509 accessors and storage +description: + System X.509 handling for accessing operating system dependents store and other storage methods -Library - Default-Language: Haskell2010 - Build-Depends: base >= 3 && < 5 - , bytestring - , mtl - , containers - , directory - , filepath - , process - , pem >= 0.1 && < 0.3 - , crypton-x509 >= 1.6 - , crypton-x509-store >= 1.6.2 - Exposed-modules: System.X509 - System.X509.Unix - System.X509.MacOS - ghc-options: -Wall - if os(windows) - cpp-options: -DWINDOWS - Build-Depends: Win32, asn1-encoding - extra-libraries: Crypt32 - Exposed-modules: System.X509.Win32 - if os(OSX) - cpp-options: -DMACOSX +category: Data +build-type: Simple +extra-source-files: ChangeLog.md source-repository head - type: git - location: https://github.com/kazu-yamamoto/crypton-certificate - subdir: x509-system + type: git + location: https://github.com/kazu-yamamoto/crypton-certificate + subdir: x509-system + +library + exposed-modules: + System.X509 + System.X509.Common + System.X509.Unix + System.X509.MacOS + + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >=3 && <5, + bytestring, + mtl, + containers, + directory, + filepath, + process, + pem >=0.1 && <0.3, + crypton-x509 >=1.6, + crypton-x509-store >=1.6.2 + + if os(windows) + exposed-modules: System.X509.Win32 + cpp-options: -DWINDOWS + extra-libraries: Crypt32 + build-depends: + Win32, + asn1-encoding + + if os(osx) + cpp-options: -DMACOSX