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,26 @@ +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 :: String +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 } + 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 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,65 @@ +-- | +-- 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) +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 + +defaultSystemPath :: FilePath +defaultSystemPath = "/etc/ssl/certs/" + +envPathOverride :: String +envPathOverride = "SYSTEM_CERTIFICATE_PATH" + +listDirectoryCerts :: FilePath -> IO [FilePath] +listDirectoryCerts path = (map (path ) . filter isCert <$> getDirectoryContents path) + >>= 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) + +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 + +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 [] 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,58 @@ +module System.X509.Win32 + ( getSystemCertificateStore + ) where + +{- +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr (castPtr) + +import Control.Exception (bracket, IOException) +import Control.Applicative ((<$>)) + +import System.Win32.Registry + +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString.Lazy as L + +import Data.X509 +import Data.X509.Cert + +import Data.Bits +import Data.CertificateStore + +defaultSystemPath :: FilePath +defaultSystemPath = "SOFTWARE\\Microsoft\\SystemCertificates\\CA\\Certificates" + +listSubDirectories path = bracket openKey regCloseKey regEnumKeys + where openKey = regOpenKeyEx hKEY_LOCAL_MACHINE path (kEY_ENUMERATE_SUB_KEYS .|. kEY_READ) + +openValue path key toByteS = bracket openKey regCloseKey $ \hkey -> allocaBytes 4096 $ \mem -> do + regQueryValueEx hkey key mem 4096 >>= toByteS mem + where openKey = regOpenKeyEx hKEY_LOCAL_MACHINE path kEY_QUERY_VALUE + +fromBlob mem ty + | ty == rEG_BINARY = do + len <- B.c_strlen (castPtr mem) + B.create (fromIntegral len) (\bptr -> B.memcpy bptr mem len) + | otherwise = error "certificate blob have unexpected type" + +data ReadErr = + Exception IOException + | CertError String + deriving (Show,Eq) + +readCertificate dir hash = do + b <- openValue path "Blob" fromBlob + return $ decodeCertificate $ L.fromChunks [b] + where path = dir ++ "\\" ++ hash + +listIn dir = listSubDirectories dir >>= \hs -> (rights <$> mapM (readCertificate dir) hs) + +getSystemCertificateStore :: IO CertificateStore +getSystemCertificateStore = makeCertificateStore <$> listIn defaultSystemPath +-} +import Data.X509.CertificateStore + +getSystemCertificateStore :: IO CertificateStore +getSystemCertificateStore = return (makeCertificateStore []) diff --git a/x509-system.cabal b/x509-system.cabal new file mode 100644 --- /dev/null +++ b/x509-system.cabal @@ -0,0 +1,41 @@ +Name: x509-system +Version: 1.4.0 +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 + , pem >= 0.1 && < 0.2 + , containers + , directory + , filepath + , process + , time + , x509 + , x509-store + Exposed-modules: System.X509 + System.X509.Unix + System.X509.MacOS + ghc-options: -Wall + if os(windows) + cpp-options: -DWINDOWS + Build-Depends: Win32 + Exposed-modules: System.X509.Win32 + if os(OSX) + cpp-options: -DMACOSX + +source-repository head + type: git + location: git://github.com/vincenthz/hs-certificate