diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # CHANGELOG for network +## Version 3.2.13.0 + +* Give Winsock errors the IOErrorType of their errno + [#632](https://github.com/haskell/network/pull/632) +* Regenerate configure, which 3.2.12.0 shipped stale, producing an invalid + network.buildinfo on Windows with GHC 9.14.2 + [#633](https://github.com/haskell/network/issues/633) + ## Version 3.2.12.0 * Add unsafeGracefulClose and recvMsgWith diff --git a/Network/Socket/Cbits.hsc b/Network/Socket/Cbits.hsc --- a/Network/Socket/Cbits.hsc +++ b/Network/Socket/Cbits.hsc @@ -3,6 +3,9 @@ #include "HsNet.h" import Network.Socket.Imports +#if defined(mingw32_HOST_OS) +import GHC.IO.Exception (IOErrorType (..)) +#endif -- | This is the value of SOMAXCONN, typically 128. -- 128 is good enough for normal network servers but @@ -41,6 +44,51 @@ wsaEHOSTUNREACH = #const WSAEHOSTUNREACH wsaENOPROTOOPT :: CInt wsaENOPROTOOPT = #const WSAENOPROTOOPT +-- | The 'IOErrorType' which 'Foreign.C.Error.errnoToIOError' gives the +-- errno of the same name. WSAEINTR stays 'OtherError': on Windows it +-- is what closesocket gives a blocked call, not an interrupt. +winsockErrorType :: CInt -> IOErrorType +winsockErrorType rc = case rc of + #{const WSAEACCES} -> PermissionDenied + #{const WSAEADDRINUSE} -> ResourceBusy + #{const WSAEADDRNOTAVAIL} -> UnsupportedOperation + #{const WSAEAFNOSUPPORT} -> UnsupportedOperation + #{const WSAEALREADY} -> AlreadyExists + #{const WSAEBADF} -> InvalidArgument + #{const WSAECONNREFUSED} -> NoSuchThing + #{const WSAECONNRESET} -> ResourceVanished + #{const WSAEDESTADDRREQ} -> InvalidArgument + #{const WSAEDQUOT} -> PermissionDenied + #{const WSAEHOSTDOWN} -> NoSuchThing + #{const WSAEHOSTUNREACH} -> NoSuchThing + #{const WSAEINPROGRESS} -> AlreadyExists + #{const WSAEINVAL} -> InvalidArgument + #{const WSAEISCONN} -> AlreadyExists + #{const WSAELOOP} -> InvalidArgument + #{const WSAEMFILE} -> ResourceExhausted + #{const WSAEMSGSIZE} -> ResourceExhausted + #{const WSAENAMETOOLONG} -> InvalidArgument + #{const WSAENETDOWN} -> ResourceVanished + #{const WSAENETRESET} -> ResourceVanished + #{const WSAENETUNREACH} -> NoSuchThing + #{const WSAENOBUFS} -> ResourceExhausted + #{const WSAENOPROTOOPT} -> UnsupportedOperation + #{const WSAENOTCONN} -> InvalidArgument + #{const WSAENOTEMPTY} -> UnsatisfiedConstraints + #{const WSAENOTSOCK} -> InvalidArgument + #{const WSAEOPNOTSUPP} -> UnsupportedOperation + #{const WSAEPFNOSUPPORT} -> UnsupportedOperation + #{const WSAEPROCLIM} -> PermissionDenied + #{const WSAEPROTONOSUPPORT} -> ProtocolError + #{const WSAEPROTOTYPE} -> ProtocolError + #{const WSAEREMOTE} -> IllegalOperation + #{const WSAESHUTDOWN} -> IllegalOperation + #{const WSAESOCKTNOSUPPORT} -> UnsupportedOperation + #{const WSAESTALE} -> ResourceVanished + #{const WSAETIMEDOUT} -> TimeExpired + #{const WSAETOOMANYREFS} -> ResourceExhausted + #{const WSAEUSERS} -> ResourceExhausted + _ -> OtherError #else fGetFd :: CInt fGetFd = #const F_GETFD diff --git a/Network/Socket/Internal.hs b/Network/Socket/Internal.hs --- a/Network/Socket/Internal.hs +++ b/Network/Socket/Internal.hs @@ -94,14 +94,15 @@ -- | Like 'throwSocketError', but the error code is supplied as an argument. -- -- On Windows the code is a Winsock error code rather than an errno. It --- is kept in 'ioe_errno' all the same: Winsock reports every error as --- 'OtherError', so the code is the only thing which tells them apart. +-- is kept in 'ioe_errno' all the same, and the error type is the one +-- the errno of the same name has elsewhere. throwSocketErrorCode :: String -> CInt -> IO a #if defined(mingw32_HOST_OS) throwSocketErrorCode name rc = do pstr <- c_getWSError rc str <- peekCString pstr - let ioe = (mkIOError OtherError name Nothing Nothing){ioe_errno = Just rc} + let typ = winsockErrorType rc + ioe = (mkIOError typ name Nothing Nothing){ioe_errno = Just rc} ioError (ioeSetErrorString ioe str) #else throwSocketErrorCode loc errno = diff --git a/Network/Socket/Wait.hs b/Network/Socket/Wait.hs --- a/Network/Socket/Wait.hs +++ b/Network/Socket/Wait.hs @@ -363,8 +363,9 @@ -- earlier send of its own came back as an ICMP port unreachable. -- -- POSIX gives it as @ECONNREFUSED@ and Winsock as @WSAECONNRESET@, so --- the error type differs (@NoSuchThing@ and @OtherError@); this reads --- the code instead. Only a connected socket hears it on any platform. +-- the error type differs (@NoSuchThing@ and @ResourceVanished@); this +-- reads the code instead. Only a connected socket hears it on any +-- platform. -- -- @since 3.2.12.0 isPortUnreachableError :: E.IOException -> Bool diff --git a/configure b/configure --- a/configure +++ b/configure @@ -685,8 +685,6 @@ ac_user_opts=' enable_option_checking with_cc -with_compiler -with_hc ' ac_precious_vars='build_alias host_alias @@ -1318,7 +1316,6 @@ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) C compiler -Haskell compiler Some influential environment variables: CC C compiler command @@ -3930,25 +3927,6 @@ -# Check whether --with-compiler was given. -if test ${with_compiler+y} -then : - withval=$with_compiler; HC=$withval -fi - - -# Check whether --with-hc was given. -if test ${with_hc+y} -then : - withval=$with_hc; HC=$withval -fi - -if test -z "$HC" -then : - HC=ghc -fi - - { printf '%s\n' "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5 printf %s "checking for an ANSI C-conforming const... " >&6; } if test ${ac_cv_c_const+y} @@ -4449,45 +4427,6 @@ { printf '%s\n' "$as_me:${as_lineno-$LINENO}: creating ./network.buildinfo" >&5 printf '%s\n' "$as_me: creating ./network.buildinfo" >&6;} echo "install-includes: HsNetworkConfig.h" > network.buildinfo - -WINIO_GHC_OPTIONS= -{ printf '%s\n' "$as_me:${as_lineno-$LINENO}: checking whether to use native Windows I/O manager RTS option" >&5 -printf %s "checking whether to use native Windows I/O manager RTS option... " >&6; } -case "$host_os" in -mingw*) - cat > conftest_ghc_cpp.hs </dev/null 2>&1; then - { printf '%s\n' "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf '%s\n' "yes" >&6; } - WINIO_GHC_OPTIONS="-with-rtsopts=--io-manager=native" - else - { printf '%s\n' "$as_me:${as_lineno-$LINENO}: result: no, $HC does not define __IO_MANAGER_WINIO__ >= 2" >&5 -printf '%s\n' "no, $HC does not define __IO_MANAGER_WINIO__ >= 2" >&6; } - fi - rm -f conftest_ghc_cpp.hi conftest_ghc_cpp.hs conftest_ghc_cpp.o - ;; -*) - { printf '%s\n' "$as_me:${as_lineno-$LINENO}: result: no, not Windows" >&5 -printf '%s\n' "no, not Windows" >&6; } - ;; -esac - -if test -n "$WINIO_GHC_OPTIONS" -then : - cat >> network.buildinfo <confcache <<\_ACEOF # This file is a shell script that caches the results of configure diff --git a/network.cabal b/network.cabal --- a/network.cabal +++ b/network.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: network -version: 3.2.12.0 +version: 3.2.13.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto, Tamar Christina diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs --- a/tests/Network/SocketSpec.hs +++ b/tests/Network/SocketSpec.hs @@ -19,7 +19,8 @@ import Network.Socket.ByteString import Network.Test.Common import System.Mem (performGC) -import System.IO.Error (tryIOError) +import GHC.IO.Exception (IOErrorType (ResourceVanished)) +import System.IO.Error (ioeGetErrorType, tryIOError) import System.IO.Temp (withSystemTempDirectory) import System.Posix.Types (Fd(..)) import Foreign.C.Types () @@ -377,6 +378,15 @@ `shouldThrow` isPortUnreachableError it "is heard by a connected one through recvMsg" $ bounceWith recvMsg' connectSend `shouldThrow` isPortUnreachableError + + describe "a connection the peer resets" $ do + it "is reported as ResourceVanished" $ do + let server sock = setSockOpt sock Linger (StructLinger 1 0) + -- Plain recv on Windows reads through GHC's IO manager, + -- which does not go by the Winsock code. + client sock = recvWith sock 1024 retry `shouldThrow` isVanished + isVanished e = ioeGetErrorType e == ResourceVanished + tcpTest client server describe "gracefulClose" $ do it "does not send TCP RST back" $ do