From e4317551c99a80f9cf5bf3e9e6b8f771fe6538cf Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 17 Aug 2026 07:38:16 +0900 Subject: [PATCH 1/4] `gracefulClose` continues `readBuf` until EOF is reached, as much as possible. trying to fix https://github.com/haskell/network/issues/618 --- Network/Socket/Shutdown.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/Network/Socket/Shutdown.hs b/Network/Socket/Shutdown.hs index 0e13b9a6..702eb0dc 100644 --- a/Network/Socket/Shutdown.hs +++ b/Network/Socket/Shutdown.hs @@ -73,5 +73,16 @@ gracefulClose s tmout0 = bufSize :: Int bufSize = 1024 +-- Maximum number of bytes to drain while waiting for the peer's FIN. +drainLimit :: Int +drainLimit = 128 * 1024 + recvEOFtimeout :: Socket -> Int -> Ptr Word8 -> IO () -recvEOFtimeout s tmout0 buf = void $ timeout (tmout0 * 1000) $ recvBuf s buf bufSize +recvEOFtimeout s tmout0 buf = + void $ timeout (tmout0 * 1000) $ loop 0 + where + loop n0 = do + n1 <- recvBuf s buf bufSize + when (n1 > 0) $ do + let n = n0 + n1 + when (n < drainLimit) $ loop n From 666bf5b63c05624663e98179300ffbdc2368b9f2 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 17 Aug 2026 07:39:54 +0900 Subject: [PATCH 2/4] Ensuring the server does not exceed the time limit in the gracefulClose test. --- tests/Network/SocketSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs index cf78c9d7..e3142081 100644 --- a/tests/Network/SocketSpec.hs +++ b/tests/Network/SocketSpec.hs @@ -254,7 +254,7 @@ spec = do it "does not send TCP RST back" $ do let server sock = do void $ recv sock 1024 -- receiving "GOAWAY" - gracefulClose sock 3000 + gracefulClose sock 300 client sock = do sendAll sock "GOAWAY" threadDelay 10000 From c4f7be5a9d726128b8377c0144d5c4ef840b76ca Mon Sep 17 00:00:00 2001 From: Viktor Dukhovni Date: Mon, 17 Aug 2026 15:38:24 +1000 Subject: [PATCH 3/4] Enforce the gracefulClose deadline with a watchdog thread, not `timeout` The drain loop makes `gracefulClose` depend on its timeout firing while `recvBuf` is blocked. With the MIO manager on Windows, `recvBuf` blocks in a foreign recv() call, and the asynchronous exception that `System.Timeout.timeout` throws cannot interrupt a foreign call. This is an existing: the timeout in `gracefulClose` hasn't been able to fire mid-recv under MIO on Windows, since 3.1.1.0. The previous single `recvBuf` masked it, because any data from the peer (not only FIN) completed the call before the timeout was needed. The drain loop is the first code path that actually waits for the FIN. Enforce the deadline with a watchdog thread instead: `threadDelay` for the deadline, then shutdown(SHUT_RDWR) on the socket. Shutdown aborts a blocked recv while leaving the descriptor valid, so unlike close it cannot race with a `recvBuf` that has not yet entered the kernel: whichever side wins, `recvBuf` returns EOF or fails, and either ends the loop. The watchdog itself only ever blocks in `threadDelay`, which is always interruptible, so `killThread` reliably reaps it once EOF is reached. No asynchronous exception ever needs to reach the draining thread, on any platform, so the same implementation serves everywhere and `timeout` is no longer used. Verified on Linux (threaded and non-threaded RTS): the deadline now bounds a peer that keeps the connection open, and the fast path (peer's FIN already queued) is unaffected. Microsoft does not document the effect of shutdown on an already-blocked recv; this PR's Windows CI run is the experiment. Should it not hold, CancelIoEx on the socket handle is the fallback. Co-Authored-By: Claude Fable 5 --- Network/Socket/Shutdown.hs | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/Network/Socket/Shutdown.hs b/Network/Socket/Shutdown.hs index 702eb0dc..883fdb33 100644 --- a/Network/Socket/Shutdown.hs +++ b/Network/Socket/Shutdown.hs @@ -9,11 +9,10 @@ module Network.Socket.Shutdown ( , gracefulClose ) where -import Control.Concurrent (yield) +import Control.Concurrent (forkIO, killThread, threadDelay, yield) import qualified Control.Exception as E import Foreign.Marshal.Alloc (mallocBytes, free) import qualified System.IO.Error as E -import System.Timeout import Network.Socket.Buffer import Network.Socket.Imports @@ -66,7 +65,7 @@ gracefulClose s tmout0 = -- FIN arrives meanwhile. yield -- Waiting TCP FIN. - E.bracket (mallocBytes bufSize) free (recvEOFtimeout s tmout0) + E.bracket (mallocBytes bufSize) free (recvEOFloop 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. @@ -77,12 +76,29 @@ bufSize = 1024 drainLimit :: Int drainLimit = 128 * 1024 -recvEOFtimeout :: Socket -> Int -> Ptr Word8 -> IO () -recvEOFtimeout s tmout0 buf = - void $ timeout (tmout0 * 1000) $ loop 0 +-- Draining the receive queue until EOF, bounded by 'drainLimit' bytes +-- and by the millisecond deadline in the second argument. +-- +-- The deadline is enforced by a watchdog thread that shuts the socket +-- down, rather than by 'System.Timeout.timeout': with the MIO manager +-- on Windows, 'recvBuf' blocks in a foreign 'recv' call, which the +-- asynchronous exception thrown by 'timeout' cannot interrupt. +-- 'shutdown' aborts a blocked 'recv' while leaving the descriptor +-- valid, so unlike 'close' it does not race with a 'recvBuf' that has +-- not yet entered the kernel: whichever side wins, 'recvBuf' returns +-- EOF or fails, both of which end the loop. The watchdog itself only +-- ever blocks in 'threadDelay', which is always interruptible, so +-- 'killThread' reliably reaps it once EOF is reached. +recvEOFloop :: Socket -> Int -> Ptr Word8 -> IO () +recvEOFloop s tmout0 buf = E.bracket watchdog killThread $ \_ -> loop 0 where + watchdog = forkIO $ do + threadDelay (tmout0 * 1000) + void $ E.tryIOError $ shutdown s ShutdownBoth loop n0 = do - n1 <- recvBuf s buf bufSize - when (n1 > 0) $ do - let n = n0 + n1 - when (n < drainLimit) $ loop n + ex <- E.tryIOError $ recvBuf s buf bufSize + case ex of + Left _ -> return () + Right n1 -> when (n1 > 0) $ do + let n = n0 + n1 + when (n < drainLimit) $ loop n From 6b300d070bd62d29821ade8549893f2de8f1f3a7 Mon Sep 17 00:00:00 2001 From: Viktor Dukhovni Date: Mon, 17 Aug 2026 06:07:42 +0000 Subject: [PATCH 4/4] Windows: abort the blocked recv with CancelIoEx The previous commit's Windows CI run answered the open question in its message: shutdown() does not wake a recv that is already blocked on Windows -- the jobs fail exactly as before, with the deadline never enforced. Keep the shutdown: it still guarantees that a recv issued after the deadline fails immediately (WSAESHUTDOWN), closing the race with a recv that has not yet entered the kernel. Add CancelIoEx(handle, NULL) after it to abort a recv that has. Sockets are created with WSA_FLAG_OVERLAPPED, so even a blocking recv is an overlapped operation internally and is cancellable; it fails with WSA_OPERATION_ABORTED, which ends the drain loop like any other error. The descriptor remains valid throughout, so as with shutdown there is no reuse hazard of the kind close would have. Under WinIO nothing changes: its overlapped recv already maps ERROR_OPERATION_ABORTED to EOF, and a cancellation from the watchdog is handled by the same path. POSIX platforms are unchanged: shutdown alone wakes the blocked recv there (verified on Linux, threaded and non-threaded RTS). Co-Authored-By: Claude Fable 5 --- Network/Socket/Shutdown.hs | 48 +++++++++++++++++++++++++++++--------- 1 file changed, 37 insertions(+), 11 deletions(-) diff --git a/Network/Socket/Shutdown.hs b/Network/Socket/Shutdown.hs index 883fdb33..ecbc72af 100644 --- a/Network/Socket/Shutdown.hs +++ b/Network/Socket/Shutdown.hs @@ -79,22 +79,19 @@ drainLimit = 128 * 1024 -- Draining the receive queue until EOF, bounded by 'drainLimit' bytes -- and by the millisecond deadline in the second argument. -- --- The deadline is enforced by a watchdog thread that shuts the socket --- down, rather than by 'System.Timeout.timeout': with the MIO manager --- on Windows, 'recvBuf' blocks in a foreign 'recv' call, which the --- asynchronous exception thrown by 'timeout' cannot interrupt. --- 'shutdown' aborts a blocked 'recv' while leaving the descriptor --- valid, so unlike 'close' it does not race with a 'recvBuf' that has --- not yet entered the kernel: whichever side wins, 'recvBuf' returns --- EOF or fails, both of which end the loop. The watchdog itself only --- ever blocks in 'threadDelay', which is always interruptible, so --- 'killThread' reliably reaps it once EOF is reached. +-- The deadline is enforced by a watchdog thread calling 'abortRecv', +-- rather than by 'System.Timeout.timeout': with the MIO manager on +-- Windows, 'recvBuf' blocks in a foreign 'recv' call, which the +-- asynchronous exception thrown by 'timeout' cannot interrupt. The +-- watchdog itself only ever blocks in 'threadDelay', which is always +-- interruptible, so 'killThread' reliably reaps it once EOF is +-- reached. recvEOFloop :: Socket -> Int -> Ptr Word8 -> IO () recvEOFloop s tmout0 buf = E.bracket watchdog killThread $ \_ -> loop 0 where watchdog = forkIO $ do threadDelay (tmout0 * 1000) - void $ E.tryIOError $ shutdown s ShutdownBoth + abortRecv s loop n0 = do ex <- E.tryIOError $ recvBuf s buf bufSize case ex of @@ -102,3 +99,32 @@ recvEOFloop s tmout0 buf = E.bracket watchdog killThread $ \_ -> loop 0 Right n1 -> when (n1 > 0) $ do let n = n0 + n1 when (n < drainLimit) $ loop n + +-- Aborting the drain loop's 'recvBuf' while leaving the descriptor +-- valid, so that, unlike 'close', nothing here can race with +-- descriptor reuse. +-- +-- 'shutdown' makes every recv issued from now on fail (POSIX: EOF; +-- Windows: WSAESHUTDOWN) and on POSIX it also wakes a recv that is +-- already blocked in the kernel. On Windows it does not, so a +-- blocked recv is aborted with CancelIoEx: sockets are created with +-- WSA_FLAG_OVERLAPPED, hence even a "blocking" recv is an overlapped +-- operation internally, waited on inside ws2_32, and cancellation +-- makes it fail with WSA_OPERATION_ABORTED. Shutting down first +-- closes the race with a recv that has not yet entered the kernel: +-- in every interleaving the recv returns EOF, fails, or is +-- cancelled, and each of these ends the drain loop. +abortRecv :: Socket -> IO () +abortRecv s = do + void $ E.tryIOError $ shutdown s ShutdownBoth +#if defined(mingw32_HOST_OS) + void $ withFdSocket s $ \fd -> c_CancelIoEx fd nullPtr +#endif + +#if defined(mingw32_HOST_OS) +-- BOOL CancelIoEx(HANDLE hFile, LPOVERLAPPED lpOverlapped) +-- A SOCKET is a kernel HANDLE. A NULL lpOverlapped cancels all +-- pending I/O on the handle, whichever thread issued it. +foreign import CALLCONV unsafe "CancelIoEx" + c_CancelIoEx :: CSocket -> Ptr () -> IO CInt +#endif