diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/X509.hs b/System/X509.hs new file mode 100644 --- /dev/null +++ b/System/X509.hs @@ -0,0 +1,19 @@ +{-# 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 diff --git a/System/X509/MacOS.hs b/System/X509/MacOS.hs new file mode 100644 --- /dev/null +++ b/System/X509/MacOS.hs @@ -0,0 +1,29 @@ +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 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] diff --git a/System/X509/Unix.hs b/System/X509/Unix.hs new file mode 100644 --- /dev/null +++ b/System/X509/Unix.hs @@ -0,0 +1,46 @@ +-- | +-- 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.Environment (getEnv) +import Data.X509.CertificateStore + +import Control.Applicative ((<$>)) +import qualified Control.Exception as E + +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" + +getSystemCertificateStore :: IO CertificateStore +getSystemCertificateStore = mconcat . catMaybes <$> (getSystemPaths >>= mapM readCertificateStore) + +getSystemPaths :: IO [FilePath] +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 new file mode 100644 --- /dev/null +++ b/System/X509/Win32.hs @@ -0,0 +1,69 @@ +{-# 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 diff --git a/crypton-x509-system.cabal b/crypton-x509-system.cabal new file mode 100644 --- /dev/null +++ b/crypton-x509-system.cabal @@ -0,0 +1,43 @@ +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 + +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 + +source-repository head + type: git + location: https://github.com/kazu-yamamoto/crypton-certificate + subdir: x509-system