dbus 0.10.2 → 0.10.3
raw patch · 4 files changed
+128/−31 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- dbus.cabal +2/−2
- lib/DBus/Transport.hs +20/−20
- tests/DBusTests/Transport.hs +86/−4
- tests/DBusTests/Util.hs +20/−5
dbus.cabal view
@@ -1,5 +1,5 @@ name: dbus-version: 0.10.2+version: 0.10.3 license: GPL-3 license-file: license.txt author: John Millikin <jmillikin@gmail.com>@@ -86,7 +86,7 @@ source-repository this type: bazaar location: https://john-millikin.com/branches/haskell-dbus/0.10/- tag: haskell-dbus_0.10.1+ tag: haskell-dbus_0.10.3 flag network-bytestring-610 default: False
lib/DBus/Transport.hs view
@@ -221,10 +221,12 @@ Left err -> throwIO (transportError err) { transportErrorAddress = Just transportAddr }- Right p -> catchIOException (Just transportAddr) $ do- sock <- socket AF_UNIX Stream defaultProtocol- connect sock (SockAddrUnix p)- return (SocketTransport (Just transportAddr) sock)+ Right p -> catchIOException (Just transportAddr) $ bracketOnError+ (socket AF_UNIX Stream defaultProtocol)+ sClose+ (\sock -> do+ connect sock (SockAddrUnix p)+ return (SocketTransport (Just transportAddr) sock)) openTcp :: Address -> IO SocketTransport openTcp transportAddr = go where@@ -324,11 +326,13 @@ Left err -> throwIO (transportError err) { transportErrorAddress = Just origAddr }- Right (addr, p) -> catchIOException (Just addr) $ do- sock <- socket AF_UNIX Stream defaultProtocol- bindSocket sock (SockAddrUnix p)- Network.Socket.listen sock (socketTransportOptionBacklog opts)- return (addr, sock)+ Right (addr, p) -> catchIOException (Just origAddr) $ bracketOnError+ (socket AF_UNIX Stream defaultProtocol)+ sClose+ (\sock -> do+ bindSocket sock (SockAddrUnix p)+ Network.Socket.listen sock (socketTransportOptionBacklog opts)+ return (addr, sock)) listenTcp :: UUID -> Address -> TransportOptions SocketTransport -> IO (Address, Socket) listenTcp uuid origAddr opts = go where@@ -398,20 +402,16 @@ } Right family_ -> catchIOException (Just origAddr) $ do sockAddrs <- getAddresses family_- - sock <- (bracketOnError- (do- sock <- socket family_ Stream defaultProtocol- setSocketOption sock ReuseAddr 1- return sock)+ bracketOnError+ (socket family_ Stream defaultProtocol) sClose (\sock -> do+ setSocketOption sock ReuseAddr 1 bindAddrs sock (map (setPort port) sockAddrs)- return sock))- - Network.Socket.listen sock (socketTransportOptionBacklog opts)- sockPort <- socketPort sock- return (sockAddr sockPort, sock)+ + Network.Socket.listen sock (socketTransportOptionBacklog opts)+ sockPort <- socketPort sock+ return (sockAddr sockPort, sock)) catchIOException :: Maybe Address -> IO a -> IO a catchIOException addr io = do
tests/DBusTests/Transport.hs view
@@ -83,28 +83,45 @@ (addr, networkSocket) <- listenRandomUnixPath afterTest (N.sClose networkSocket) + fdcountBefore <- countFileDescriptors+ t <- liftIO (transportOpen socketTransportOptions addr)- afterTest (transportClose t)+ liftIO (transportClose t)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenUnix_Abstract :: Test test_OpenUnix_Abstract = assertions "abstract" $ do (addr, networkSocket) <- listenRandomUnixAbstract afterTest (N.sClose networkSocket) + fdcountBefore <- countFileDescriptors+ t <- liftIO (transportOpen socketTransportOptions addr)- afterTest (transportClose t)+ liftIO (transportClose t)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenUnix_TooFew :: Test test_OpenUnix_TooFew = assertions "too-few" $ do+ fdcountBefore <- countFileDescriptors+ let Just addr = address "unix" Map.empty $assert $ throwsEq ((transportError "One of 'path' or 'abstract' must be specified for the 'unix' transport.") { transportErrorAddress = Just addr }) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenUnix_TooMany :: Test test_OpenUnix_TooMany = assertions "too-many" $ do+ fdcountBefore <- countFileDescriptors+ let Just addr = address "unix" (Map.fromList [ ("path", "foo") , ("abstract", "bar")@@ -114,9 +131,14 @@ { transportErrorAddress = Just addr }) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenUnix_NotListening :: Test test_OpenUnix_NotListening = assertions "not-listening" $ do+ fdcountBefore <- countFileDescriptors+ (addr, networkSocket) <- listenRandomUnixAbstract liftIO (NS.sClose networkSocket) $assert $ throwsEq@@ -124,6 +146,9 @@ { transportErrorAddress = Just addr }) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenTcp :: Suite test_OpenTcp = suite "tcp"@@ -140,19 +165,31 @@ (addr, networkSocket) <- listenRandomIPv4 afterTest (N.sClose networkSocket) + fdcountBefore <- countFileDescriptors+ t <- liftIO (transportOpen socketTransportOptions addr)- afterTest (transportClose t)+ liftIO (transportClose t)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenTcp_IPv6 :: Test test_OpenTcp_IPv6 = assertions "ipv6" $ do (addr, networkSocket) <- listenRandomIPv6 afterTest (N.sClose networkSocket) + fdcountBefore <- countFileDescriptors+ t <- liftIO (transportOpen socketTransportOptions addr)- afterTest (transportClose t)+ liftIO (transportClose t)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenTcp_Unknown :: Test test_OpenTcp_Unknown = assertions "unknown-family" $ do+ fdcountBefore <- countFileDescriptors+ let Just addr = address "tcp" (Map.fromList [ ("family", "noexist") , ("port", "1234")@@ -162,9 +199,14 @@ { transportErrorAddress = Just addr }) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenTcp_NoPort :: Test test_OpenTcp_NoPort = assertions "no-port" $ do+ fdcountBefore <- countFileDescriptors+ let Just addr = address "tcp" (Map.fromList [ ("family", "ipv4") ])@@ -173,9 +215,14 @@ { transportErrorAddress = Just addr }) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenTcp_InvalidPort :: Test test_OpenTcp_InvalidPort = assertions "invalid-port" $ do+ fdcountBefore <- countFileDescriptors+ let Just addr = address "tcp" (Map.fromList [ ("family", "ipv4") , ("port", "123456")@@ -185,9 +232,14 @@ { transportErrorAddress = Just addr }) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenTcp_NoUsableAddresses :: Test test_OpenTcp_NoUsableAddresses = assertions "no-usable-addresses" $ do+ fdcountBefore <- countFileDescriptors+ let Just addr = address "tcp" (Map.fromList [ ("family", "ipv4") , ("port", "1234")@@ -199,9 +251,14 @@ , transportErrorAddress err == Just addr ]) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_OpenTcp_NotListening :: Test test_OpenTcp_NotListening = assertions "too-many" $ do+ fdcountBefore <- countFileDescriptors+ (addr, networkSocket) <- listenRandomIPv4 liftIO (NS.sClose networkSocket) $assert $ throwsEq@@ -209,6 +266,9 @@ { transportErrorAddress = Just addr }) (transportOpen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_TransportSendReceive :: Test test_TransportSendReceive = assertions "send-receive" $ do@@ -278,6 +338,7 @@ test_ListenUnix_Tmpdir test_ListenUnix_TooFew test_ListenUnix_TooMany+ test_ListenUnix_InvalidBind test_ListenUnix_Path :: Test test_ListenUnix_Path = assertions "path" $ do@@ -342,6 +403,22 @@ }) (transportListen socketTransportOptions addr) +test_ListenUnix_InvalidBind :: Test+test_ListenUnix_InvalidBind = assertions "invalid-bind" $ do+ fdcountBefore <- countFileDescriptors+ + let Just addr = address "unix" (Map.fromList+ [ ("path", "/")+ ])+ $assert $ throwsEq+ ((transportError "bind: resource busy (Address already in use)")+ { transportErrorAddress = Just addr+ })+ (transportListen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter)+ test_ListenTcp :: Suite test_ListenTcp = suite "tcp" test_ListenTcp_IPv4@@ -400,6 +477,8 @@ test_ListenTcp_InvalidBind :: Test test_ListenTcp_InvalidBind = assertions "invalid-bind" $ do+ fdcountBefore <- countFileDescriptors+ let Just addr = address "tcp" (Map.fromList [ ("family", "ipv4") , ("port", "1")@@ -409,6 +488,9 @@ { transportErrorAddress = Just addr }) (transportListen socketTransportOptions addr)+ + fdcountAfter <- countFileDescriptors+ $assert (equal fdcountBefore fdcountAfter) test_AcceptSocket :: Test test_AcceptSocket = assertions "socket" $ do
tests/DBusTests/Util.hs view
@@ -27,7 +27,9 @@ , listenRandomIPv6 , noIPv6 , forkVar+ , withEnv+ , countFileDescriptors , dropWhileEnd @@ -38,7 +40,7 @@ ) where import Control.Concurrent-import Control.Exception (IOException, try, bracket_)+import Control.Exception (IOException, try, bracket, bracket_) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Bits ((.&.)) import qualified Data.ByteString@@ -50,7 +52,7 @@ import qualified Network as N import qualified Network.Socket as NS import System.Directory (getTemporaryDirectory, removeFile)-import qualified System.Posix.Env+import qualified System.Posix as Posix import System.FilePath ((</>)) import Test.Chell@@ -172,10 +174,23 @@ withEnv :: MonadIO m => String -> Maybe String -> IO a -> m a withEnv name value io = liftIO $ do let set val = case val of- Just x -> System.Posix.Env.setEnv name x True- Nothing -> System.Posix.Env.unsetEnv name- old <- System.Posix.Env.getEnv name+ Just x -> Posix.setEnv name x True+ Nothing -> Posix.unsetEnv name+ old <- Posix.getEnv name bracket_ (set value) (set old) io++countFileDescriptors :: MonadIO m => m Int+countFileDescriptors = liftIO io where+ io = do+ pid <- Posix.getProcessID+ let fdDir = "/proc/" ++ show pid ++ "/fd"+ bracket (Posix.openDirStream fdDir) Posix.closeDirStream countDirEntries+ countDirEntries dir = loop 0 where+ loop n = do+ name <- Posix.readDirStream dir+ if null name+ then return n+ else loop (n + 1) instance (Arbitrary a, Ord a) => Arbitrary (Data.Set.Set a) where arbitrary = fmap Data.Set.fromList arbitrary