x509-system-1.6.3/0000755000000000000000000000000012635210221011730 5ustar0000000000000000x509-system-1.6.3/LICENSE0000644000000000000000000000273112635210221012740 0ustar0000000000000000Copyright (c) 2010-2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. x509-system-1.6.3/Setup.hs0000644000000000000000000000005612635210221013365 0ustar0000000000000000import Distribution.Simple main = defaultMain x509-system-1.6.3/x509-system.cabal0000644000000000000000000000256712635210221014755 0ustar0000000000000000Name: x509-system Version: 1.6.3 Description: System X.509 handling 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 Library Build-Depends: base >= 3 && < 5 , bytestring , mtl , containers , directory , filepath , process , pem >= 0.1 && < 0.3 , x509 >= 1.6 && < 1.7 , x509-store >= 1.6 && < 1.7 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 source-repository head type: git location: git://github.com/vincenthz/hs-certificate subdir: x509-system x509-system-1.6.3/System/0000755000000000000000000000000012635210221013214 5ustar0000000000000000x509-system-1.6.3/System/X509.hs0000644000000000000000000000057212635210221014221 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module : System.X509 -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : good -- module System.X509 ( getSystemCertificateStore ) where #if defined(WINDOWS) import System.X509.Win32 #elif defined(MACOSX) import System.X509.MacOS #else import System.X509.Unix #endif x509-system-1.6.3/System/X509/0000755000000000000000000000000012635210221013661 5ustar0000000000000000x509-system-1.6.3/System/X509/MacOS.hs0000644000000000000000000000205012635210221015154 0ustar0000000000000000module System.X509.MacOS ( getSystemCertificateStore ) where import Data.PEM (pemParseLBS, PEM(..)) import System.Process import qualified Data.ByteString.Lazy as LBS import Control.Applicative import Data.Either import Data.X509 import Data.X509.CertificateStore rootCAKeyChain :: FilePath rootCAKeyChain = "/System/Library/Keychains/SystemRootCertificates.keychain" 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 <$> listInKeyChains [rootCAKeyChain, systemKeyChain] x509-system-1.6.3/System/X509/Unix.hs0000644000000000000000000000654112635210221015146 0ustar0000000000000000-- | -- Module : System.X509 -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unix only -- -- this module is portable to unix system where there is usually -- a /etc/ssl/certs with system X509 certificates. -- -- 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 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) import Data.Monoid (mconcat) 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" -- List all the path susceptible to contains a certificate in a directory -- -- if the parameter is not a directory, hilarity follows. 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 -- Try to read certificate from the content of a file. -- -- The file may contains multiple certificates 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 [] x509-system-1.6.3/System/X509/Win32.hs0000644000000000000000000000461412635210221015124 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} module System.X509.Win32 ( getSystemCertificateStore ) where import Foreign.Ptr import Foreign.Storable import Data.Word 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 type HCertStore = Ptr Word8 type PCCERT_Context = Ptr Word8 foreign import stdcall unsafe "CertOpenSystemStoreW" c_CertOpenSystemStore :: Ptr Word8 -> LPCTSTR -> IO HCertStore foreign import stdcall unsafe "CertCloseStore" c_CertCloseStore :: HCertStore -> DWORD -> IO () foreign import stdcall unsafe "CertEnumCertificatesInStore" c_CertEnumCertificatesInStore :: HCertStore -> PCCERT_Context -> IO PCCERT_Context certOpenSystemStore :: IO HCertStore certOpenSystemStore = withTString "ROOT" $ \cstr -> c_CertOpenSystemStore nullPtr cstr 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)) 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)) getSystemCertificateStore :: IO CertificateStore getSystemCertificateStore = 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 ecert <- certFromContext r case ecert of Left _ -> loop st r Right cert -> (cert :) <$> (loop st r) `catch` \(_ :: ASN1Error) -> loop st r