diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,17 @@ +2020-10-08 Vladimir Shabanov + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.20 + + * Hostname validation + by @amesgen (#52) + + * Do not compile OpenSSL modules twice for tests + 2020-09-01 Vladimir Shabanov * HsOpenSSL.cabal (Version): Bump version to 0.11.4.19 - * HsOpenSSL.cabal (Version): Discover OpenSSL via pkg-config + * HsOpenSSL.cabal: Discover OpenSSL via pkg-config by Alexander Biehl @alexbiehl (#51) 2020-03-31 Vladimir Shabanov @@ -21,7 +30,7 @@ 2019-01-21 Vladimir Shabanov - * HsOpenSSL.cabal (Version): + * HsOpenSSL.cabal: Added upper version bounds to all dependencies (#41) 2019-01-21 Vladimir Shabanov @@ -29,7 +38,7 @@ * HsOpenSSL.cabal (Version): Bump version to 0.11.4.16 * Compatibility for network-3.0.0 - by Roman Borschel romanb (#40) + by Roman Borschel @romanb (#40) * .travis.yml: Fixed build. Updated to last 3 GHC versions. diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -10,7 +10,7 @@ systems and stable. You may also be interested in the @tls@ package, , which is a pure Haskell implementation of SSL. -Version: 0.11.4.19 +Version: 0.11.4.20 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen @@ -175,8 +175,9 @@ Test-Suite test-dsa Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/DSA.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: DSA.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, base >= 4.4 && < 5, @@ -188,8 +189,9 @@ Test-Suite test-der Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/DER.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: DER.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, base >= 4.4 && < 5 @@ -200,8 +202,9 @@ Test-Suite test-evp-base64 Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/EVP/Base64.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: EVP/Base64.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, base >= 4.4 && < 5, @@ -213,8 +216,9 @@ Test-Suite test-evp-digest Type: exitcode-stdio-1.0 - Main-Is: Test/OpenSSL/EVP/Digest.hs - Other-Modules: Test.OpenSSL.TestUtils + Main-Is: EVP/Digest.hs + HS-Source-Dirs: Test/OpenSSL + Other-Modules: TestUtils Build-Depends: HsOpenSSL, base >= 4.4 && < 5, diff --git a/OpenSSL/Session.hsc b/OpenSSL/Session.hsc --- a/OpenSSL/Session.hsc +++ b/OpenSSL/Session.hsc @@ -38,6 +38,7 @@ , addOption , removeOption , setTlsextHostName + , enableHostnameValidation , accept , tryAccept , connect @@ -101,7 +102,11 @@ import qualified Data.ByteString.Lazy.Internal as L import System.IO.Unsafe import System.Posix.Types (Fd(..)) +#if MIN_VERSION_network(3,1,0) +import Network.Socket (Socket, withFdSocket) +#else import Network.Socket (Socket, fdSocket) +#endif #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<$)) @@ -381,12 +386,16 @@ -- collector closing the file descriptor out from under you. connection :: SSLContext -> Socket -> IO SSL connection context sock = do +#if MIN_VERSION_network(3,1,0) + withFdSocket sock $ \ fd -> connection' context (Fd fd) (Just sock) +#else #if MIN_VERSION_network(3,0,0) fd <- fdSocket sock #else let fd = fdSocket sock #endif connection' context (Fd fd) (Just sock) +#endif -- | Wrap a socket Fd in an SSL connection. fdConnection :: SSLContext -> Fd -> IO SSL @@ -423,6 +432,21 @@ withSSL ssl $ \sslPtr -> withCString h $ \ hPtr -> _SSL_set_tlsext_host_name sslPtr hPtr >> return () + +-- Hostname validation, inspired by https://wiki.openssl.org/index.php/Hostname_validation + +foreign import ccall unsafe "HsOpenSSL_enable_hostname_validation" + _enable_hostname_validation :: Ptr SSL_ -> CString -> CSize -> IO CInt + +-- | Enable hostname validation. Also see 'setTlsextHostName'. +-- +-- This uses the built-in mechanism introduced in 1.0.2/1.1.0, and will +-- fail otherwise. +enableHostnameValidation :: SSL -> String -> IO () +enableHostnameValidation ssl host = + withSSL ssl $ \ssl -> + withCStringLen host $ \(host, hostLen) -> + _enable_hostname_validation ssl host (fromIntegral hostLen) >>= failIf_ (/= 1) foreign import ccall "SSL_accept" _ssl_accept :: Ptr SSL_ -> IO CInt foreign import ccall "SSL_connect" _ssl_connect :: Ptr SSL_ -> IO CInt diff --git a/Test/OpenSSL/DER.hs b/Test/OpenSSL/DER.hs --- a/Test/OpenSSL/DER.hs +++ b/Test/OpenSSL/DER.hs @@ -2,7 +2,7 @@ import OpenSSL.RSA import OpenSSL.DER -import Test.OpenSSL.TestUtils +import TestUtils main :: IO () main = do diff --git a/Test/OpenSSL/DSA.hs b/Test/OpenSSL/DSA.hs --- a/Test/OpenSSL/DSA.hs +++ b/Test/OpenSSL/DSA.hs @@ -2,7 +2,7 @@ import qualified Data.ByteString as BS import OpenSSL.DSA -import Test.OpenSSL.TestUtils +import TestUtils -- | This function just runs the example DSA generation, as given in FIP 186-2, -- app 5. diff --git a/Test/OpenSSL/EVP/Base64.hs b/Test/OpenSSL/EVP/Base64.hs --- a/Test/OpenSSL/EVP/Base64.hs +++ b/Test/OpenSSL/EVP/Base64.hs @@ -9,7 +9,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import OpenSSL.EVP.Base64 -import Test.OpenSSL.TestUtils +import TestUtils -- NOTE: bytestring-0.9.0.4 has these instances too, while -- bytestring-0.9.0.3 does not. If our bytestring is 0.9.0.4 we'll diff --git a/Test/OpenSSL/EVP/Digest.hs b/Test/OpenSSL/EVP/Digest.hs --- a/Test/OpenSSL/EVP/Digest.hs +++ b/Test/OpenSSL/EVP/Digest.hs @@ -6,7 +6,7 @@ import OpenSSL import Text.Printf import OpenSSL.EVP.Digest -import Test.OpenSSL.TestUtils +import TestUtils main :: IO () main = withOpenSSL $ do diff --git a/Test/OpenSSL/TestUtils.hs b/Test/OpenSSL/TestUtils.hs --- a/Test/OpenSSL/TestUtils.hs +++ b/Test/OpenSSL/TestUtils.hs @@ -1,4 +1,4 @@ -module Test.OpenSSL.TestUtils where +module TestUtils where import qualified Control.Exception as E import Control.Monad diff --git a/cbits/HsOpenSSL.c b/cbits/HsOpenSSL.c --- a/cbits/HsOpenSSL.c +++ b/cbits/HsOpenSSL.c @@ -390,3 +390,13 @@ return SSL_set_options(ssl, tmp & ~options); #endif } + +int HsOpenSSL_enable_hostname_validation(SSL* ssl, char* host_name, size_t host_len) { +#if defined(X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS) + X509_VERIFY_PARAM* param = SSL_get0_param(ssl); + X509_VERIFY_PARAM_set_hostflags(param, X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS); + return X509_VERIFY_PARAM_set1_host(param, host_name, host_len); +#else + return 0; +#endif +} diff --git a/cbits/HsOpenSSL.h b/cbits/HsOpenSSL.h --- a/cbits/HsOpenSSL.h +++ b/cbits/HsOpenSSL.h @@ -105,4 +105,6 @@ long HsOpenSSL_SSL_clear_options(SSL* ssl, long options); long HsOpenSSL_SSL_set_tlsext_host_name(SSL* ssl, char* host_name); +int HsOpenSSL_enable_hostname_validation(SSL* ssl, char* host_name, size_t host_len); + #endif