diff --git a/System/X509.hs b/System/X509.hs --- a/System/X509.hs +++ b/System/X509.hs @@ -7,8 +7,8 @@ -- Portability : good -- module System.X509 - ( getSystemCertificateStore - ) where + ( getSystemCertificateStore + ) where #if defined(WINDOWS) import System.X509.Win32 diff --git a/System/X509/MacOS.hs b/System/X509/MacOS.hs --- a/System/X509/MacOS.hs +++ b/System/X509/MacOS.hs @@ -1,6 +1,6 @@ module System.X509.MacOS - ( getSystemCertificateStore - ) where + ( getSystemCertificateStore + ) where import Data.PEM (pemParseLBS, PEM(..)) import System.Process @@ -11,16 +11,19 @@ import Data.X509 import Data.X509.CertificateStore -rootCAKeyChain :: String +rootCAKeyChain :: FilePath rootCAKeyChain = "/System/Library/Keychains/SystemRootCertificates.keychain" -listInKeyChain :: String -> IO [SignedCertificate] -listInKeyChain keyChain = do - (_, Just hout, _, ph) <- createProcess (proc "security" ["find-certificate", "-pa", keyChain]) { std_out = CreatePipe } +systemKeyChain :: FilePath +systemKeyChain = "/Library/Keychains/System.keychain" + +listInKeyChains :: [FilePath] -> IO [SignedCertificate] +listInKeyChains keyChains = do + (_, 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 _ <- targets `seq` waitForProcess ph return targets getSystemCertificateStore :: IO CertificateStore -getSystemCertificateStore = makeCertificateStore <$> listInKeyChain rootCAKeyChain +getSystemCertificateStore = 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 @@ -16,54 +16,31 @@ ( getSystemCertificateStore ) where -import System.Directory (getDirectoryContents, doesFileExist) import System.Environment (getEnv) -import System.FilePath (()) - -import Data.List (isPrefixOf) -import Data.PEM (PEM(..), pemParseBS) -import Data.Either -import qualified Data.ByteString as B -import Data.X509 import Data.X509.CertificateStore import Control.Applicative ((<$>)) -import Control.Monad (filterM) import qualified Control.Exception as E -import Data.Char +import Data.Maybe (catMaybes) +import Data.Monoid (mconcat) -defaultSystemPath :: FilePath -defaultSystemPath = "/etc/ssl/certs/" +defaultSystemPaths :: [FilePath] +defaultSystemPaths = + [ "/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" -listDirectoryCerts :: FilePath -> IO [FilePath] -listDirectoryCerts path = (map (path ) . filter isCert <$> getDirContents) - >>= filterM doesFileExist - where isHashedFile s = length s == 10 - && isDigit (s !! 9) - && (s !! 8) == '.' - && all isHexDigit (take 8 s) - isCert x = (not $ isPrefixOf "." x) && (not $ isHashedFile x) - - getDirContents = E.catch (getDirectoryContents path) emptyPaths - where emptyPaths :: E.IOException -> IO [FilePath] - emptyPaths _ = return [] - getSystemCertificateStore :: IO CertificateStore -getSystemCertificateStore = makeCertificateStore . concat <$> (getSystemPath >>= listDirectoryCerts >>= mapM readCertificates) - -getSystemPath :: IO FilePath -getSystemPath = E.catch (getEnv envPathOverride) inDefault - where - inDefault :: E.IOException -> IO FilePath - inDefault _ = return defaultSystemPath +getSystemCertificateStore = mconcat . catMaybes <$> (getSystemPaths >>= mapM readCertificateStore) -readCertificates :: FilePath -> IO [SignedCertificate] -readCertificates file = E.catch (either (const []) (rights . map getCert) . pemParseBS <$> B.readFile file) skipIOError +getSystemPaths :: IO [FilePath] +getSystemPaths = E.catch ((:[]) <$> getEnv envPathOverride) inDefault where - getCert = decodeSignedCertificate . pemContent - skipIOError :: E.IOException -> IO [SignedCertificate] - skipIOError _ = return [] + 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 @@ -11,11 +11,13 @@ import Control.Monad (when) import Control.Applicative +import Control.Exception (catch) import qualified Data.ByteString.Internal as B import Data.X509 import Data.X509.CertificateStore +import Data.ASN1.Error import System.Win32.Types @@ -64,4 +66,4 @@ case ecert of Left _ -> loop st r Right cert -> (cert :) <$> (loop st r) - + `catch` \(_ :: ASN1Error) -> loop st r diff --git a/x509-system.cabal b/x509-system.cabal --- a/x509-system.cabal +++ b/x509-system.cabal @@ -1,19 +1,20 @@ Name: x509-system -Version: 1.4.5 -Description: System X.509 handling +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: Vincent Hanquez -Synopsis: Handle per-operating-system X.509 accessors and storage Build-Type: Simple Category: Data stability: experimental Homepage: http://github.com/vincenthz/hs-certificate -Cabal-Version: >=1.8 +Cabal-Version: >= 1.10 Library + Default-Language: Haskell2010 Build-Depends: base >= 3 && < 5 , bytestring , mtl @@ -21,17 +22,16 @@ , directory , filepath , process - , time , pem >= 0.1 && < 0.3 - , x509 >= 1.4 && < 1.5 - , x509-store >= 1.4 && < 1.5 + , x509 >= 1.6 + , 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 + Build-Depends: Win32, asn1-encoding extra-libraries: Crypt32 Exposed-modules: System.X509.Win32 if os(OSX)