network 3.0.1.1 → 3.1.0.0
raw patch · 17 files changed
+173/−110 lines, 17 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.Socket: withFdSocket :: Socket -> (CInt -> IO r) -> IO r
Files
- CHANGELOG.md +15/−0
- Network/Socket.hs +1/−0
- Network/Socket/Buffer.hs +23/−23
- Network/Socket/ByteString/IO.hsc +11/−12
- Network/Socket/ByteString/Lazy/Posix.hs +1/−2
- Network/Socket/Internal.hs +6/−6
- Network/Socket/Name.hs +2/−4
- Network/Socket/Options.hsc +8/−10
- Network/Socket/Shutdown.hs +1/−2
- Network/Socket/Syscall.hs +11/−15
- Network/Socket/Types.hsc +35/−2
- Network/Socket/Unix.hsc +8/−9
- configure +9/−9
- configure.ac +1/−1
- network.cabal +1/−1
- tests/Network/SocketSpec.hs +28/−2
- tests/Network/Test/Common.hs +12/−12
CHANGELOG.md view
@@ -1,3 +1,11 @@+## Version 3.1.0.0++* Making GC of socket safer.+ [#399](https://github.com/haskell/network/pull/399)+* Deprecating fdSocket. Use withFdSocket instead to ensure+ that sockets are GCed in proper time.+ [#399](https://github.com/haskell/network/pull/399)+ ## Version 3.0.1.1 * Fix blocking `if_nametoindex` errors on Windows@@ -42,6 +50,13 @@ * All APIs are available on any platforms. * Build system is simplified. * Bug fixes.++## Version 2.8.0.1++* Eensuring that accept returns a correct sockaddr for unix domain.+ [#400](https://github.com/haskell/network/pull/400)+* Avoid out of bounds writes in pokeSockAddr.+ [#400](https://github.com/haskell/network/pull/400) ## Version 2.8.0.0
Network/Socket.hs view
@@ -136,6 +136,7 @@ , Socket , socket , fdSocket+ , withFdSocket , mkSocket , socketToHandle -- ** Types of Socket
Network/Socket/Buffer.hs view
@@ -35,12 +35,12 @@ -> IO Int -- Number of Bytes sent sendBufTo s ptr nbytes sa = withSocketAddress sa $ \p_sa siz -> fromIntegral <$> do- fd <- fdSocket s- let sz = fromIntegral siz- n = fromIntegral nbytes- flags = 0- throwSocketErrorWaitWrite s "Network.Socket.sendBufTo" $- c_sendto fd ptr n flags p_sa sz+ withFdSocket s $ \fd -> do+ let sz = fromIntegral siz+ n = fromIntegral nbytes+ flags = 0+ throwSocketErrorWaitWrite s "Network.Socket.sendBufTo" $+ c_sendto fd ptr n flags p_sa sz #if defined(mingw32_HOST_OS) socket2FD :: Socket -> IO FD@@ -68,11 +68,11 @@ throwSocketErrorIfMinus1Retry "Network.Socket.sendBuf" $ writeRawBufferPtr "Network.Socket.sendBuf" fd (castPtr str) 0 clen #else- fd <- fdSocket s- let flags = 0- clen = fromIntegral len- throwSocketErrorWaitWrite s "Network.Socket.sendBuf" $- c_send fd str clen flags+ withFdSocket s $ \fd -> do+ let flags = 0+ clen = fromIntegral len+ throwSocketErrorWaitWrite s "Network.Socket.sendBuf" $+ c_send fd str clen flags #endif -- | Receive data from the socket, writing it into buffer instead of@@ -90,16 +90,16 @@ recvBufFrom :: SocketAddress sa => Socket -> Ptr a -> Int -> IO (Int, sa) recvBufFrom s ptr nbytes | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBufFrom")- | otherwise = withNewSocketAddress $ \ptr_sa sz -> alloca $ \ptr_len -> do- fd <- fdSocket s- poke ptr_len (fromIntegral sz)- let cnbytes = fromIntegral nbytes- flags = 0- len <- throwSocketErrorWaitRead s "Network.Socket.recvBufFrom" $- c_recvfrom fd ptr cnbytes flags ptr_sa ptr_len- sockaddr <- peekSocketAddress ptr_sa- `E.catch` \(E.SomeException _) -> getPeerName s- return (fromIntegral len, sockaddr)+ | otherwise = withNewSocketAddress $ \ptr_sa sz -> alloca $ \ptr_len ->+ withFdSocket s $ \fd -> do+ poke ptr_len (fromIntegral sz)+ let cnbytes = fromIntegral nbytes+ flags = 0+ len <- throwSocketErrorWaitRead s "Network.Socket.recvBufFrom" $+ c_recvfrom fd ptr cnbytes flags ptr_sa ptr_len+ sockaddr <- peekSocketAddress ptr_sa+ `E.catch` \(E.SomeException _) -> getPeerName s+ return (fromIntegral len, sockaddr) -- | Receive data from the socket. The socket must be in a connected -- state. This function may return fewer bytes than specified. If the@@ -124,8 +124,8 @@ len <- throwSocketErrorIfMinus1Retry "Network.Socket.recvBuf" $ readRawBufferPtr "Network.Socket.recvBuf" fd ptr 0 cnbytes #else- fd <- fdSocket s- len <- throwSocketErrorWaitRead s "Network.Socket.recvBuf" $+ len <- withFdSocket s $ \fd ->+ throwSocketErrorWaitRead s "Network.Socket.recvBuf" $ c_recv fd (castPtr ptr) (fromIntegral nbytes) 0{-flags-} #endif return $ fromIntegral len
Network/Socket/ByteString/IO.hsc view
@@ -80,9 +80,8 @@ sendBuf s (castPtr str) len waitWhen0 :: Int -> Socket -> IO ()-waitWhen0 0 s = when rtsSupportsBoundThreads $ do- fd <- fromIntegral <$> fdSocket s- threadWaitWrite fd+waitWhen0 0 s = when rtsSupportsBoundThreads $+ withFdSocket s $ \fd -> threadWaitWrite $ fromIntegral fd waitWhen0 _ _ = return () -- | Send data to the socket. The socket must be connected to a@@ -145,11 +144,11 @@ when (sent >= 0) $ sendMany s $ remainingChunks sent cs where sendManyInner =- fmap fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) -> do- fd <- fdSocket s- let len = fromIntegral $ min iovsLen (#const IOV_MAX)- throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $- c_writev fd iovsPtr len+ fmap fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->+ withFdSocket s $ \fd -> do+ let len = fromIntegral $ min iovsLen (#const IOV_MAX)+ throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $+ c_writev fd iovsPtr len #else sendMany s = sendAll s . B.concat #endif@@ -177,10 +176,10 @@ let msgHdr = MsgHdr addrPtr (fromIntegral addrSize) iovsPtr (fromIntegral iovsLen)- fd <- fdSocket s- with msgHdr $ \msgHdrPtr ->- throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $- c_sendmsg fd msgHdrPtr 0+ withFdSocket s $ \fd ->+ with msgHdr $ \msgHdrPtr ->+ throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $+ c_sendmsg fd msgHdrPtr 0 #else sendManyTo s cs = sendAllTo s (B.concat cs) #endif
Network/Socket/ByteString/Lazy/Posix.hs view
@@ -27,8 +27,7 @@ send s lbs = do let cs = take maxNumChunks (L.toChunks lbs) len = length cs- fd <- fdSocket s- siz <- allocaArray len $ \ptr ->+ siz <- withFdSocket s $ \fd -> allocaArray len $ \ptr -> withPokes cs ptr $ \niovs -> throwSocketErrorWaitWrite s "writev" $ c_writev fd ptr niovs return $ fromIntegral siz
Network/Socket/Internal.hs view
@@ -192,17 +192,17 @@ -- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready, -- and try again. throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a-throwSocketErrorWaitRead s name io = do- fd <- fromIntegral <$> fdSocket s- throwSocketErrorIfMinus1RetryMayBlock name (threadWaitRead fd) io+throwSocketErrorWaitRead s name io = withFdSocket s $ \fd ->+ throwSocketErrorIfMinus1RetryMayBlock name+ (threadWaitRead $ fromIntegral fd) io -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with -- @EWOULDBLOCK@ or similar, wait for the socket to be write-ready, -- and try again. throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a-throwSocketErrorWaitWrite s name io = do- fd <- fromIntegral <$> fdSocket s- throwSocketErrorIfMinus1RetryMayBlock name (threadWaitWrite fd) io+throwSocketErrorWaitWrite s name io = withFdSocket s $ \fd ->+ throwSocketErrorIfMinus1RetryMayBlock name+ (threadWaitWrite $ fromIntegral fd) io -- --------------------------------------------------------------------------- -- WinSock support
Network/Socket/Name.hs view
@@ -19,8 +19,7 @@ getPeerName :: SocketAddress sa => Socket -> IO sa getPeerName s = withNewSocketAddress $ \ptr sz ->- with (fromIntegral sz) $ \int_star -> do- fd <- fdSocket s+ with (fromIntegral sz) $ \int_star -> withFdSocket s $ \fd -> do throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerName" $ c_getpeername fd ptr int_star _sz <- peek int_star@@ -30,8 +29,7 @@ getSocketName :: SocketAddress sa => Socket -> IO sa getSocketName s = withNewSocketAddress $ \ptr sz ->- with (fromIntegral sz) $ \int_star -> do- fd <- fdSocket s+ with (fromIntegral sz) $ \int_star -> withFdSocket s $ \fd -> do throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketName" $ c_getsockname fd ptr int_star peekSocketAddress ptr
Network/Socket/Options.hsc view
@@ -202,18 +202,18 @@ with arg $ \ptr_arg -> void $ do let ptr = ptr_arg :: Ptr StructLinger sz = fromIntegral $ sizeOf (undefined :: StructLinger)- fd <- fdSocket s- throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $- c_setsockopt fd level opt ptr sz+ withFdSocket s $ \fd ->+ throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $+ c_setsockopt fd level opt ptr sz #endif setSocketOption s so v = do (level, opt) <- packSocketOption' "setSocketOption" so with (fromIntegral v) $ \ptr_v -> void $ do let ptr = ptr_v :: Ptr CInt sz = fromIntegral $ sizeOf (undefined :: CInt)- fd <- fdSocket s- throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $- c_setsockopt fd level opt ptr sz+ withFdSocket s $ \fd ->+ throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $+ c_setsockopt fd level opt ptr sz -- | Get a socket option that gives an Int value. -- There is currently no API to get e.g. the timeval socket options@@ -226,8 +226,7 @@ alloca $ \ptr_v -> do let ptr = ptr_v :: Ptr StructLinger sz = fromIntegral $ sizeOf (undefined :: StructLinger)- fd <- fdSocket s- with sz $ \ptr_sz -> do+ withFdSocket s $ \fd -> with sz $ \ptr_sz -> do throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $ c_getsockopt fd level opt ptr ptr_sz StructLinger onoff linger <- peek ptr@@ -238,8 +237,7 @@ alloca $ \ptr_v -> do let ptr = ptr_v :: Ptr CInt sz = fromIntegral $ sizeOf (undefined :: CInt)- fd <- fdSocket s- with sz $ \ptr_sz -> do+ withFdSocket s $ \fd -> with sz $ \ptr_sz -> do throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $ c_getsockopt fd level opt ptr ptr_sz fromIntegral <$> peek ptr
Network/Socket/Shutdown.hs view
@@ -28,8 +28,7 @@ -- 'ShutdownSend', further sends are disallowed. If it is -- 'ShutdownBoth', further sends and receives are disallowed. shutdown :: Socket -> ShutdownCmd -> IO ()-shutdown s stype = void $ do- fd <- fdSocket s+shutdown s stype = void $ withFdSocket s $ \fd -> throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown" $ c_shutdown fd $ sdownCmdToInt stype
Network/Socket/Syscall.hs view
@@ -125,8 +125,7 @@ -- 'defaultPort' is passed then the system assigns the next available -- use port. bind :: SocketAddress sa => Socket -> sa -> IO ()-bind s sa = withSocketAddress sa $ \p_sa siz -> void $ do- fd <- fdSocket s+bind s sa = withSocketAddress sa $ \p_sa siz -> void $ withFdSocket s $ \fd -> do let sz = fromIntegral siz throwSocketErrorIfMinus1Retry "Network.Socket.bind" $ c_bind fd p_sa sz @@ -139,11 +138,10 @@ connectLoop s p_sa (fromIntegral sz) connectLoop :: SocketAddress sa => Socket -> Ptr sa -> CInt -> IO ()-connectLoop s p_sa sz = loop+connectLoop s p_sa sz = withFdSocket s $ \fd -> loop fd where errLoc = "Network.Socket.connect: " ++ show s- loop = do- fd <- fdSocket s+ loop fd = do r <- c_connect fd p_sa sz when (r == -1) $ do #if defined(mingw32_HOST_OS)@@ -151,14 +149,13 @@ #else err <- getErrno case () of- _ | err == eINTR -> loop+ _ | err == eINTR -> loop fd _ | err == eINPROGRESS -> connectBlocked -- _ | err == eAGAIN -> connectBlocked _otherwise -> throwSocketError errLoc connectBlocked = do- fd <- fromIntegral <$> fdSocket s- threadWaitWrite fd+ withFdSocket s $ threadWaitWrite . fromIntegral err <- getSocketOption s SoError when (err /= 0) $ throwSocketErrorCode errLoc (fromIntegral err) #endif@@ -170,8 +167,7 @@ -- specifies the maximum number of queued connections and should be at -- least 1; the maximum value is system-dependent (usually 5). listen :: Socket -> Int -> IO ()-listen s backlog = do- fd <- fdSocket s+listen s backlog = withFdSocket s $ \fd -> do throwSocketErrorIfMinus1Retry_ "Network.Socket.listen" $ c_listen fd $ fromIntegral backlog @@ -191,11 +187,11 @@ -- to the socket on the other end of the connection. -- On Unix, FD_CLOEXEC is set to the new 'Socket'. accept :: SocketAddress sa => Socket -> IO (Socket, sa)-accept listing_sock = withNewSocketAddress $ \new_sa sz -> do- listing_fd <- fdSocket listing_sock- new_sock <- callAccept listing_fd new_sa sz >>= mkSocket- new_addr <- peekSocketAddress new_sa- return (new_sock, new_addr)+accept listing_sock = withNewSocketAddress $ \new_sa sz ->+ withFdSocket listing_sock $ \listing_fd -> do+ new_sock <- callAccept listing_fd new_sa sz >>= mkSocket+ new_addr <- peekSocketAddress new_sa+ return (new_sock, new_addr) where #if defined(mingw32_HOST_OS) callAccept fd sa sz
Network/Socket/Types.hsc view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash, UnboxedTuples #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-}@@ -11,6 +12,7 @@ -- * Socket type Socket , fdSocket+ , withFdSocket , mkSocket , invalidateSocket , close@@ -70,6 +72,10 @@ import GHC.Conc (closeFdWith) import System.Posix.Types (Fd) import Control.DeepSeq (NFData (..))+import GHC.Exts (touch##)+import GHC.IORef (IORef (..))+import GHC.STRef (STRef (..))+import GHC.IO (IO (..)) #if defined(DOMAIN_SOCKET_SUPPORT) import Foreign.Marshal.Array@@ -103,10 +109,37 @@ -- -- In this case, it is safer for Thread A to clone 'Fd' by -- 'System.Posix.IO.dup'. But this would still suffer from--- a rase condition between 'fdSocket' and 'close'.+-- a race condition between 'fdSocket' and 'close'.+--+-- A safer option is to use 'withFdSocket' instead.+{-# DEPRECATED fdSocket "Use withFdSocket instead" #-} fdSocket :: Socket -> IO CInt fdSocket (Socket ref _) = readIORef ref +-- | Get a file descriptor from a 'Socket'. The socket will never+-- be closed automatically before @withFdSocket@ completes, but+-- it may still be closed by an explicit call to 'close' or `close'`,+-- either before or during the call.+--+-- The file descriptor must not be used after @withFdSocket@ returns;+-- see the documentation for 'fdSocket' to see why that is.+withFdSocket :: Socket -> (CInt -> IO r) -> IO r+withFdSocket (Socket ref@(IORef (STRef ref##)) _) f = do+ fd <- readIORef ref+ -- Should we throw an exception if the socket is already invalid?+ -- That will catch some mistakes but certainly not all.++ r <- f fd++ -- Thanks to a GHC issue, this touch# may not be quite guaranteed+ -- to work. There's talk of replacing the touch# primop with one+ -- that works better with the optimizer. But this seems to be the+ -- "right" way to do it for now.++ IO $ \s -> (## touch## ref## s, () ##)+ return r++ -- | Creating a socket from a file descriptor. mkSocket :: CInt -> IO Socket mkSocket fd = do@@ -896,7 +929,7 @@ !FlowInfo -- sin6_flowinfo (ditto) !HostAddress6 -- sin6_addr (ditto) !ScopeID -- sin6_scope_id (ditto)- -- | 'String' must be a list of 0-255 values and its length should be less than 104.+ -- | The path must have less than 104 characters. All of these characters must have code points less than 256. | SockAddrUnix String -- sun_path deriving (Eq, Ord, Typeable)
Network/Socket/Unix.hsc view
@@ -73,8 +73,7 @@ #ifdef HAVE_STRUCT_UCRED_SO_PEERCRED getPeerCred s = do let sz = (#const sizeof(struct ucred))- fd <- fdSocket s- allocaBytes sz $ \ ptr_cr ->+ withFdSocket s $ \fd -> allocaBytes sz $ \ ptr_cr -> with (fromIntegral sz) $ \ ptr_sz -> do _ <- ($) throwSocketErrorIfMinus1Retry "Network.Socket.getPeerCred" $ c_getsockopt fd (#const SOL_SOCKET) (#const SO_PEERCRED) ptr_cr ptr_sz@@ -96,9 +95,9 @@ getPeerEid s = do alloca $ \ ptr_uid -> alloca $ \ ptr_gid -> do- fd <- fdSocket s- throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerEid" $- c_getpeereid fd ptr_uid ptr_gid+ withFdSocket s $ \fd ->+ throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerEid" $+ c_getpeereid fd ptr_uid ptr_gid uid <- peek ptr_uid gid <- peek ptr_gid return (uid, gid)@@ -127,8 +126,8 @@ sendFd :: Socket -> CInt -> IO () #if defined(DOMAIN_SOCKET_SUPPORT) sendFd s outfd = void $ do- fd <- fdSocket s- throwSocketErrorWaitWrite s "Network.Socket.sendFd" $ c_sendFd fd outfd+ withFdSocket s $ \fd ->+ throwSocketErrorWaitWrite s "Network.Socket.sendFd" $ c_sendFd fd outfd foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt #else sendFd _ _ = error "Network.Socket.sendFd"@@ -142,8 +141,8 @@ recvFd :: Socket -> IO CInt #if defined(DOMAIN_SOCKET_SUPPORT) recvFd s = do- fd <- fdSocket s- throwSocketErrorWaitRead s "Network.Socket.recvFd" $ c_recvFd fd+ withFdSocket s $ \fd ->+ throwSocketErrorWaitRead s "Network.Socket.recvFd" $ c_recvFd fd foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt #else recvFd _ = error "Network.Socket.recvFd"
configure view
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.69 for Haskell network package 3.0.0.0.+# Generated by GNU Autoconf 2.69 for Haskell network package 3.1.0.0. # # Report bugs to <libraries@haskell.org>. #@@ -580,8 +580,8 @@ # Identity of this package. PACKAGE_NAME='Haskell network package' PACKAGE_TARNAME='network'-PACKAGE_VERSION='3.0.0.0'-PACKAGE_STRING='Haskell network package 3.0.0.0'+PACKAGE_VERSION='3.1.0.0'+PACKAGE_STRING='Haskell network package 3.1.0.0' PACKAGE_BUGREPORT='libraries@haskell.org' PACKAGE_URL='' @@ -1245,7 +1245,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF-\`configure' configures Haskell network package 3.0.0.0 to adapt to many kinds of systems.+\`configure' configures Haskell network package 3.1.0.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1311,7 +1311,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in- short | recursive ) echo "Configuration of Haskell network package 3.0.0.0:";;+ short | recursive ) echo "Configuration of Haskell network package 3.1.0.0:";; esac cat <<\_ACEOF @@ -1396,7 +1396,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF-Haskell network package configure 3.0.0.0+Haskell network package configure 3.1.0.0 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc.@@ -1922,7 +1922,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by Haskell network package $as_me 3.0.0.0, which was+It was created by Haskell network package $as_me 3.1.0.0, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@@@ -4429,7 +4429,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by Haskell network package $as_me 3.0.0.0, which was+This file was extended by Haskell network package $as_me 3.1.0.0, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES@@ -4482,7 +4482,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\-Haskell network package config.status 3.0.0.0+Haskell network package config.status 3.1.0.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\"
configure.ac view
@@ -1,5 +1,5 @@ AC_INIT([Haskell network package],- [3.0.1.0],+ [3.1.0.0], [libraries@haskell.org], [network])
network.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: network-version: 3.0.1.1+version: 3.1.0.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto, Evan Borden
tests/Network/SocketSpec.hs view
@@ -3,11 +3,13 @@ module Network.SocketSpec (main, spec) where +import Control.Concurrent (threadDelay, forkIO) import Control.Concurrent.MVar (readMVar) import Control.Monad import Network.Socket import Network.Socket.ByteString import Network.Test.Common+import System.Mem (performGC) import Test.Hspec @@ -81,6 +83,8 @@ #if defined(mingw32_HOST_OS) let lpdevname = "loopback_0"+#elif defined(darwin_HOST_OS)+ let lpdevname = "lo0" #else let lpdevname = "lo" #endif@@ -93,6 +97,24 @@ it "converts an index to a name" $ ifIndexToName 1 `shouldReturn` Just lpdevname + describe "socket" $ do+ let gc = do+ threadDelay 100000+ performGC+ connect' = do+ threadDelay 200000+ sock <- socket AF_INET Stream defaultProtocol+ connect sock $ SockAddrInet 6000 $ tupleToHostAddress (127, 0, 0, 1)+ it "should not be GCed while blocking" $ do+ sock <- socket AF_INET Stream defaultProtocol+ setSocketOption sock ReuseAddr 1+ bind sock $ SockAddrInet 6000 $ tupleToHostAddress (127, 0, 0, 1)+ listen sock 1+ _ <- forkIO gc+ _ <- forkIO connect'+ (_sock', addr) <- accept sock+ -- check if an exception is not thrown.+ isSupportedSockAddr addr `shouldBe` True when isUnixDomainSocketAvailable $ do context "unix sockets" $ do@@ -113,6 +135,11 @@ addr `shouldBe` (SockAddrUnix "") test . setClientAction client $ unix abstractAddress (const $ return ()) $ server+ it "safely throws an exception" $ do+ when isUnixDomainSocketAvailable $ do+ let abstractAddress = toEnum 0:"/haskell/network/abstract-longlonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglong"+ sock <- socket AF_UNIX Stream defaultProtocol+ bind sock (SockAddrUnix abstractAddress) `shouldThrow` anyErrorCall #endif describe "socketPair" $ do@@ -127,8 +154,7 @@ it "can send and recieve a file descriptor" $ do (s1, s2) <- socketPair AF_UNIX Stream defaultProtocol (s3, s4) <- socketPair AF_UNIX Stream defaultProtocol- fd1 <- fdSocket s1- void $ sendFd s3 fd1+ withFdSocket s1 $ \fd1 -> void $ sendFd s3 fd1 fd1' <- recvFd s4 s1' <- mkSocket fd1' void $ send s1' testMsg
tests/Network/Test/Common.hs view
@@ -104,9 +104,9 @@ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort) sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) #if !defined(mingw32_HOST_OS)- fd <- fdSocket sock- getNonBlock fd `shouldReturn` True- getCloseOnExec fd `shouldReturn` False+ withFdSocket sock $ \fd -> do+ getNonBlock fd `shouldReturn` True+ getCloseOnExec fd `shouldReturn` False #endif connect sock $ addrAddress addr return sock@@ -117,15 +117,15 @@ } addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)- fd <- fdSocket sock+ withFdSocket sock $ \fd -> do #if !defined(mingw32_HOST_OS)- getNonBlock fd `shouldReturn` True- getCloseOnExec fd `shouldReturn` False+ getNonBlock fd `shouldReturn` True+ getCloseOnExec fd `shouldReturn` False #endif- setSocketOption sock ReuseAddr 1- setCloseOnExecIfNeeded fd+ setSocketOption sock ReuseAddr 1+ setCloseOnExecIfNeeded fd #if !defined(mingw32_HOST_OS)- getCloseOnExec fd `shouldReturn` True+ getCloseOnExec fd `shouldReturn` True #endif bind sock $ addrAddress addr listen sock 1@@ -135,9 +135,9 @@ , serverAction = \sock -> do (clientSock, _) <- accept sock #if !defined(mingw32_HOST_OS)- fd <- fdSocket clientSock- getNonBlock fd `shouldReturn` True- getCloseOnExec fd `shouldReturn` True+ withFdSocket sock $ \fd -> do+ getNonBlock fd `shouldReturn` True+ getCloseOnExec fd `shouldReturn` True #endif _ <- serverAct clientSock close clientSock