From 9b78ba951256e535878cefc8611262065739a9fc Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 21 Sep 2026 14:43:55 +0900 Subject: [PATCH 1/4] winio: load WSASendMsg/WSARecvMsg from Haskell Winsock exposes WSASendMsg and WSARecvMsg only through WSAIoctl with SIO_GET_EXTENSION_FUNCTION_POINTER, and cmsg.c wrapped them in C functions of the same name that fetched the pointer on first use behind an unsynchronised static. C cannot wait for a completion event from the RTS, so the call could not be issued asynchronously from there; that was the TODO cmsg.c carried. Move the lookup into Network.Socket.Win32.Load, which caches the pointer in a TVar and hands out a safe wrapper for MIO and an unsafe one for WinIO, and call it from Buffer.hsc and ByteString/IO.hsc. The control buffer fix-up on WSAEMSGSIZE moves to Haskell along with it. Picked from #611. Co-Authored-By: Claude Opus 5 (1M context) --- Network/Socket/Buffer.hsc | 52 +++++++----- Network/Socket/ByteString/IO.hsc | 8 +- Network/Socket/ByteString/Internal.hs | 11 +-- Network/Socket/Win32/Load.hs | 114 ++++++++++++++++++++++++++ cbits/cmsg.c | 76 ++++++----------- include/HsNet.h | 14 ++-- network.cabal | 1 + 7 files changed, 187 insertions(+), 89 deletions(-) create mode 100644 Network/Socket/Win32/Load.hs diff --git a/Network/Socket/Buffer.hsc b/Network/Socket/Buffer.hsc index 4a09195b..240c192e 100644 --- a/Network/Socket/Buffer.hsc +++ b/Network/Socket/Buffer.hsc @@ -32,6 +32,7 @@ import System.IO.Error (mkIOError, ioeSetErrorString, catchIOError) #if defined(mingw32_HOST_OS) import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr) import Network.Socket.Win32.CmsgHdr +import Network.Socket.Win32.Load import Network.Socket.Win32.MsgHdr import Network.Socket.Win32.WSABuf ## if __IO_MANAGER_WINIO__ >= 2 @@ -519,37 +520,40 @@ foreign import CALLCONV SAFE_ON_WIN "ioctlsocket" c_ioctlsocket :: CSocket -> CLong -> Ptr CULong -> IO CInt foreign import CALLCONV SAFE_ON_WIN "WSAGetLastError" c_WSAGetLastError :: IO CInt -foreign import CALLCONV SAFE_ON_WIN "WSASendMsg" - -- fixme Handle for SOCKET, see #426 - c_sendmsg :: CSocket -> Ptr (MsgHdr sa) -> DWORD -> LPDWORD -> Ptr () -> Ptr () -> IO CInt foreign import CALLCONV unsafe "WSASend" c_WSASend :: CSocket -> Ptr WSABuf -> DWORD -> LPDWORD -> DWORD -> Ptr () -> Ptr () -> IO CInt foreign import CALLCONV unsafe "WSASendTo" c_WSASendTo :: CSocket -> Ptr WSABuf -> DWORD -> LPDWORD -> DWORD -> Ptr sa -> CInt -> Ptr () -> Ptr () -> IO CInt -foreign import CALLCONV SAFE_ON_WIN "WSARecvMsg" - c_recvmsg_mio :: CSocket -> Ptr (MsgHdr sa) -> LPDWORD -> Ptr () -> Ptr () -> IO CInt foreign import CALLCONV unsafe "WSARecv" c_WSARecv :: CSocket -> Ptr WSABuf -> DWORD -> LPDWORD -> LPDWORD -> Ptr () -> Ptr () -> IO CInt foreign import CALLCONV unsafe "WSARecvFrom" c_WSARecvFrom :: CSocket -> Ptr WSABuf -> DWORD -> LPDWORD -> LPDWORD -> Ptr sa -> Ptr CInt -> Ptr () -> Ptr () -> IO CInt -## if __IO_MANAGER_WINIO__ >= 2 -foreign import CALLCONV unsafe "WSARecvMsg" - c_recvmsg_winio :: CSocket -> Ptr (MsgHdr sa) -> LPDWORD -> Ptr () -> Ptr () -> IO CInt -## endif + +-- Winsock can leave the control buffer pointing at garbage once the +-- message was truncated, so clear it. The C wrapper around WSARecvMsg +-- used to do this. +clearCtrlOnTruncation :: Ptr (MsgHdr sa) -> CInt -> IO () +clearCtrlOnTruncation msgHdrPtr ret = when (ret == -1) $ do + err <- c_WSAGetLastError + when (err == #{const WSAEMSGSIZE}) $ do + (#poke WSAMSG, Control.len) msgHdrPtr (0 :: Word32) + (#poke WSAMSG, Control.buf) msgHdrPtr (nullPtr :: Ptr Word8) sendBufMsgMIO :: Socket -> CSocket -> Ptr (MsgHdr sa) -> CInt -> IO CInt -sendBufMsgMIO s fd msgHdrPtr cflags = +sendBufMsgMIO s fd msgHdrPtr cflags = do + sendMsg <- mkSendMsgSafe <$> getWSASendMsg fd throwSocketErrorWaitWrite s "Network.Socket.Buffer.sendMsg" $ alloca $ \send_ptr -> - c_sendmsg fd msgHdrPtr (fromIntegral cflags) send_ptr nullPtr nullPtr + sendMsg fd (castPtr msgHdrPtr) (fromIntegral cflags) send_ptr nullPtr nullPtr ## if __IO_MANAGER_WINIO__ >= 2 sendBufMsgWinIO :: CSocket -> Ptr (MsgHdr sa) -> CInt -> IO CInt -sendBufMsgWinIO fd msgHdrPtr cflags = +sendBufMsgWinIO fd msgHdrPtr cflags = do + sendMsg <- mkSendMsgUnsafe <$> getWSASendMsg fd fmap fromIntegral $ Mgr.withException "sendBufMsg" $ Mgr.withOverlapped "sendBufMsg" (wordPtrToPtr $ fromIntegral fd) 0 (\lpOverlapped -> do - ret <- c_sendmsg fd msgHdrPtr (fromIntegral cflags) nullPtr + ret <- sendMsg fd (castPtr msgHdrPtr) (fromIntegral cflags) nullPtr (castPtr lpOverlapped) nullPtr if ret == 0 then return Mgr.CbPending @@ -564,22 +568,28 @@ sendBufMsgWinIO fd msgHdrPtr cflags = -- Helper functions for recvBufMsg on Windows recvBufMsgMIO :: Socket -> CSocket -> Ptr (MsgHdr sa) -> IO Int -recvBufMsgMIO s fd msgHdrPtr = alloca $ \len_ptr -> do - _ <- throwSocketErrorWaitReadBut (== #{const WSAEMSGSIZE}) s "Network.Socket.Buffer.recvmsg" $ - c_recvmsg_mio fd msgHdrPtr len_ptr nullPtr nullPtr - fromIntegral <$> peek len_ptr +recvBufMsgMIO s fd msgHdrPtr = do + recvMsg <- mkRecvMsgSafe <$> getWSARecvMsg fd + alloca $ \len_ptr -> do + _ <- throwSocketErrorWaitReadBut (== #{const WSAEMSGSIZE}) s "Network.Socket.Buffer.recvmsg" $ do + ret <- recvMsg fd (castPtr msgHdrPtr) len_ptr nullPtr nullPtr + clearCtrlOnTruncation msgHdrPtr ret + return ret + fromIntegral <$> peek len_ptr ## if __IO_MANAGER_WINIO__ >= 2 recvBufMsgWinIO :: CSocket -> Ptr (MsgHdr sa) -> IO Int recvBufMsgWinIO fd msgHdrPtr = do -- Perform async WSARecvMsg using withOverlapped -- (socket already associated in socket creation) + recvMsg <- mkRecvMsgUnsafe <$> getWSARecvMsg fd fmap fromIntegral $ Mgr.withException "recvMsg" $ - Mgr.withOverlapped "recvMsg" (wordPtrToPtr $ fromIntegral fd) 0 startCB completionCB + Mgr.withOverlapped "recvMsg" (wordPtrToPtr $ fromIntegral fd) 0 (startCB recvMsg) completionCB where - startCB :: Mgr.LPOVERLAPPED -> IO (Mgr.CbResult Int) - startCB lpOverlapped = do - ret <- c_recvmsg_winio fd msgHdrPtr nullPtr (castPtr lpOverlapped) nullPtr + startCB :: WSARecvMsgFn -> Mgr.LPOVERLAPPED -> IO (Mgr.CbResult Int) + startCB recvMsg lpOverlapped = do + ret <- recvMsg fd (castPtr msgHdrPtr) nullPtr (castPtr lpOverlapped) nullPtr + clearCtrlOnTruncation msgHdrPtr ret -- Check WSAGetLastError immediately: if the operation didn't -- complete synchronously (ret /= 0), we must distinguish -- ERROR_IO_PENDING (async completion forthcoming) from real diff --git a/Network/Socket/ByteString/IO.hsc b/Network/Socket/ByteString/IO.hsc index 243bfef2..a600b26c 100644 --- a/Network/Socket/ByteString/IO.hsc +++ b/Network/Socket/ByteString/IO.hsc @@ -58,6 +58,9 @@ import System.Posix.Types (Fd(..)) import Network.Socket.Flag import Network.Socket.SockAddr (annotateWithSocket) +#if defined(mingw32_HOST_OS) +import Network.Socket.Win32.Load +#endif #if !defined(mingw32_HOST_OS) import Network.Socket.Posix.Cmsg @@ -216,11 +219,12 @@ sendManyTo s cs addr = sendManyTo' `annotateWithSocket` (s, Nothing) , msgCtrlLen = 0 , msgFlags = 0 } - withFdSocket s $ \fd -> + withFdSocket s $ \fd -> do + sendMsg <- mkSendMsgSafe <$> getWSASendMsg fd with msgHdr $ \msgHdrPtr -> alloca $ \send_ptr -> do _ <- throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $ - c_sendmsg fd msgHdrPtr 0 send_ptr nullPtr nullPtr + sendMsg fd (castPtr msgHdrPtr) 0 send_ptr nullPtr nullPtr peek send_ptr #endif diff --git a/Network/Socket/ByteString/Internal.hs b/Network/Socket/ByteString/Internal.hs index 59c8104f..c26cd146 100644 --- a/Network/Socket/ByteString/Internal.hs +++ b/Network/Socket/ByteString/Internal.hs @@ -14,11 +14,11 @@ module Network.Socket.ByteString.Internal mkInvalidRecvArgError #if !defined(mingw32_HOST_OS) , c_writev + , c_sendmsg + , c_recvmsg #else , c_wsasend #endif - , c_sendmsg - , c_recvmsg ) where #include "HsNetDef.h" @@ -39,7 +39,6 @@ import Foreign.C.Types import Foreign.Ptr import Network.Socket.Win32.WSABuf (WSABuf) -import Network.Socket.Win32.MsgHdr (MsgHdr) import Network.Socket.Types type DWORD = Word32 @@ -64,8 +63,6 @@ foreign import ccall unsafe "recvmsg" -- fixme Handle for SOCKET, see #426 foreign import CALLCONV SAFE_ON_WIN "WSASend" c_wsasend :: CSocket -> Ptr WSABuf -> DWORD -> LPDWORD -> DWORD -> Ptr () -> Ptr () -> IO CInt -foreign import CALLCONV SAFE_ON_WIN "WSASendMsg" - c_sendmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> DWORD -> LPDWORD -> Ptr () -> Ptr () -> IO CInt -foreign import CALLCONV SAFE_ON_WIN "WSARecvMsg" - c_recvmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> LPDWORD -> Ptr () -> Ptr () -> IO CInt +-- WSASendMsg and WSARecvMsg are extension functions and cannot be +-- imported by name; see Network.Socket.Win32.Load. #endif diff --git a/Network/Socket/Win32/Load.hs b/Network/Socket/Win32/Load.hs new file mode 100644 index 00000000..05ed2f03 --- /dev/null +++ b/Network/Socket/Win32/Load.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE CPP #-} + +-- | Lazily loading Winsock extension functions. +-- +-- Winsock does not export @WSASendMsg@ and @WSARecvMsg@ as ordinary +-- symbols. They have to be looked up at run time with @WSAIoctl@ and +-- @SIO_GET_EXTENSION_FUNCTION_POINTER@, which needs a live socket. The +-- resulting pointer is process-wide, so it is fetched once and cached. +-- +-- Doing the lookup here rather than in C is what lets the WinIO path +-- issue the call itself and hand it to @withOverlapped@. +module Network.Socket.Win32.Load ( + -- * Generic loader + Loaded(..) + , loadExtensionFunction + -- * WSASendMsg and WSARecvMsg + , WSASendMsgFn + , WSARecvMsgFn + , getWSASendMsg + , getWSARecvMsg + , mkSendMsgSafe + , mkRecvMsgSafe +#if __IO_MANAGER_WINIO__ >= 2 + , mkSendMsgUnsafe + , mkRecvMsgUnsafe +#endif + ) where + +#include "HsNetDef.h" + +import Control.Concurrent.STM +import Control.Exception (onException) +import System.IO.Unsafe (unsafePerformIO) + +import Network.Socket.Imports +import Network.Socket.Internal (throwSocketError) +import Network.Socket.Types (CSocket) + +type DWORD = Word32 +type LPDWORD = Ptr DWORD + +-- | Cache state of a lazily loaded extension function. +data Loaded a = Unloaded | Loading | Loaded a + +-- | Look an extension function up once and cache it. A concurrent +-- caller waits for the in-flight lookup instead of issuing a redundant +-- @WSAIoctl@. On failure the cache is reset so that a later call, which +-- may have a usable socket, can try again. +loadExtensionFunction + :: TVar (Loaded (FunPtr a)) + -- ^ Cache shared by all sockets. + -> (CSocket -> IO (FunPtr a)) + -- ^ The C side loader, returning a null pointer on failure. + -> String + -- ^ Function name, for the error message. + -> CSocket + -> IO (FunPtr a) +loadExtensionFunction var load fname s = do + mfp <- atomically $ do + st <- readTVar var + case st of + Unloaded -> do + writeTVar var Loading + return Nothing + Loading -> retry + Loaded fp -> return $ Just fp + case mfp of + Just fp -> return fp + Nothing -> load' `onException` atomically (writeTVar var Unloaded) + where + load' = do + fp <- load s + when (fp == nullFunPtr) $ + throwSocketError $ "Network.Socket: cannot load " ++ fname + atomically $ writeTVar var $ Loaded fp + return fp + +-- The message header is kept as @Ptr ()@ so that one cache serves every +-- socket address type; callers cast it. +type WSASendMsgFn = CSocket -> Ptr () -> DWORD -> LPDWORD -> Ptr () -> Ptr () -> IO CInt +type WSARecvMsgFn = CSocket -> Ptr () -> LPDWORD -> Ptr () -> Ptr () -> IO CInt + +foreign import ccall unsafe "loadWSASendMsg" + c_loadWSASendMsg :: CSocket -> IO (FunPtr WSASendMsgFn) +foreign import ccall unsafe "loadWSARecvMsg" + c_loadWSARecvMsg :: CSocket -> IO (FunPtr WSARecvMsgFn) + +-- | MIO blocks inside the call and so needs a safe wrapper. +foreign import CALLCONV SAFE_ON_WIN "dynamic" + mkSendMsgSafe :: FunPtr WSASendMsgFn -> WSASendMsgFn +foreign import CALLCONV SAFE_ON_WIN "dynamic" + mkRecvMsgSafe :: FunPtr WSARecvMsgFn -> WSARecvMsgFn + +#if __IO_MANAGER_WINIO__ >= 2 +-- | WinIO returns immediately, so the unsafe wrapper is the right one. +foreign import CALLCONV unsafe "dynamic" + mkSendMsgUnsafe :: FunPtr WSASendMsgFn -> WSASendMsgFn +foreign import CALLCONV unsafe "dynamic" + mkRecvMsgUnsafe :: FunPtr WSARecvMsgFn -> WSARecvMsgFn +#endif + +sendMsgCache :: TVar (Loaded (FunPtr WSASendMsgFn)) +sendMsgCache = unsafePerformIO $ newTVarIO Unloaded +{-# NOINLINE sendMsgCache #-} + +recvMsgCache :: TVar (Loaded (FunPtr WSARecvMsgFn)) +recvMsgCache = unsafePerformIO $ newTVarIO Unloaded +{-# NOINLINE recvMsgCache #-} + +getWSASendMsg :: CSocket -> IO (FunPtr WSASendMsgFn) +getWSASendMsg = loadExtensionFunction sendMsgCache c_loadWSASendMsg "WSASendMsg" + +getWSARecvMsg :: CSocket -> IO (FunPtr WSARecvMsgFn) +getWSARecvMsg = loadExtensionFunction recvMsgCache c_loadWSARecvMsg "WSARecvMsg" diff --git a/cbits/cmsg.c b/cbits/cmsg.c index 15b17cd8..41eade3e 100644 --- a/cbits/cmsg.c +++ b/cbits/cmsg.c @@ -23,63 +23,37 @@ unsigned int cmsg_len(unsigned int l) { return (WSA_CMSG_LEN(l)); } -static LPFN_WSASENDMSG ptr_SendMsg; -static LPFN_WSARECVMSG ptr_RecvMsg; -/* GUIDS to lookup WSASend/RecvMsg */ +/* GUIDs to look up WSASendMsg/WSARecvMsg. Winsock does not export them + as ordinary symbols; they have to be fetched from a live socket. The + caching lives in Haskell (Network.Socket.Win32.Load) so that the call + itself can be issued asynchronously from there. */ static GUID WSARecvMsgGUID = WSAID_WSARECVMSG; static GUID WSASendMsgGUID = WSAID_WSASENDMSG; -int WINAPI -WSASendMsg (SOCKET s, LPWSAMSG lpMsg, DWORD flags, - LPDWORD lpdwNumberOfBytesRecvd, LPWSAOVERLAPPED lpOverlapped, - LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine) { - - if (!ptr_SendMsg) { - DWORD len; - if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER, - &WSASendMsgGUID, sizeof(WSASendMsgGUID), &ptr_SendMsg, - /* Sadly we can't perform this async for now as C code can't wait for - completion events from the Haskell RTS. This needs to be moved to - Haskell on a re-designed async Network. */ - sizeof(ptr_SendMsg), &len, NULL, NULL) != 0) - return -1; - } - - return ptr_SendMsg (s, lpMsg, flags, lpdwNumberOfBytesRecvd, lpOverlapped, - lpCompletionRoutine); +LPFN_WSASENDMSG loadWSASendMsg (SOCKET s) { + LPFN_WSASENDMSG fn = NULL; + DWORD len; + + if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER, + &WSASendMsgGUID, sizeof(WSASendMsgGUID), &fn, sizeof(fn), + &len, NULL, NULL) != 0) + return NULL; + + return fn; } -/** - * WSARecvMsg function - */ -int WINAPI -WSARecvMsg (SOCKET s, LPWSAMSG lpMsg, LPDWORD lpdwNumberOfBytesRecvd, - LPWSAOVERLAPPED lpOverlapped, - LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine) { - - if (!ptr_RecvMsg) { - DWORD len; - if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER, - &WSARecvMsgGUID, sizeof(WSARecvMsgGUID), &ptr_RecvMsg, - /* Sadly we can't perform this async for now as C code can't wait for - completion events from the Haskell RTS. This needs to be moved to - Haskell on a re-designed async Network. */ - sizeof(ptr_RecvMsg), &len, NULL, NULL) != 0) - return -1; - } - - int res = ptr_RecvMsg (s, lpMsg, lpdwNumberOfBytesRecvd, lpOverlapped, - lpCompletionRoutine); - - /* If the msg was truncated then this pointer can be garbage. */ - if (res == SOCKET_ERROR && GetLastError () == WSAEMSGSIZE) - { - lpMsg->Control.len = 0; - lpMsg->Control.buf = NULL; - } - - return res; +LPFN_WSARECVMSG loadWSARecvMsg (SOCKET s) { + LPFN_WSARECVMSG fn = NULL; + DWORD len; + + if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER, + &WSARecvMsgGUID, sizeof(WSARecvMsgGUID), &fn, sizeof(fn), + &len, NULL, NULL) != 0) + return NULL; + + return fn; } + #else struct cmsghdr *cmsg_firsthdr(struct msghdr *mhdr) { return (CMSG_FIRSTHDR(mhdr)); diff --git a/include/HsNet.h b/include/HsNet.h index 6531302f..355ee8d6 100644 --- a/include/HsNet.h +++ b/include/HsNet.h @@ -101,18 +101,16 @@ extern unsigned int cmsg_len(unsigned int l); /** - * WSASendMsg function + * Fetch the WSASendMsg extension function, or NULL on failure. */ -extern WINAPI int -WSASendMsg (SOCKET, LPWSAMSG, DWORD, LPDWORD, - LPWSAOVERLAPPED, LPWSAOVERLAPPED_COMPLETION_ROUTINE); +extern LPFN_WSASENDMSG +loadWSASendMsg (SOCKET); /** - * WSARecvMsg function + * Fetch the WSARecvMsg extension function, or NULL on failure. */ -extern WINAPI int -WSARecvMsg (SOCKET, LPWSAMSG, LPDWORD, - LPWSAOVERLAPPED, LPWSAOVERLAPPED_COMPLETION_ROUTINE); +extern LPFN_WSARECVMSG +loadWSARecvMsg (SOCKET); #else /* _WIN32 */ extern int sendFd(int sock, int outfd); diff --git a/network.cabal b/network.cabal index 8a91859c..b8fd210c 100644 --- a/network.cabal +++ b/network.cabal @@ -162,6 +162,7 @@ library Network.Socket.Win32.Cmsg Network.Socket.Win32.CmsgHdr Network.Socket.Win32.HostName + Network.Socket.Win32.Load Network.Socket.Win32.WSABuf Network.Socket.Win32.MsgHdr From c22363ac6ddca71cd47bb1e40ed89f89a7268ea3 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 21 Sep 2026 15:59:47 +0900 Subject: [PATCH 2/4] winio: do not shortcut a synchronous recv completion recvBufFromWinIO, recvBufWinIO and recvBufMsgWinIO returned CbDone Nothing when WSARecv/WSARecvFrom/WSARecvMsg completed synchronously. An overlapped socket still queues a completion packet in that case, and withOverlappedEx answers CbDone Nothing by trying getOverlappedResult with bWait = False and, when that yields nothing, reading the OVERLAPPED structure directly. If the packet has not landed yet the caller is handed 0 bytes, which reads as EOF: getContents returned "" instead of the data in 13 of 20 runs of the test suite under --io-manager=native. Return CbPending instead, as the three send paths already do, and let the I/O manager resolve the completion with a blocking getOverlappedResult. 0 of 20 runs fail afterwards; MIO is unaffected. Co-Authored-By: Claude Opus 5 (1M context) --- Network/Socket/Buffer.hsc | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/Network/Socket/Buffer.hsc b/Network/Socket/Buffer.hsc index 240c192e..ef95d190 100644 --- a/Network/Socket/Buffer.hsc +++ b/Network/Socket/Buffer.hsc @@ -252,7 +252,12 @@ recvBufFromWinIO s ptr nbytes = -- would hang forever). err <- c_WSAGetLastError if ret == 0 - then return $ Mgr.CbDone Nothing + -- An overlapped socket queues a completion packet even when + -- the call succeeds synchronously, so let the I/O manager + -- resolve it. CbDone Nothing makes it read an OVERLAPPED + -- that may not be filled in yet, which surfaces as a + -- spurious EOF. + then return Mgr.CbPending else if err == _ERROR_IO_PENDING then return Mgr.CbPending else return $ Mgr.CbError (fromIntegral err) @@ -329,7 +334,12 @@ recvBufWinIO s ptr nbytes = withFdSocket s $ \sock -> -- would hang forever). err <- c_WSAGetLastError if ret == 0 - then return $ Mgr.CbDone Nothing + -- An overlapped socket queues a completion packet even when + -- the call succeeds synchronously, so let the I/O manager + -- resolve it. CbDone Nothing makes it read an OVERLAPPED + -- that may not be filled in yet, which surfaces as a + -- spurious EOF. + then return Mgr.CbPending else if err == _ERROR_IO_PENDING then return Mgr.CbPending else return $ Mgr.CbError (fromIntegral err) @@ -597,7 +607,12 @@ recvBufMsgWinIO fd msgHdrPtr = do -- would hang forever). err <- c_WSAGetLastError if ret == 0 - then return $ Mgr.CbDone Nothing + -- An overlapped socket queues a completion packet even when + -- the call succeeds synchronously, so let the I/O manager + -- resolve it. CbDone Nothing makes it read an OVERLAPPED + -- that may not be filled in yet, which surfaces as a + -- spurious EOF. + then return Mgr.CbPending else if err == _ERROR_IO_PENDING then return Mgr.CbPending else return $ Mgr.CbError (fromIntegral err) From 0963a1ffd030b8900d21e4f14cbcf9e7e4287f4f Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 21 Sep 2026 16:24:45 +0900 Subject: [PATCH 3/4] changelog --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index cb6f1ae5..c937616f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,9 @@ [#621](https://github.com/haskell/network/pull/621) * Fixing the misspelled WSAEACCES error description on Windows. [#622](https://github.com/haskell/network/pull/622) +* WINIO: loading WSASendMsg and WSARecvMsg from Haskell so that they can be + issued asynchronously. +* WINIO: fixing a spurious EOF when a recv completes synchronously. ## Version 3.2.8.0 From 52a7c9847eeb5d2dc364149d88ca6acd4042216b Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 21 Sep 2026 16:36:12 +0900 Subject: [PATCH 4/4] changelog: add PR link --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c937616f..bab5edf4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,7 +15,9 @@ [#622](https://github.com/haskell/network/pull/622) * WINIO: loading WSASendMsg and WSARecvMsg from Haskell so that they can be issued asynchronously. + [#626](https://github.com/haskell/network/pull/626) * WINIO: fixing a spurious EOF when a recv completes synchronously. + [#626](https://github.com/haskell/network/pull/626) ## Version 3.2.8.0