certificate 0.8.0 → 0.8.1

raw patch · 4 files changed

+159/−1 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

• System/Certificate/X509/MacOS.hs +14/−0
• System/Certificate/X509/Unix.hs +81/−0
• System/Certificate/X509/Win32.hs +60/−0
• certificate.cabal +4/−1

@@ -0,0 +1,14 @@+module System.Certificate.X509.MacOS+	( getSystemPath+	, readAll+	, findCertificate+	) where++getSystemPath :: IO FilePath+getSystemPath = undefined++readAll :: IO [Either ReadErr X509]+readAll = undefined++findCertificate :: (X509 -> Bool) -> IO (Maybe X509)+findCertificate f = undefined

@@ -0,0 +1,81 @@+-- |+-- Module      : System.Certificate.X509+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- 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.Certificate.X509.Unix+	( getSystemPath+	, readAll+	, findCertificate+	) where++import System.Directory (getDirectoryContents)+import System.Environment (getEnv)+import Data.List (isPrefixOf)++import Data.Either+import Data.Certificate.X509+import Data.Certificate.PEM+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++import Control.Applicative ((<$>))+import Control.Exception+import Control.Monad++import Prelude hiding (catch)++defaultSystemPath :: FilePath+defaultSystemPath = "/etc/ssl/certs/"++envPathOverride :: String+envPathOverride = "SYSTEM_CERTIFICATE_PATH"++getSystemPath :: IO FilePath+getSystemPath = catch (getEnv envPathOverride) inDefault+	where+		inDefault :: IOException -> IO FilePath+		inDefault _ = return defaultSystemPath++data ReadErr =+	  Exception IOException+	| CertError String+	deriving (Show,Eq)++readCertificate :: FilePath -> IO (Either ReadErr X509)+readCertificate file = do+	rawdata <- try $ B.readFile file :: IO (Either IOException B.ByteString)+	either (return . Left . Exception) parseCert $ rawdata+	where+		parseCert pemdata = case parsePEMCert pemdata of+			Nothing       -> return $ Left $ CertError "certificate not in PEM format"+			Just certdata -> do+				return $ either (Left . CertError) Right $ decodeCertificate $ L.fromChunks [certdata]++readAll :: IO [Either ReadErr X509]+readAll = do+	path      <- getSystemPath+	certfiles <- filter (not . isPrefixOf ".") <$> getDirectoryContents path+	forM certfiles $ \certfile -> readCertificate (path ++ certfile)++findCertificate :: (X509 -> Bool) -> IO (Maybe X509)+findCertificate f = do+	path      <- getSystemPath+	certfiles <- filter (not . isPrefixOf ".") <$> getDirectoryContents path+	loop $ map (path ++) certfiles+	where+		loop []     = return Nothing+		loop (x:xs) = do+			ox509 <- readCertificate x+			case ox509 of+				Left _     -> loop xs+				Right x509 -> if f x509 then return $ Just x509 else loop xs

@@ -0,0 +1,60 @@+module System.Certificate.X509.Win32+	( findCertificate+	) 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.Certificate.X509+import Data.Certificate.X509Cert++import Data.Bits++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"++getSystemPath :: IO FilePath+getSystemPath = undefined++data ReadErr =+	  Exception IOException+	| CertError String+	deriving (Show,Eq)++findCertificate :: (X509 -> Bool) -> IO (Maybe X509)+findCertificate f = do+	hashes <- listSubDirectories defaultSystemPath+	loop hashes+	where+		readCertificate path = do+			b <- openValue path "Blob" fromBlob+			return $ decodeCertificate $ L.fromChunks [b]++		loop []     = return Nothing+		loop (x:xs) = do+			cert <- readCertificate (defaultSystemPath ++ "\\" ++ x)+			case cert of+				Left _ -> loop xs+				Right x509 -> if f x509 then return $ Just x509 else loop xs

@@ -1,5 +1,5 @@ Name:                certificate-Version:             0.8.0+Version:             0.8.1 Description:     Certificates and Key reader/writer     .@@ -39,12 +39,15 @@                      Data.Certificate.KeyRSA                      System.Certificate.X509   Other-modules:     Data.Certificate.X509Internal+                     System.Certificate.X509.Unix   ghc-options:       -Wall   if os(windows)      cpp-options: -DWINDOWS      Build-Depends:  Win32+     Other-modules:  System.Certificate.X509.Win32   if os(OSX)      cpp-options: -DMACOSX+     Other-modules:  System.Certificate.X509.MacOS  Executable           certificate   Main-Is:           Certificate.hs