network 3.2.6.0 → 3.2.7.0

raw patch · 6 files changed

+46/−36 lines, 6 files

Files

• CHANGELOG.md +9/−0
• Network/Socket/Info.hsc +4/−2
• Network/Socket/Shutdown.hs +24/−25
• Network/Socket/Syscall.hs +7/−7
• configure.ac +1/−1
• network.cabal +1/−1

@@ -1,3 +1,12 @@+## Version 3.2.7.0++* Using nested `bracket` for `gracefulClose`.+  [#591](https://github.com/haskell/network/issues/590)+* Fix memory leak in getaddrinfo and make it async exception safe.+  [#591](https://github.com/haskell/network/pull/591)+* Make call to c_free async exception safe.+  [#592](https://github.com/haskell/network/pull/592)+ ## Version 3.2.6.0  * fixing the Show instance of IPv4-mapped IPv6 address on little endian machines

@@ -7,6 +7,7 @@  module Network.Socket.Info where +import Control.Exception (mask, onException) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Foreign.Marshal.Alloc (alloca, allocaBytes)@@ -274,11 +275,12 @@             maybeWith with filteredHints                    $ \c_hints ->                   alloca                                    $ \ptr_ptr_addrs ->                       body c_node c_service c_hints ptr_ptr_addrs-    getaddrinfo c_node c_service c_hints ptr_ptr_addrs = do+    getaddrinfo c_node c_service c_hints ptr_ptr_addrs = mask $ \release -> do         ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs         if ret == 0 then do             ptr_addrs <- peek ptr_ptr_addrs-            ais       <- followAddrInfo ptr_addrs+            ais       <- release (followAddrInfo ptr_addrs) `onException` c_freeaddrinfo ptr_addrs+            c_freeaddrinfo ptr_addrs             return ais           else do             err <- gai_strerror ret

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}  #include "HsNetDef.h" @@ -59,7 +60,8 @@         -- Sending TCP FIN.         ex <- E.try $ shutdown s ShutdownSend         case ex of-          Left (E.SomeException _) -> return ()+          -- Don't catch asynchronous exceptions+          Left (_ :: E.IOException) -> return ()           Right () -> do               -- Giving CPU time to other threads hoping that               -- FIN arrives meanwhile.@@ -93,29 +95,26 @@ recvEOFevent s tmout0 buf = do     tmmgr <- Ev.getSystemTimerManager     tvar <- newTVarIO False-    E.bracket (setup tmmgr tvar) teardown $ \(wait, _) -> do-        waitRes <- wait-        case waitRes of-          TimeoutTripped -> return ()-          -- We don't check the (positive) length.-          -- In normal case, it's 0. That is, only FIN is received.-          -- In error cases, data is available. But there is no-          -- application which can read it. So, let's stop receiving-          -- to prevent attacks.-          MoreData       -> void $ recvBufNoWait s buf bufSize+    E.bracket (setupTimeout tmmgr tvar) (cancelTimeout tmmgr) $ \_ -> do+        E.bracket (setupRead s) cancelRead $ \(rxWait,_) -> do+            let toWait = readTVar tvar >>= check+                wait = atomically ((toWait >> return TimeoutTripped)+                               <|> (rxWait >> return MoreData))+            waitRes <- wait+            case waitRes of+              TimeoutTripped -> return ()+              -- We don't check the (positive) length.+              -- In normal case, it's 0. That is, only FIN is received.+              -- In error cases, data is available. But there is no+              -- application which can read it. So, let's stop receiving+              -- to prevent attacks.+              MoreData       -> void $ recvBufNoWait s buf bufSize   where-    setup tmmgr tvar = do-        -- millisecond to microsecond-        key <- Ev.registerTimeout tmmgr (tmout0 * 1000) $-            atomically $ writeTVar tvar True-        (evWait, evCancel) <- waitAndCancelReadSocketSTM s-        let toWait = do-                tmout <- readTVar tvar-                check tmout-            toCancel = Ev.unregisterTimeout tmmgr key-            wait = atomically ((toWait >> return TimeoutTripped)-                           <|> (evWait >> return MoreData))-            cancel = evCancel >> toCancel-        return (wait, cancel)-    teardown (_, cancel) = cancel+    -- millisecond to microsecond+    tmout = tmout0 * 1000+    setupTimeout tmmgr tvar =+        Ev.registerTimeout tmmgr tmout $ atomically $ writeTVar tvar True+    cancelTimeout = Ev.unregisterTimeout+    setupRead = waitAndCancelReadSocketSTM+    cancelRead (_,cancel) = cancel #endif

@@ -11,6 +11,7 @@ #endif  #if defined(mingw32_HOST_OS)+import Control.Exception (bracket) import Foreign (FunPtr) import GHC.Conc (asyncDoProc) #else@@ -202,13 +203,12 @@                        throwSocketErrorIfMinus1Retry "Network.Socket.accept" $                          c_accept_safe fd sa ptr_len        | otherwise = do-             paramData <- c_newAcceptParams fd (fromIntegral sz) sa-             rc        <- asyncDoProc c_acceptDoProc paramData-             new_fd    <- c_acceptNewSock paramData-             c_free paramData-             when (rc /= 0) $-               throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc)-             return new_fd+             bracket (c_newAcceptParams fd (fromIntegral sz) sa) c_free $ \paramData -> do+                 rc     <- asyncDoProc c_acceptDoProc paramData+                 new_fd <- c_acceptNewSock paramData+                 when (rc /= 0) $+                     throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc)+                 return new_fd #else      callAccept fd sa sz = with (fromIntegral sz) $ \ ptr_len -> do # ifdef HAVE_ADVANCED_SOCKET_FLAGS

@@ -1,5 +1,5 @@ AC_INIT([Haskell network package],-        [3.2.6.0],+        [3.2.7.0],         [libraries@haskell.org],         [network]) 

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               network-version:            3.2.6.0+version:            3.2.7.0 license:            BSD3 license-file:       LICENSE maintainer:         Kazu Yamamoto, Tamar Christina