packages feed

HsOpenSSL-x509-system (empty) → 0.1.0.0

raw patch · 8 files changed

+282/−0 lines, 8 filesdep +HsOpenSSLdep +Win32dep +basesetup-changed

Dependencies added: HsOpenSSL, Win32, base, bytestring, process, unix

Files

+ ChangeLog view
+ HsOpenSSL-x509-system.cabal view
@@ -0,0 +1,48 @@+name:                HsOpenSSL-x509-system+version:             0.1.0.0+synopsis:            Use the system's native CA certificate store with HsOpenSSL+description:+  A cross-platform library that tries to find a (reasonable) CA certificate+  bundle that can be used with @HsOpenSSL@ to verify the certificates of+  remote peers.+  .+  This package is for @HsOpenSSL@ what @x509-system@ is for the @tls@ package.+  Additionally, it borrows some ideas from @x509-system@.+homepage:            https://github.com/redneb/HsOpenSSL-x509-system+bug-reports:         https://github.com/redneb/HsOpenSSL-x509-system/issues+license:             BSD3+license-file:        LICENSE+author:              Marios Titas <rednebΑΤgmxDΟΤcom>+maintainer:          Marios Titas <rednebΑΤgmxDΟΤcom>+category:            System, Filesystem+build-type:          Simple+cabal-version:       >=1.10++extra-source-files:+  ChangeLog++source-repository head+  type: git+  location: https://github.com/redneb/HsOpenSSL-x509-system.git++library+  exposed-modules:     OpenSSL.X509.SystemStore+  build-depends:       base >=4.6 && <5,+                       HsOpenSSL ==0.11.*,+                       bytestring >=0.9 && <1+  if os(windows)+    other-modules:       OpenSSL.X509.SystemStore.Win32+    build-depends:       Win32 >=2.2 && <3+    extra-libraries:     Crypt32+    cpp-options:         -DCABAL_OS_WINDOWS+    build-tools:         hsc2hs+  else+    if os(OSX)+      other-modules:       OpenSSL.X509.SystemStore.MacOSX+      build-depends:       process >=1 && <2+      cpp-options:         -DCABAL_OS_MACOSX+    else+      other-modules:       OpenSSL.X509.SystemStore.Unix+      build-depends:       unix >=2.6 && <3+  default-language:    Haskell2010+  ghc-options:         -Wall
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Marios Titas++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Marios Titas nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.
+ OpenSSL/X509/SystemStore.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++module OpenSSL.X509.SystemStore+    ( contextLoadSystemCerts+    ) where++import OpenSSL.Session (SSLContext)+#ifdef CABAL_OS_WINDOWS+import qualified OpenSSL.X509.SystemStore.Win32 as S+#elif defined(CABAL_OS_MACOSX)+import qualified OpenSSL.X509.SystemStore.MacOSX as S+#else+import qualified OpenSSL.X509.SystemStore.Unix as S+#endif++-- | Add the certificates from the system-wide certificate store to the+-- given @openssl@ context. Note that this does not automatically enable+-- peer certificate verification. You need to also call+-- 'OpenSSL.Session.contextSetVerificationMode' for that.+contextLoadSystemCerts :: SSLContext -> IO () +contextLoadSystemCerts = S.contextLoadSystemCerts+{-# INLINE contextLoadSystemCerts #-}
+ OpenSSL/X509/SystemStore/MacOSX.hs view
@@ -0,0 +1,48 @@+module OpenSSL.X509.SystemStore.MacOSX+    ( contextLoadSystemCerts+    ) where++import System.Process (createProcess, waitForProcess, proc,+                       CreateProcess(std_out), StdStream(CreatePipe))+import System.IO (hGetLine, hIsEOF)+import Control.Monad ((>=>))+import Control.Exception (throwIO, ErrorCall(ErrorCall))+import OpenSSL.Session (SSLContext, contextGetCAStore)+import OpenSSL.X509 (X509)+import OpenSSL.X509.Store (addCertToStore)+import OpenSSL.PEM (readX509)++contextLoadSystemCerts :: SSLContext -> IO () +contextLoadSystemCerts ctx = do+    st <- contextGetCAStore ctx+    iterSystemCertsX509 (addCertToStore st)++iterSystemCertsX509 :: (X509 -> IO ()) -> IO ()+iterSystemCertsX509 action =+    iterSystemCertsPEM (readX509 >=> action)++iterSystemCertsPEM :: (String -> IO ()) -> IO ()+iterSystemCertsPEM action = do+    (_, Just hdl, _, ph) <- createProcess cmd {std_out = CreatePipe}+    loop [] hdl+    _ <- waitForProcess ph+    return ()+  where+    loop ls hdl = do+        eof <- hIsEOF hdl+        if not eof then do+            s <- hGetLine hdl+            let ls' = s : ls+            if s == endCert then do+                action (unlines $ reverse ls')+                loop [] hdl+            else+                loop ls' hdl+        else if null ls then+            return ()+        else+            throwIO $ ErrorCall "Incomplete certificate"+    endCert = "-----END CERTIFICATE-----"+    cmd = proc "security"+        ["export", "-t", "certs", "-f", "pemseq", "-k", rootCAKeyChain]+    rootCAKeyChain = "/System/Library/Keychains/SystemRootCertificates.keychain"
+ OpenSSL/X509/SystemStore/Unix.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables #-}++module OpenSSL.X509.SystemStore.Unix+    ( contextLoadSystemCerts+    ) where++import OpenSSL.Session (SSLContext, contextSetCADirectory, contextSetCAFile)+import qualified System.Posix.Files as U+import Control.Exception (try, IOException)+import System.IO.Unsafe (unsafePerformIO)++contextLoadSystemCerts :: SSLContext -> IO ()+contextLoadSystemCerts =+    unsafePerformIO $ loop defaultSystemPaths+  where+    loop ((isDir, path) : rest) = do+        mst <- try $ U.getFileStatus path+            :: IO (Either IOException U.FileStatus)+        case mst of+            Right st | isDir, U.isDirectory st ->+                return (flip contextSetCADirectory path)+            Right st | not isDir, U.isRegularFile st ->+                return (flip contextSetCAFile path)+            _ -> loop rest+    loop [] = return (const $ return ()) -- throw an exception instead?+{-# NOINLINE contextLoadSystemCerts #-}++-- A True value indicates that the path must be a directory.+-- According to [1], the fedora path should be tried before /etc/ssl/certs+-- because of [2].+--+-- [1] https://www.happyassassin.net/2015/01/12/a-note-about-ssltls-trusted-certificate-stores-and-platforms/+-- [2] https://bugzilla.redhat.com/show_bug.cgi?id=1053882+defaultSystemPaths :: [(Bool, FilePath)]+defaultSystemPaths =+    [ (False, "/etc/pki/tls/certs/ca-bundle.crt"      ) -- red hat, fedora. centos+    , (True , "/etc/ssl/certs"                        ) -- other linux, netbsd+    , (True , "/system/etc/security/cacerts"          ) -- android+    , (True , "/usr/local/share/certs"                ) -- freebsd+    , (False, "/etc/ssl/cert.pem"                     ) -- openbsd+    , (False, "/usr/share/ssl/certs/ca-bundle.crt"    ) -- older red hat+    , (False, "/usr/local/share/certs/ca-root-nss.crt") -- freebsd (security/ca-root-nss)+    ]
+ OpenSSL/X509/SystemStore/Win32.hsc view
@@ -0,0 +1,89 @@+module OpenSSL.X509.SystemStore.Win32+    ( contextLoadSystemCerts+    ) where++import Control.Exception (bracket)+import Control.Monad (when, (>=>))+import OpenSSL.X509 (X509)+import qualified OpenSSL.Session as SSL+import qualified OpenSSL.PEM as SSL+import qualified OpenSSL.X509.Store as SSL+import qualified OpenSSL.EVP.Base64 as SSL+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as C8++import Foreign (Ptr, nullPtr, peekByteOff)+import System.Win32.Types (DWORD, BOOL, LPCTSTR, withTString)++contextLoadSystemCerts :: SSL.SSLContext -> IO () +contextLoadSystemCerts ctx = do+    st <- SSL.contextGetCAStore ctx+    iterCertStoreX509 "ROOT" (SSL.addCertToStore st)++iterCertStoreX509 :: String -> (X509 -> IO ()) -> IO ()+iterCertStoreX509 subsystemProtocol action =+    iterCertStorePEM subsystemProtocol (SSL.readX509 >=> action)++iterCertStorePEM :: String -> (String -> IO ()) -> IO ()+iterCertStorePEM subsystemProtocol action =+    iterCertStoreDER subsystemProtocol (action . derToPem)++iterCertStoreDER :: String -> (B.ByteString -> IO ()) -> IO ()+iterCertStoreDER subsystemProtocol action =+    withTString subsystemProtocol $ \ssProtPtr ->+        bracket+            (certOpenSystemStore nullPtr ssProtPtr)+            (flip certCloseStore 0)+            (loop nullPtr)+  where+    loop prevCertCtx certStore = do+        certCtx <- certEnumCertificatesInStore certStore prevCertCtx+        when (certCtx /= nullPtr) $ do+            certEncType <- (#peek struct _CERT_CONTEXT, dwCertEncodingType) certCtx+            when (certEncType == x509EncType) $ do+                len <- (#peek struct _CERT_CONTEXT, cbCertEncoded) certCtx :: IO DWORD+                certBuf <- (#peek struct _CERT_CONTEXT, pbCertEncoded) certCtx+                cert <- B.packCStringLen (certBuf, fromIntegral len)+                action cert+                loop certCtx certStore++derToPem :: B.ByteString -> String+derToPem der = unlines ([beginCert] ++ ls ++ [endCert])+  where+    ls = map C8.unpack $ splitChunks $ SSL.encodeBase64BS der+    splitChunks s+        | B.null s = []+        | otherwise = chunk : splitChunks rest+          where+            (chunk, rest) = B.splitAt 64 s+    beginCert = "-----BEGIN CERTIFICATE-----"+    endCert = "-----END CERTIFICATE-----"++--------------------------------------------------------------------------------++#include <windows.h>+#include <Wincrypt.h>++data HCERTSTORE++data PCCERT_CONTEXT++data HCRYPTPROV_LEGACY++foreign import stdcall unsafe "CertOpenSystemStoreW"+    certOpenSystemStore+        :: Ptr HCRYPTPROV_LEGACY+        -> LPCTSTR+        -> IO (Ptr HCERTSTORE)++foreign import stdcall unsafe "CertCloseStore"+    certCloseStore :: Ptr HCERTSTORE -> DWORD -> IO BOOL++foreign import stdcall unsafe "CertEnumCertificatesInStore"+    certEnumCertificatesInStore+        :: Ptr HCERTSTORE+        -> Ptr PCCERT_CONTEXT+        -> IO (Ptr PCCERT_CONTEXT)++x509EncType :: DWORD+x509EncType = (#const X509_ASN_ENCODING)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain