--- /dev/null
+#### 0.1.0.4 *2020-08-23*
+
+ * Improve detection of the certificate store location in recent versions of FreeBSD.
+
+#### 0.1.0.3 *2016-08-23*
+
+ * Documentation updates.
+
+#### 0.1.0.2 *2015-04-02*
+
+ * Documentation updates.
+
+#### 0.1.0.1 *2015-02-20*
+
+ * Documentation updates.
+
+#### 0.1.0.0 *2015-02-16*
+
+ * Initial public release.
--- /dev/null
+name: HsOpenSSL-x509-system
+version: 0.1.0.4
+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.md
+
+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
--- /dev/null
+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.
--- /dev/null
+{-# 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 in __older versions of OpenSSL__
+-- (namely <1.1.0), this does not automatically enable peer certificate
+-- verification. In that case,
+-- 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
+-- <https://github.com/iSECPartners/ssl-conservatory/blob/master/openssl/everything-you-wanted-to-know-about-openssl.pdf here>.
+contextLoadSystemCerts :: SSLContext -> IO ()
+contextLoadSystemCerts = S.contextLoadSystemCerts
+{-# INLINE contextLoadSystemCerts #-}
--- /dev/null
+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"
--- /dev/null
+{-# 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
+ , (False, "/etc/ssl/cert.pem" ) -- openbsd/freebsd
+ , (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)
+ , (True , "/usr/local/share/certs" ) -- freebsd
+ ]
--- /dev/null
+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)
--- /dev/null
+import Distribution.Simple
+main = defaultMain