Import haskell-hsopenssl-x509-system_0.1.0.4.orig.tar.gz
authorClint Adams <clint@debian.org>
Sun, 3 Jul 2022 18:19:31 +0000 (19:19 +0100)
committerClint Adams <clint@debian.org>
Sun, 3 Jul 2022 18:19:31 +0000 (19:19 +0100)
[dgit import orig haskell-hsopenssl-x509-system_0.1.0.4.orig.tar.gz]

ChangeLog.md [new file with mode: 0755]
HsOpenSSL-x509-system.cabal [new file with mode: 0644]
LICENSE [new file with mode: 0644]
OpenSSL/X509/SystemStore.hs [new file with mode: 0644]
OpenSSL/X509/SystemStore/MacOSX.hs [new file with mode: 0644]
OpenSSL/X509/SystemStore/Unix.hs [new file with mode: 0644]
OpenSSL/X509/SystemStore/Win32.hsc [new file with mode: 0644]
Setup.hs [new file with mode: 0644]

diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100755 (executable)
index 0000000..1bcb84c
--- /dev/null
@@ -0,0 +1,19 @@
+#### 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.
diff --git a/HsOpenSSL-x509-system.cabal b/HsOpenSSL-x509-system.cabal
new file mode 100644 (file)
index 0000000..ca098aa
--- /dev/null
@@ -0,0 +1,48 @@
+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
diff --git a/LICENSE b/LICENSE
new file mode 100644 (file)
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 (file)
index 0000000..ecb6515
--- /dev/null
@@ -0,0 +1,26 @@
+{-# 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 #-}
diff --git a/OpenSSL/X509/SystemStore/MacOSX.hs b/OpenSSL/X509/SystemStore/MacOSX.hs
new file mode 100644 (file)
index 0000000..4370bd3
--- /dev/null
@@ -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 (file)
index 0000000..59405d9
--- /dev/null
@@ -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
+    , (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
+    ]
diff --git a/OpenSSL/X509/SystemStore/Win32.hsc b/OpenSSL/X509/SystemStore/Win32.hsc
new file mode 100644 (file)
index 0000000..abf3921
--- /dev/null
@@ -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)
diff --git a/Setup.hs b/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain