diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +0.5.2.0 Lars Petersen 2015-07-08 + + * Don't set `msgNoSignal` automatically with `send` and `sendTo`. This implicit behaviour is a bad design decision. The implications of this change are rather limited. The behaviour/correctness of an application is only affected if it hooked SIGPIPE. GHC's RTS by default ignores SIGPIPE since #1619. You're still advised to adapt your applications to use `msgNoSignal` explicitly when writing on stream oriented sockets. Otherwise the RTS gets unnecessarily interrupted. This is harmless, but annoying and not desired when developing high-performance applications. + * Define `msgNoSignal` as 0 if not available and documented this behaviour. + * Added new exception value `ePipe`. + 0.5.1.0 Lars Petersen 2015-06-22 * Exposed `unsafeGetSocketOption` and `unsafeSetSocketOption`. diff --git a/CONTRIBUTORS.txt b/CONTRIBUTORS.txt --- a/CONTRIBUTORS.txt +++ b/CONTRIBUTORS.txt @@ -1,2 +1,3 @@ Michael Fox (reported issue #7) Bryan O'Sullivan (legitimately criticised the bizarre naming) +Alex Högy (reported the MSG_NOSIGNAL issue on OSX) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -41,7 +41,7 @@ #### MacOS -Unknown. Please report if you have a Mac. +Working. #### Windows diff --git a/platform/linux/include/hs_socket.h b/platform/linux/include/hs_socket.h --- a/platform/linux/include/hs_socket.h +++ b/platform/linux/include/hs_socket.h @@ -27,3 +27,13 @@ #define SEALREADY EALREADY #define SEISCONN EISCONN #define SETIMEDOUT ETIMEDOUT +#define SEPIPE EPIPE + +/* MSG_NOSIGNAL might not be available (i.e. on MacOSX and Solaris). + * In this case it gets defined as 0. This is relatively + * safe to do as the GHC runtime ignores signals that aren't hooked. + * The application won't die, but might be unncessarily interrupted. + */ +#ifndef MSG_NOSIGNAL +#define MSG_NOSIGNAL 0 +#endif diff --git a/platform/win32/include/hs_socket.h b/platform/win32/include/hs_socket.h --- a/platform/win32/include/hs_socket.h +++ b/platform/win32/include/hs_socket.h @@ -125,3 +125,4 @@ #define SEALREADY WSAEALREADY #define SEISCONN WSAEISCONN #define SETIMEDOUT WSAETIMEDOUT +#define SEPIPE WSAECONNABORTED diff --git a/socket.cabal b/socket.cabal --- a/socket.cabal +++ b/socket.cabal @@ -1,14 +1,10 @@ name: socket -version: 0.5.1.0 +version: 0.5.2.0 synopsis: A portable and extensible sockets library. description: This library is a minimal and platform-independant interface for BSD style networking. . - The following is a list of known extension packages: - . - - https://hackage.haskell.org/package/socket-sctp - . Also see README.md for details. license: MIT @@ -142,6 +138,16 @@ main-is: IPV6_V6ONLY.hs type: exitcode-stdio-1.0 default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , bytestring < 0.11 + , socket + , async + +test-suite EPIPE + hs-source-dirs: tests + default-language: Haskell2010 + main-is: EPIPE.hs + type: exitcode-stdio-1.0 build-depends: base >= 4.7 && < 5 , bytestring < 0.11 , socket diff --git a/src/System/Socket.hsc b/src/System/Socket.hsc --- a/src/System/Socket.hsc +++ b/src/System/Socket.hsc @@ -31,11 +31,11 @@ -- > forever $ do -- > (peer,_) <- accept s -- > forkIO $ do --- > sendAll peer "Hello world!" mempty `finally` close peer +-- > sendAll peer "Hello world!" msgNoSignal `finally` close peer -- > where -- > addr = SocketAddressInet Inet.loopback 8080 -- --- This downloads the [Haskell website](http://www.haskell.org) and prints it to stdout. +-- This downloads the Haskell website and prints it to stdout. -- Note the use of IPv4-mapped `Inet6` addresses: This will work -- even if you don't have IPv6 connectivity yet and is the preferred method -- when writing new applications. @@ -51,7 +51,7 @@ -- > main = do -- > withConnectedSocket "www.haskell.org" "80" (aiAll `mappend` aiV4Mapped) $ \sock-> do -- > let _ = sock :: Socket Inet6 Stream TCP --- > sendAll sock "GET / HTTP/1.0\r\nHost: www.haskell.org\r\n\r\n" mempty +-- > sendAll sock "GET / HTTP/1.0\r\nHost: www.haskell.org\r\n\r\n" msgNoSignal -- > x <- receiveAll sock (1024*1024*1024) mempty -- > B.putStr x ----------------------------------------------------------------------------- @@ -438,7 +438,6 @@ -- `SequentialPacket` sockets certain assurances on atomicity exist and `eAgain` or -- `eWouldBlock` are returned until the whole message would fit -- into the send buffer. --- - The flag `msgNoSignal` is set to supress signals which are pointless. -- - This operation throws `SocketException`s. Consult @man 3p send@ for -- details and specific @errno@s. -- - `eAgain`, `eWouldBlock` and `eInterrupted` and handled internally and won't diff --git a/src/System/Socket/Internal/Exception.hsc b/src/System/Socket/Internal/Exception.hsc --- a/src/System/Socket/Internal/Exception.hsc +++ b/src/System/Socket/Internal/Exception.hsc @@ -16,7 +16,7 @@ instance Show SocketException where show e@(SocketException i) | e == eOk = "eOk" - | e == eInterrupted = "eInterrupted" + | e == eInterrupted = "eInterrupted" | e == eAgain = "eAgain" | e == eWouldBlock = "eWouldBlock" | e == eBadFileDescriptor = "eBadFileDescriptor" @@ -29,6 +29,7 @@ | e == eAlready = "eAlready" | e == eIsConnected = "eIsConnected" | e == eTimedOut = "eTimedOut" + | e == ePipe = "ePipe" | otherwise = "SocketException " ++ show i eOk :: SocketException @@ -72,3 +73,6 @@ eTimedOut :: SocketException eTimedOut = SocketException (#const SETIMEDOUT) + +ePipe :: SocketException +ePipe = SocketException (#const SEPIPE) diff --git a/src/System/Socket/Internal/Message.hsc b/src/System/Socket/Internal/Message.hsc --- a/src/System/Socket/Internal/Message.hsc +++ b/src/System/Socket/Internal/Message.hsc @@ -55,6 +55,28 @@ msgEndOfRecord = MessageFlags (#const MSG_EOR) -- | @MSG_NOSIGNAL@ +-- +-- Suppresses the generation of @PIPE@ signals when writing to a socket +-- that is no longer connected. +-- +-- Although this flag is POSIX, it is not available on all platforms. Try +-- +-- > msgNoSignal /= mempty +-- +-- in order to check whether this flag is defined on a certain platform. +-- It is safe to just use this constant even if it might not have effect +-- on a certain target platform. The platform independence of this flag +-- is therefore fulfilled to some extent. +-- +-- Some more explanation on the platform specific behaviour: +-- +-- - Linux defines and supports `MSG_NOSIGNAL` and properly suppresses +-- the generation of broken pipe-related signals. +-- - Windows does not define it, but does not generate signals either. +-- - OSX does not define it, but generates @PIPE@ signals. The GHC runtime +-- ignores them if you don't hook them explicitly. The +-- non-portable socket option `SO_NOSIGPIPE` may be used disable signals +-- on a per-socket basis. msgNoSignal :: MessageFlags msgNoSignal = MessageFlags (#const MSG_NOSIGNAL) diff --git a/src/System/Socket/Unsafe.hsc b/src/System/Socket/Unsafe.hsc --- a/src/System/Socket/Unsafe.hsc +++ b/src/System/Socket/Unsafe.hsc @@ -44,11 +44,11 @@ unsafeSend :: Socket a t p -> Ptr a -> CSize -> MessageFlags -> IO CInt unsafeSend s bufPtr bufSize flags = do - tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_send fd bufPtr bufSize (flags `mappend` msgNoSignal) ) + tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_send fd bufPtr bufSize flags ) unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> CInt -> IO CInt unsafeSendTo s bufPtr bufSize flags addrPtr addrSize = do - tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNoSignal) addrPtr addrSize) + tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) flags addrPtr addrSize) unsafeReceive :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt unsafeReceive s bufPtr bufSize flags = diff --git a/tests/EPIPE.hs b/tests/EPIPE.hs new file mode 100644 --- /dev/null +++ b/tests/EPIPE.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Control.Monad +import Control.Exception +import Control.Concurrent +import Control.Concurrent.Async + +import Data.Int +import Data.Monoid +import qualified Data.ByteString.Lazy as LBS + +import System.Socket +import System.Socket.Family.Inet as Inet + +main :: IO () +main = do + bracket + ( do server <- socket `onException` print "E01" :: IO (Socket Inet Stream TCP) + client <- socket `onException` print "E02" :: IO (Socket Inet Stream TCP) + return (server, client) + ) + (\(server,client)-> do + close server `onException` print "E03" + close client `onException` print "E04" + ) + (\(server,client)-> do + bind server addr `onException` print "E06" + listen server 5 `onException` print "E07" + + connect client addr `onException` print "E08" + (peerSock, _) <- accept server `onException` print "E09" + _ <- send client "This should be received." mempty `onException` print "E10" + _ <- receive peerSock 4096 mempty `onException` print "E11" + close peerSock `onException` print "E12" + + threadDelay 1000000 + + e1 <- try $ send client "This might fail." mempty `onException` print "E13" + case e1 of + Right _ -> return () + Left e -> if e == ePipe + then return () + else throwIO e `onException` print "E14" + + threadDelay 1000000 + + e2 <- try $ send client "This should fail." mempty `onException` print "E15" + case e2 of + Right _ -> error "E16" + Left e -> if e == ePipe + then return () + else throwIO e `onException` print "E17" + ) + where + addr = SocketAddressInet Inet.loopback 7777