module System.X509.Unix
( getSystemCertificateStore
) where
import System.Directory (getDirectoryContents, doesFileExist, doesDirectoryExist)
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)
defaultSystemPaths :: [FilePath]
defaultSystemPaths =
[ "/etc/ssl/certs/"
, "/system/etc/security/cacerts/"
, "/usr/local/share/certs/"
, "/etc/ssl/cert.pem"
]
envPathOverride :: String
envPathOverride = "SYSTEM_CERTIFICATE_PATH"
listDirectoryCerts :: FilePath -> IO [FilePath]
listDirectoryCerts path =
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 (map (path </>) . filter isCert <$> getDirectoryContents path) emptyPaths
where emptyPaths :: E.IOException -> IO [FilePath]
emptyPaths _ = return []
makeCertStore :: FilePath -> IO (Maybe CertificateStore)
makeCertStore path = do
isDir <- doesDirectoryExist path
isFile <- doesFileExist path
wrapStore <$> (if isDir then makeDirStore else if isFile then makeFileStore else return [])
where
wrapStore :: [SignedCertificate] -> Maybe CertificateStore
wrapStore [] = Nothing
wrapStore l = Just $ makeCertificateStore l
makeFileStore = readCertificates path
makeDirStore = do
certFiles <- listDirectoryCerts path
concat <$> mapM readCertificates certFiles
getSystemCertificateStore :: IO CertificateStore
getSystemCertificateStore = mconcat . catMaybes <$> (getSystemPaths >>= mapM makeCertStore)
getSystemPaths :: IO [FilePath]
getSystemPaths = E.catch ((:[]) <$> getEnv envPathOverride) inDefault
where
inDefault :: E.IOException -> IO [FilePath]
inDefault _ = return defaultSystemPaths
readCertificates :: FilePath -> IO [SignedCertificate]
readCertificates file = E.catch (either (const []) (rights . map getCert) . pemParseBS <$> B.readFile file) skipIOError
where
getCert = decodeSignedCertificate . pemContent
skipIOError :: E.IOException -> IO [SignedCertificate]
skipIOError _ = return []