tls 1.5.3 → 1.5.4

raw patch · 6 files changed

+45/−24 lines, 6 files

Files

• Benchmarks/Benchmarks.hs +3/−3
• CHANGELOG.md +7/−0
• Network/TLS/Handshake/Client.hs +11/−2
• Tests/Connection.hs +12/−11
• Tests/Tests.hs +11/−7
• tls.cabal +1/−1

@@ -62,9 +62,9 @@            -> a            -> IO b runTLSPipe params tlsServer tlsClient d = do-    (writeStart, readResult) <- establishDataPipe params tlsServer tlsClient-    writeStart d-    readResult+    withDataPipe params tlsServer tlsClient $ \(writeStart, readResult) -> do+        writeStart d+        readResult  runTLSPipeSimple :: (ClientParams, ServerParams) -> B.ByteString -> IO B.ByteString runTLSPipeSimple params = runTLSPipe params tlsServer tlsClient

@@ -1,3 +1,10 @@+## Version 1.5.4++- Restore interoperability with early Java 6+  [#422](https://github.com/vincenthz/hs-tls/pull/422)+- Test cleanups for timeout and async usage+  [#416](https://github.com/vincenthz/hs-tls/pull/416)+ ## Version 1.5.3  - Additional verification regarding EC signatures

@@ -120,6 +120,15 @@         tls13 = highestVer >= TLS13         ems = supportedExtendedMasterSec $ ctxSupported ctx         groupToSend = listToMaybe groups++        -- List of extensions to send in ClientHello, ordered such that we never+        -- terminate with a zero-length extension.  Some buggy implementations+        -- are allergic to an extension with empty data at final position.+        --+        -- Without TLS 1.3, the list ends with extension "signature_algorithms"+        -- with length >= 2 bytes.  When TLS 1.3 is enabled, extensions+        -- "psk_key_exchange_modes" (currently always sent) and "pre_shared_key"+        -- (not always present) have length > 0.         getExtensions pskInfo rtt0 = sequence             [ sniExtension             , secureReneg@@ -133,10 +142,10 @@             , versionExtension             , earlyDataExtension rtt0             , keyshareExtension-            , pskExchangeModeExtension             , cookieExtension             , postHandshakeAuthExtension-            , preSharedKeyExtension pskInfo -- MUST be last+            , pskExchangeModeExtension+            , preSharedKeyExtension pskInfo -- MUST be last (RFC 8446)             ]          toExtensionRaw :: Extension e => e -> ExtensionRaw

@@ -26,7 +26,7 @@     , twoSessionManagers     , setPairParamsSessionManagers     , setPairParamsSessionResuming-    , establishDataPipe+    , withDataPipe     , initiateDataPipe     , byeBye     ) where@@ -366,8 +366,8 @@                                     , loggingPacketRecv = putStrLn . ((pre ++ "<< ") ++) }                 else def -establishDataPipe :: (ClientParams, ServerParams) -> (Context -> Chan result -> IO ()) -> (Chan start -> Context -> IO ()) -> IO (start -> IO (), IO result)-establishDataPipe params tlsServer tlsClient = do+withDataPipe :: (ClientParams, ServerParams) -> (Context -> Chan result -> IO ()) -> (Chan start -> Context -> IO ()) -> ((start -> IO (), IO result) -> IO a) -> IO a+withDataPipe params tlsServer tlsClient cont = do     -- initial setup     pipe        <- newPipe     _           <- runPipe pipe@@ -376,19 +376,20 @@      (cCtx, sCtx) <- newPairContext pipe params -    sAsync <- async $ E.catch (tlsServer sCtx resultQueue)-                              (printAndRaise "server" (serverSupported $ snd params))-    cAsync <- async $ E.catch (tlsClient startQueue cCtx)-                              (printAndRaise "client" (clientSupported $ fst params))+    withAsync (E.catch (tlsServer sCtx resultQueue)+                       (printAndRaise "server" (serverSupported $ snd params))) $ \sAsync -> do+    withAsync (E.catch (tlsClient startQueue cCtx)+                       (printAndRaise "client" (clientSupported $ fst params))) $ \cAsync -> do -    let readResult = waitBoth cAsync sAsync >> readChan resultQueue-    return (writeChan startQueue, readResult)+      let readResult = waitBoth cAsync sAsync >> readChan resultQueue+      cont (writeChan startQueue, readResult)+   where         printAndRaise :: String -> Supported -> E.SomeException -> IO ()         printAndRaise s supported e = do             putStrLn $ s ++ " exception: " ++ show e ++-                           ", supported: " ++ show supported-            E.throw e+                            ", supported: " ++ show supported+            E.throwIO e  initiateDataPipe :: (ClientParams, ServerParams) -> (Context -> IO a1) -> (Context -> IO a) -> IO (Either E.SomeException a, Either E.SomeException a1) initiateDataPipe params tlsServer tlsClient = do

@@ -58,16 +58,20 @@  runTLSPipeN :: Int -> (ClientParams, ServerParams) -> (Context -> Chan [C8.ByteString] -> IO ()) -> (Chan C8.ByteString -> Context -> IO ()) -> PropertyM IO () runTLSPipeN n params tlsServer tlsClient = do-    (writeStart, readResult) <- run (establishDataPipe params tlsServer tlsClient)-    -- send some data+    -- generate some data to send     ds <- replicateM n $ do         d <- B.pack <$> pick (someWords8 256)-        _ <- run $ writeStart d         return d-    -- receive it-    dsres <- run $ timeout 60000000 readResult -- 60 sec-    -- check if it equal-    Just ds `assertEq` dsres+    -- send it+    m_dsres <- run $ do+        withDataPipe params tlsServer tlsClient $ \(writeStart, readResult) -> do+            forM_ ds $ \d -> do+                writeStart d+            -- receive it+            timeout 60000000 readResult -- 60 sec+    case m_dsres of+        Nothing -> error "timed out"+        Just dsres -> ds `assertEq` dsres  runTLSPipe :: (ClientParams, ServerParams) -> (Context -> Chan [C8.ByteString] -> IO ()) -> (Chan C8.ByteString -> Context -> IO ()) -> PropertyM IO () runTLSPipe = runTLSPipeN 1

@@ -1,5 +1,5 @@ Name:                tls-Version:             1.5.3+Version:             1.5.4 Description:    Native Haskell TLS and SSL protocol implementation for server and client.    .