network 3.0.1.0 → 3.0.1.1
raw patch · 5 files changed
+222/−109 lines, 5 filesdep −unixPVP ok
version bump matches the API change (PVP)
Dependencies removed: unix
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−1
- Network/Socket/Fcntl.hs +2/−2
- network.cabal +2/−4
- tests/Network/SocketSpec.hs +107/−45
- tests/Network/Test/Common.hs +105/−57
CHANGELOG.md view
@@ -1,3 +1,8 @@+## Version 3.0.1.1++* Fix blocking `if_nametoindex` errors on Windows+ [#391](https://github.com/haskell/network/pull/391)+ ## Version 3.0.1.0 * Added `getSocketType :: Socket -> IO SocketType`.@@ -28,7 +33,7 @@ new mkSocket :: CInt -> IO Socket ``` * Breaking change: the deprecated APIs are removed: send, sendTo, recv, recvFrom, recvLen, htonl, ntohl, inet_addr, int_ntoa, bindSocket, sClose, SocketStatus, isConnected, isBound, isListening, isReadable, isWritable, sIsConnected, sIsBound, sIsListening, sIsReadable, sIsWritable, aNY_PORT, iNADDR_ANY, iN6ADDR_ANY, sOMAXCONN, sOL_SOCKET, sCM_RIGHTS, packSocketType, getPeerCred.-* Breaking chage: SockAddrCan is removed from SockAddr.+* Breaking change: SockAddrCan is removed from SockAddr. * Socket addresses are extendable with Network.Socket.Address. * "socket" is now asynchronous-exception-safe. [#336](https://github.com/haskell/network/pull/336)
Network/Socket/Fcntl.hs view
@@ -15,7 +15,7 @@ setNonBlockIfNeeded fd = System.Posix.Internals.setNonBlockingFD fd True --- | Set the nonblocking flag on Unix.+-- | Set the close_on_exec flag on Unix. -- On Windows, nothing is done. -- -- Since 2.7.0.0.@@ -45,7 +45,7 @@ return (ret /= 0) #endif --- | Get the close_on_exec flag.+-- | Get the nonblocking flag. -- On Windows, this function always returns 'False'. -- -- Since 2.7.0.0.
network.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: network-version: 3.0.1.0+version: 3.0.1.1 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto, Evan Borden@@ -95,8 +95,6 @@ Network.Socket.ByteString.IOVec Network.Socket.ByteString.Lazy.Posix Network.Socket.ByteString.MsgHdr- build-depends:- unix >= 2 c-sources: cbits/ancilData.c if os(solaris)@@ -106,7 +104,7 @@ other-modules: Network.Socket.ByteString.Lazy.Windows c-sources: cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c- extra-libraries: ws2_32+ extra-libraries: ws2_32, iphlpapi -- See https://github.com/haskell/network/pull/362 if impl(ghc >= 7.10) cpp-options: -D_WIN32_WINNT=0x0600
tests/Network/SocketSpec.hs view
@@ -29,8 +29,25 @@ connect' (8080 :: Int) `shouldThrow` anyIOException it "successfully connects to a socket with no exception" $ do- tcpTestUsingClient return return $ readMVar >=> connect'+ withPort $ \portVar -> test (tcp return portVar)+ { clientSetup = readMVar portVar >>= connect'+ } + describe "bind" $ do+ let hints = defaultHints+ { addrFlags = [AI_PASSIVE]+ , addrSocketType = Stream+ }+ it "successfully binds to an ipv6 socket" $ do+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr6) Nothing+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ bind sock $ addrAddress addr++ it "fails to bind to unknown ipv6 socket" $ do+ addr:_ <- getAddrInfo (Just hints) (Just "::6") Nothing+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ bind sock (addrAddress addr) `shouldThrow` anyIOException+ describe "UserTimeout" $ do it "can be set" $ do when (isSupportedSocketOption UserTimeout) $ do@@ -41,44 +58,6 @@ getSocketOption sock UserTimeout `shouldReturn` 2000 close sock - -- On various BSD systems the peer credentials are exchanged during- -- connect(), and this does not happen with `socketpair()`. Therefore,- -- we must actually set up a listener and connect, rather than use a- -- socketpair().- --- describe "getPeerCredential" $ do- it "can return something" $ do- when isUnixDomainSocketAvailable $ do- -- It would be useful to check that we did not get garbage- -- back, but rather the actual uid of the test program. For- -- that we'd need System.Posix.User, but that is not available- -- under Windows. For now, accept the risk that we did not get- -- the right answer.- --- let client sock = do- (_, uid, _) <- getPeerCredential sock- uid `shouldNotBe` Nothing- server (sock, _) = do- (_, uid, _) <- getPeerCredential sock- uid `shouldNotBe` Nothing- unixTest client server- {- The below test fails on many *BSD systems, because the getsockopt()- call that underlies getpeereid() does not have the same meaning for- all address families, but the C-library was not checking that the- provided sock is an AF_UNIX socket. This will fixed some day, but- we should not fail on those systems in the mean-time. The upstream- C-library fix is to call getsockname() and check the address family- before calling `getpeereid()`. We could duplicate that in our own- code, and then this test would work on those platforms that have- `getpeereid()` and not the SO_PEERCRED socket option.-- it "return nothing for non-UNIX-domain socket" $ do- when isUnixDomainSocketAvailable $ do- s <- socket AF_INET Stream defaultProtocol- cred1 <- getPeerCredential s- cred1 `shouldBe` (Nothing,Nothing,Nothing)- -}- describe "getAddrInfo" $ do it "works for IPv4 address" $ do let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }@@ -100,11 +79,94 @@ let hints = defaultHints { addrFlags = [AI_NUMERICSERV] } void $ getAddrInfo (Just hints) (Just "localhost") Nothing - describe "unix sockets" $ do- it "basic unix sockets end-to-end" $ do- when isUnixDomainSocketAvailable $ do+#if defined(mingw32_HOST_OS)+ let lpdevname = "loopback_0"+#else+ let lpdevname = "lo"+#endif++ describe "ifNameToIndex" $ do+ it "converts a name to an index" $+ ifNameToIndex lpdevname `shouldReturn` Just 1++ describe "ifIndexToName" $ do+ it "converts an index to a name" $+ ifIndexToName 1 `shouldReturn` Just lpdevname+++ when isUnixDomainSocketAvailable $ do+ context "unix sockets" $ do+ it "basic unix sockets end-to-end" $ do let client sock = send sock testMsg server (sock, addr) = do- recv sock 1024 `shouldReturn` testMsg- addr `shouldBe` (SockAddrUnix "")- unixTest client server+ recv sock 1024 `shouldReturn` testMsg+ addr `shouldBe` (SockAddrUnix "")+ test . setClientAction client $ unixWithUnlink unixAddr server++#ifdef linux_HOST_OS+ it "can end-to-end with an abstract socket" $ do+ let+ abstractAddress = toEnum 0:"/haskell/network/abstract"+ client sock = send sock testMsg+ server (sock, addr) = do+ recv sock 1024 `shouldReturn` testMsg+ addr `shouldBe` (SockAddrUnix "")+ test . setClientAction client $+ unix abstractAddress (const $ return ()) $ server+#endif++ describe "socketPair" $ do+ it "can send and recieve bi-directionally" $ do+ (s1, s2) <- socketPair AF_UNIX Stream defaultProtocol+ void $ send s1 testMsg+ recv s2 1024 `shouldReturn` testMsg+ void $ send s2 testMsg+ recv s1 1024 `shouldReturn` testMsg++ describe "sendFd/recvFd" $ do+ 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+ fd1' <- recvFd s4+ s1' <- mkSocket fd1'+ void $ send s1' testMsg+ recv s2 1024 `shouldReturn` testMsg++ -- On various BSD systems the peer credentials are exchanged during+ -- connect(), and this does not happen with `socketpair()`. Therefore,+ -- we must actually set up a listener and connect, rather than use a+ -- socketpair().+ --+ describe "getPeerCredential" $ do+ it "can return something" $ do+ -- It would be useful to check that we did not get garbage+ -- back, but rather the actual uid of the test program. For+ -- that we'd need System.Posix.User, but that is not available+ -- under Windows. For now, accept the risk that we did not get+ -- the right answer.+ --+ let server (sock, _) = do+ (_, uid, _) <- getPeerCredential sock+ uid `shouldNotBe` Nothing+ client sock = do+ (_, uid, _) <- getPeerCredential sock+ uid `shouldNotBe` Nothing+ test . setClientAction client $ unixWithUnlink unixAddr server+ {- The below test fails on many *BSD systems, because the getsockopt()+ call that underlies getpeereid() does not have the same meaning for+ all address families, but the C-library was not checking that the+ provided sock is an AF_UNIX socket. This will fixed some day, but+ we should not fail on those systems in the mean-time. The upstream+ C-library fix is to call getsockname() and check the address family+ before calling `getpeereid()`. We could duplicate that in our own+ code, and then this test would work on those platforms that have+ `getpeereid()` and not the SO_PEERCRED socket option.++ it "return nothing for non-UNIX-domain socket" $ do+ when isUnixDomainSocketAvailable $ do+ s <- socket AF_INET Stream defaultProtocol+ cred1 <- getPeerCredential s+ cred1 `shouldBe` (Nothing,Nothing,Nothing)+ -}
tests/Network/Test/Common.hs view
@@ -3,13 +3,25 @@ {-# LANGUAGE ScopedTypeVariables #-} module Network.Test.Common- ( serverAddr- , testMsg- , lazyTestMsg+ ( -- * Client server configuration+ ClientServer(..)+ , setClientAction+ , setServerAction+ , tcp+ , unix+ , unixWithUnlink+ , udp+ , withPort+ -- * Run a ClientServer configuration+ , test , tcpTest- , unixTest , udpTest- , tcpTestUsingClient+ -- * Common constants+ , serverAddr+ , serverAddr6+ , unixAddr+ , testMsg+ , lazyTestMsg ) where import Control.Concurrent (ThreadId, forkIO, myThreadId)@@ -27,6 +39,9 @@ serverAddr :: String serverAddr = "127.0.0.1" +serverAddr6 :: String+serverAddr6 = "::1"+ testMsg :: ByteString testMsg = "This is a test message." @@ -41,32 +56,37 @@ -- get passed a connected 'Socket', used for communicating between -- client and server. 'unixTest' makes sure that the 'Socket' is -- closed after the actions have run.-unixTest :: (Socket -> IO a) -> ((Socket, SockAddr) -> IO b) -> IO ()-unixTest clientAct serverAct =- test clientSetup clientAct serverSetup server+unixWithUnlink :: String -> ((Socket, SockAddr) -> IO b) -> (ClientServer Socket b)+unixWithUnlink address = unix address unlink where- clientSetup = do+ unlink file = do+ exist <- doesFileExist file+ when exist $ removeFile file++unix+ :: String -- ^ address+ -> (String -> IO ()) -- ^ clean up action+ -> ((Socket, SockAddr) -> IO b) -- ^ server action+ -> (ClientServer Socket b)+unix address cleanupAct serverAct = defaultClientServer+ { clientSetup = do sock <- socket AF_UNIX Stream defaultProtocol- connect sock (SockAddrUnix unixAddr)+ connect sock (SockAddrUnix address) return sock-- serverSetup = do+ , serverSetup = do sock <- socket AF_UNIX Stream defaultProtocol- unlink unixAddr -- just in case- bind sock (SockAddrUnix unixAddr)+ cleanupAct address -- just in case+ bind sock (SockAddrUnix address) listen sock 1 return sock-- server sock = E.bracket (accept sock) (killClientSock . fst) serverAct-- unlink file = do- exist <- doesFileExist file- when exist $ removeFile file-+ , serverAction = \sock ->+ E.bracket (accept sock) (killClientSock . fst) serverAct+ }+ where killClientSock sock = do shutdown sock ShutdownBoth close sock- unlink unixAddr+ cleanupAct address -- | Establish a connection between client and server and then run -- 'clientAct' and 'serverAct', in different threads. Both actions@@ -74,10 +94,11 @@ -- client and server. 'tcpTest' makes sure that the 'Socket' is -- closed after the actions have run. tcpTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()-tcpTest clientAct serverAct =- tcpTestUsingClient serverAct clientAct clientSetup- where- clientSetup portVar = do+tcpTest client server = withPort $ test . setClientAction client . tcp server++tcp :: (Socket -> IO b) -> MVar PortNumber -> ClientServer Socket ()+tcp serverAct portVar = defaultClientServer+ { clientSetup = do let hints = defaultHints { addrSocketType = Stream } serverPort <- readMVar portVar addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)@@ -89,18 +110,11 @@ #endif connect sock $ addrAddress addr return sock--tcpTestUsingClient- :: (Socket -> IO a) -> (Socket -> IO b) -> (MVar PortNumber -> IO Socket) -> IO ()-tcpTestUsingClient serverAct clientAct clientSetup = do- portVar <- newEmptyMVar- test (clientSetup portVar) clientAct (serverSetup portVar) server- where- serverSetup portVar = do+ , serverSetup = do let hints = defaultHints { addrFlags = [AI_PASSIVE]- , addrSocketType = Stream- }+ , addrSocketType = Stream+ } addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) fd <- fdSocket sock@@ -118,8 +132,7 @@ serverPort <- socketPort sock putMVar portVar serverPort return sock-- server sock = do+ , serverAction = \sock -> do (clientSock, _) <- accept sock #if !defined(mingw32_HOST_OS) fd <- fdSocket clientSock@@ -128,25 +141,28 @@ #endif _ <- serverAct clientSock close clientSock+ } -- | Create an unconnected 'Socket' for sending UDP and receiving -- datagrams and then run 'clientAct' and 'serverAct'. udpTest :: (Socket -> PortNumber -> IO a) -> (Socket -> IO b) -> IO ()-udpTest clientAct serverAct = do- portVar <- newEmptyMVar- test clientSetup (client portVar) (serverSetup portVar) serverAct- where- clientSetup = socket AF_INET Datagram defaultProtocol+udpTest client server =+ withPort $ test . setServerAction server . udp client - client portVar sock = do+udp+ :: (Socket -> PortNumber -> IO a)+ -> MVar PortNumber+ -> ClientServer a Socket+udp clientAct portVar = defaultClientServer+ { clientSetup = socket AF_INET Datagram defaultProtocol+ , clientAction = \sock -> do serverPort <- readMVar portVar clientAct sock serverPort-- serverSetup portVar = do+ , serverSetup = do let hints = defaultHints { addrFlags = [AI_PASSIVE]- , addrSocketType = Datagram- }+ , addrSocketType = Datagram+ } addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) setSocketOption sock ReuseAddr 1@@ -154,32 +170,64 @@ serverPort <- socketPort sock putMVar portVar serverPort return sock+ } +data ClientServer a b+ = ClientServer+ { clientSetup :: IO Socket+ , clientAction :: Socket -> IO a+ , serverSetup :: IO Socket+ , serverAction :: Socket -> IO b+ }++setClientAction+ :: (Socket -> IO b)+ -> ClientServer a c+ -> ClientServer b c+setClientAction f c = c { clientAction = f }++setServerAction+ :: (Socket -> IO c)+ -> ClientServer a b+ -> ClientServer a c+setServerAction f c = c { serverAction = f }++defaultClientServer :: ClientServer Socket Socket+defaultClientServer = ClientServer+ { clientSetup =+ E.throwIO $ userError "no client setup defined"+ , clientAction = return+ , serverSetup = E.throwIO $ userError "no server setup defined"+ , serverAction = return+ }+ -- | Run a client/server pair and synchronize them so that the server -- is started before the client and the specified server action is -- finished before the client closes the 'Socket'.-test :: IO Socket -> (Socket -> IO b) -> IO Socket -> (Socket -> IO c) -> IO ()-test clientSetup clientAct serverSetup serverAct = do+test :: ClientServer a b -> IO ()+test conf = do tid <- myThreadId barrier <- newEmptyMVar- _ <- forkIO $ server barrier+ _ <- forkIO $ server tid barrier client tid barrier where- server barrier =- E.bracket serverSetup close $ \sock -> do+ server tid barrier =+ bracketWithReraise tid (serverSetup conf) close $ \sock -> do serverReady- Just _ <- timeout 1000000 $ serverAct sock+ Just _ <- timeout 1000000 $ (serverAction conf) sock putMVar barrier () where -- | Signal to the client that it can proceed. serverReady = putMVar barrier ()- client tid barrier = do takeMVar barrier -- Transfer exceptions to the main thread.- bracketWithReraise tid clientSetup close $ \res -> do- Just _ <- timeout 1000000 $ clientAct res+ bracketWithReraise tid (clientSetup conf) close $ \res -> do+ Just _ <- timeout 1000000 $ (clientAction conf) res takeMVar barrier++withPort :: (MVar PortNumber -> IO a) -> IO a+withPort f = f =<< newEmptyMVar -- | Like 'bracket' but catches and reraises the exception in another -- thread, specified by the first argument.