x509-system 1.4.0 → 1.4.1

raw patch · 2 files changed

+55/−46 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• System/X509/Win32.hs +49/−42
• x509-system.cabal +6/−4

@@ -1,58 +1,65 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} module System.X509.Win32-	( getSystemCertificateStore-	) where--{--import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.Ptr (castPtr)+    ( getSystemCertificateStore+    ) where -import Control.Exception (bracket, IOException)-import Control.Applicative ((<$>))+import Foreign.Ptr+import Foreign.Storable+import Data.Word -import System.Win32.Registry+import Control.Monad (when)+import Control.Applicative -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"+import Data.X509.CertificateStore -listSubDirectories path = bracket openKey regCloseKey regEnumKeys-	where openKey = regOpenKeyEx hKEY_LOCAL_MACHINE path (kEY_ENUMERATE_SUB_KEYS .|. kEY_READ)+import System.Win32.Types -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+type HCertStore = Ptr Word8+type PCCERT_Context = Ptr Word8 -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"+foreign import stdcall unsafe "CertOpenSystemStoreW"+    c_CertOpenSystemStore :: Ptr Word8 -> LPCTSTR -> IO HCertStore+foreign import stdcall unsafe "CertCloseStore"+    c_CertCloseStore :: HCertStore -> DWORD -> IO () -data ReadErr =-	  Exception IOException-	| CertError String-	deriving (Show,Eq)+foreign import stdcall unsafe "CertEnumCertificatesInStore"+    c_CertEnumCertificatesInStore :: HCertStore -> PCCERT_Context -> IO PCCERT_Context -readCertificate dir hash = do-    b <- openValue path "Blob" fromBlob-    return $ decodeCertificate $ L.fromChunks [b]-    where path = dir ++ "\\" ++ hash+certOpenSystemStore :: IO HCertStore+certOpenSystemStore = withTString "ROOT" $ \cstr ->+    c_CertOpenSystemStore nullPtr cstr -listIn dir = listSubDirectories dir >>= \hs -> (rights <$> mapM (readCertificate dir) hs)+certFromContext :: PCCERT_Context -> IO (Either String SignedCertificate)+certFromContext cctx = do+    ty <- peek (castPtr cctx :: Ptr DWORD)+    p  <- peek (castPtr (cctx `plusPtr` 4) :: Ptr (Ptr BYTE))+    len <- peek (castPtr (cctx `plusPtr` 8) :: 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)  getSystemCertificateStore :: IO CertificateStore-getSystemCertificateStore = makeCertificateStore <$> listIn defaultSystemPath--}-import Data.X509.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) -getSystemCertificateStore :: IO CertificateStore-getSystemCertificateStore = return (makeCertificateStore [])

@@ -1,5 +1,5 @@ Name:                x509-system-Version:             1.4.0+Version:             1.4.1 Description:         System X.509 handling License:             BSD3 License-file:        LICENSE@@ -30,12 +30,14 @@                      System.X509.MacOS   ghc-options:       -Wall   if os(windows)-     cpp-options: -DWINDOWS-     Build-Depends:  Win32-     Exposed-modules:  System.X509.Win32+     cpp-options:     -DWINDOWS+     Build-Depends:   Win32+     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