HsOpenSSL-x509-system-0.1.0.3/0000755000000000000000000000000012757043533013653 5ustar0000000000000000HsOpenSSL-x509-system-0.1.0.3/LICENSE0000644000000000000000000000276212757043533014667 0ustar0000000000000000Copyright (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. HsOpenSSL-x509-system-0.1.0.3/Setup.hs0000644000000000000000000000005612757043533015310 0ustar0000000000000000import Distribution.Simple main = defaultMain HsOpenSSL-x509-system-0.1.0.3/HsOpenSSL-x509-system.cabal0000644000000000000000000000335612757043533020451 0ustar0000000000000000name: HsOpenSSL-x509-system version: 0.1.0.3 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 maintainer: Marios Titas 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 HsOpenSSL-x509-system-0.1.0.3/ChangeLog0000644000000000000000000000004412757043533015423 0ustar0000000000000000v0.1.0.1 * Documentation updates. HsOpenSSL-x509-system-0.1.0.3/OpenSSL/0000755000000000000000000000000012757043533015136 5ustar0000000000000000HsOpenSSL-x509-system-0.1.0.3/OpenSSL/X509/0000755000000000000000000000000012757043533015603 5ustar0000000000000000HsOpenSSL-x509-system-0.1.0.3/OpenSSL/X509/SystemStore.hs0000644000000000000000000000177312757043533020450 0ustar0000000000000000{-# 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 also need to call 'OpenSSL.Session.contextSetVerificationMode' and -- __check manually if the hostname matches__ the one specified in the -- certificate. You can find information about how to do the latter -- . contextLoadSystemCerts :: SSLContext -> IO () contextLoadSystemCerts = S.contextLoadSystemCerts {-# INLINE contextLoadSystemCerts #-} HsOpenSSL-x509-system-0.1.0.3/OpenSSL/X509/SystemStore/0000755000000000000000000000000012757043533020104 5ustar0000000000000000HsOpenSSL-x509-system-0.1.0.3/OpenSSL/X509/SystemStore/Win32.hsc0000644000000000000000000000567612757043533021523 0ustar0000000000000000module 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 #include 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) HsOpenSSL-x509-system-0.1.0.3/OpenSSL/X509/SystemStore/MacOSX.hs0000644000000000000000000000311612757043533021533 0ustar0000000000000000module 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" HsOpenSSL-x509-system-0.1.0.3/OpenSSL/X509/SystemStore/Unix.hs0000644000000000000000000000352212757043533021365 0ustar0000000000000000{-# 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) ]