From 3e4c658909d6b554c405f61f786ddf86151bdd79 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Fri, 14 Aug 2026 10:35:41 +0900 Subject: [PATCH] simplifying gracefulClose --- Network/Socket/Shutdown.hs | 55 +++----------------------------------- 1 file changed, 4 insertions(+), 51 deletions(-) diff --git a/Network/Socket/Shutdown.hs b/Network/Socket/Shutdown.hs index 92eccb30..0e13b9a6 100644 --- a/Network/Socket/Shutdown.hs +++ b/Network/Socket/Shutdown.hs @@ -15,15 +15,9 @@ import Foreign.Marshal.Alloc (mallocBytes, free) import qualified System.IO.Error as E import System.Timeout -#if !defined(mingw32_HOST_OS) -import Control.Concurrent.STM -import qualified GHC.Event as Ev -#endif - import Network.Socket.Buffer import Network.Socket.Imports import Network.Socket.Internal -import Network.Socket.STM import Network.Socket.Types data ShutdownCmd = ShutdownReceive @@ -58,7 +52,8 @@ foreign import CALLCONV unsafe "shutdown" -- -- Since: 3.1.1.0 gracefulClose :: Socket -> Int -> IO () -gracefulClose s tmout0 = (sendRecvFIN `E.finally` close s) `annotateIOException` show s +gracefulClose s tmout0 = + (sendRecvFIN `E.finally` close s) `annotateIOException` show s where sendRecvFIN = do -- Sending TCP FIN. @@ -71,18 +66,7 @@ gracefulClose s tmout0 = (sendRecvFIN `E.finally` close s) `annotateIOException` -- FIN arrives meanwhile. yield -- Waiting TCP FIN. - E.bracket (mallocBytes bufSize) free (recvEOF s tmout0) - -recvEOF :: Socket -> Int -> Ptr Word8 -> IO () -#if !defined(mingw32_HOST_OS) -recvEOF s tmout0 buf = do - mevmgr <- Ev.getSystemEventManager - case mevmgr of - Nothing -> recvEOFtimeout s tmout0 buf - Just _ -> recvEOFevent s tmout0 buf -#else -recvEOF = recvEOFtimeout -#endif + E.bracket (mallocBytes bufSize) free (recvEOFtimeout s tmout0) -- Don't use 4092 here. The GHC runtime takes the global lock -- if the length is over 3276 bytes in 32bit or 3272 bytes in 64bit. @@ -90,35 +74,4 @@ bufSize :: Int bufSize = 1024 recvEOFtimeout :: Socket -> Int -> Ptr Word8 -> IO () -recvEOFtimeout s tmout0 buf = void $ timeout tmout0 $ recvBuf s buf bufSize - -#if !defined(mingw32_HOST_OS) -data Wait = MoreData | TimeoutTripped - -recvEOFevent :: Socket -> Int -> Ptr Word8 -> IO () -recvEOFevent s tmout0 buf = do - tmmgr <- Ev.getSystemTimerManager - tvar <- newTVarIO False - 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 - -- 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 +recvEOFtimeout s tmout0 buf = void $ timeout (tmout0 * 1000) $ recvBuf s buf bufSize