From bd75bade226efefe93cd32bf3f01c00a97e7613a Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Thu, 13 Oct 2016 19:55:26 +0100 Subject: [PATCH] Import haskell-hsopenssl-x509-system_0.1.0.3.orig.tar.gz [dgit import orig haskell-hsopenssl-x509-system_0.1.0.3.orig.tar.gz] --- ChangeLog | 3 + HsOpenSSL-x509-system.cabal | 48 ++++++++++++++++ LICENSE | 30 ++++++++++ OpenSSL/X509/SystemStore.hs | 25 +++++++++ OpenSSL/X509/SystemStore/MacOSX.hs | 48 ++++++++++++++++ OpenSSL/X509/SystemStore/Unix.hs | 43 +++++++++++++++ OpenSSL/X509/SystemStore/Win32.hsc | 89 ++++++++++++++++++++++++++++++ Setup.hs | 2 + 8 files changed, 288 insertions(+) create mode 100644 ChangeLog create mode 100644 HsOpenSSL-x509-system.cabal create mode 100644 LICENSE create mode 100644 OpenSSL/X509/SystemStore.hs create mode 100644 OpenSSL/X509/SystemStore/MacOSX.hs create mode 100644 OpenSSL/X509/SystemStore/Unix.hs create mode 100644 OpenSSL/X509/SystemStore/Win32.hsc create mode 100644 Setup.hs diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..30fefa8 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,3 @@ +v0.1.0.1 + + * Documentation updates. diff --git a/HsOpenSSL-x509-system.cabal b/HsOpenSSL-x509-system.cabal new file mode 100644 index 0000000..239e7ed --- /dev/null +++ b/HsOpenSSL-x509-system.cabal @@ -0,0 +1,48 @@ +name: 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 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..6ae6cbc --- /dev/null +++ b/LICENSE @@ -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. diff --git a/OpenSSL/X509/SystemStore.hs b/OpenSSL/X509/SystemStore.hs new file mode 100644 index 0000000..04f5696 --- /dev/null +++ b/OpenSSL/X509/SystemStore.hs @@ -0,0 +1,25 @@ +{-# 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 #-} diff --git a/OpenSSL/X509/SystemStore/MacOSX.hs b/OpenSSL/X509/SystemStore/MacOSX.hs new file mode 100644 index 0000000..4370bd3 --- /dev/null +++ b/OpenSSL/X509/SystemStore/MacOSX.hs @@ -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" diff --git a/OpenSSL/X509/SystemStore/Unix.hs b/OpenSSL/X509/SystemStore/Unix.hs new file mode 100644 index 0000000..fcd8edc --- /dev/null +++ b/OpenSSL/X509/SystemStore/Unix.hs @@ -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) + ] diff --git a/OpenSSL/X509/SystemStore/Win32.hsc b/OpenSSL/X509/SystemStore/Win32.hsc new file mode 100644 index 0000000..abf3921 --- /dev/null +++ b/OpenSSL/X509/SystemStore/Win32.hsc @@ -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 +#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) diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain -- 2.30.2