dbus 0.10.1 → 0.10.2

raw patch · 7 files changed

+105/−12 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• dbus.cabal +1/−1
• lib/DBus/Client.hs +16/−2
• lib/DBus/Transport.hs +10/−4
• lib/DBus/Wire.hs +16/−5
• tests/DBusTests.hs +2/−0
• tests/DBusTests/Transport.hs +17/−0
• tests/DBusTests/Wire.hs +43/−0

@@ -1,5 +1,5 @@ name: dbus-version: 0.10.1+version: 0.10.2 license: GPL-3 license-file: license.txt author: John Millikin <jmillikin@gmail.com>

@@ -116,6 +116,7 @@ 	-- * Advanced connection options 	, ClientOptions 	, clientSocketOptions+	, clientThreadRunner 	, defaultClientOptions 	, connectWith 	) where@@ -164,6 +165,16 @@ 	-- | Options for the underlying socket, for advanced use cases. See 	-- the "DBus.Socket" module. 	  clientSocketOptions :: DBus.Socket.SocketOptions t+	+	-- | A function to run the client thread. The provided IO computation+	-- should be called repeatedly; each time it is called, it will process+	-- one incoming message.+	--+	-- The provided computation will throw a 'ClientError' if it fails to+	-- process an incoming message, or if the connection is lost.+	--+	-- The default implementation is 'forever'.+	, clientThreadRunner :: IO () -> IO () 	}  type Callback = (ReceivedMessage -> IO ())@@ -246,10 +257,12 @@ 	signalHandlers <- newIORef [] 	objects <- newIORef Data.Map.empty 	+	let threadRunner = clientThreadRunner opts+	 	clientMVar <- newEmptyMVar 	threadID <- forkIO $ do 		client <- readMVar clientMVar-		mainLoop client+		threadRunner (mainLoop client) 	 	let client = Client 		{ clientSocket = sock@@ -273,6 +286,7 @@ defaultClientOptions :: ClientOptions SocketTransport defaultClientOptions = ClientOptions 	{ clientSocketOptions = DBus.Socket.defaultSocketOptions+	, clientThreadRunner = forever 	}  -- | Stop a 'Client''s callback thread and close its underlying socket.@@ -293,7 +307,7 @@ 	DBus.Socket.close (clientSocket client)  mainLoop :: Client -> IO ()-mainLoop client = forever $ do+mainLoop client = do 	let sock = clientSocket client 	 	received <- Control.Exception.try (DBus.Socket.receive sock)

@@ -158,10 +158,16 @@ 			loop builder (n - Data.ByteString.length chunk) 		else do 			chunk <- recv s n-			let builder = Builder.append acc (Builder.fromByteString chunk)-			if Data.ByteString.length chunk == n-				then return (Builder.toByteString builder)-				else loop builder (n - Data.ByteString.length chunk)+			case Data.ByteString.length chunk of+				-- Unexpected end of connection; maybe the remote end went away.+				-- Return what we've got so far.+				0 -> return (Builder.toByteString acc)+				+				len -> do+					let builder = Builder.append acc (Builder.fromByteString chunk)+					if len == n+						then return (Builder.toByteString builder)+						else loop builder (n - Data.ByteString.length chunk)  instance TransportOpen SocketTransport where 	transportOpen _ a = case addressMethod a of

@@ -570,8 +570,11 @@ unmarshalMessageM :: Monad m => (Int -> m ByteString)                   -> m (Either UnmarshalError ReceivedMessage) unmarshalMessageM getBytes' = runErrorT $ do-	let getBytes = ErrorT . liftM Right . getBytes'-	+	let getBytes count = do+		bytes <- ErrorT (liftM Right (getBytes' count))+		if Data.ByteString.length bytes < count+			then throwErrorT (UnmarshalError "Unexpected end of input while parsing message header.")+			else return bytes  	let Just fixedSig = parseSignature "yyyyuuu" 	fixedBytes <- getBytes 16@@ -671,9 +674,17 @@ require label _     = throwErrorM label  unmarshalMessage :: ByteString -> Either UnmarshalError ReceivedMessage-unmarshalMessage bytes = case Get.runGet (unmarshalMessageM Get.getByteString) bytes of-	Left err -> Left (UnmarshalError err)-	Right x -> x+unmarshalMessage bytes = checkError (Get.runGet get bytes) where+	get = unmarshalMessageM getBytes+	+	-- wrap getByteString, so it will behave like transportGet and return+	-- a truncated result on EOF instead of throwing an exception.+	getBytes count = do+		remaining <- Get.remaining+		Get.getByteString (min remaining count)+	+	checkError (Left err) = Left (UnmarshalError err)+	checkError (Right x) = x  untilM :: Monad m => m Bool -> m a -> m [a] untilM test comp = do

@@ -35,6 +35,7 @@ import           DBusTests.Signature import           DBusTests.Transport import           DBusTests.Variant+import           DBusTests.Wire  -- import all dbus modules here to ensure they show up in the coverage report, -- even if not tested.@@ -64,6 +65,7 @@ 	, test_Socket 	, test_Transport 	, test_Variant+	, test_Wire 	]  main :: IO ()

@@ -42,6 +42,7 @@ 	test_TransportListen 	test_TransportAccept 	test_TransportSendReceive+	test_HandleLostConnection  test_TransportOpen :: Suite test_TransportOpen = suite "transportOpen"@@ -244,6 +245,22 @@ 		liftIO (transportPut t sentBytes) 		bytes <- liftIO (readMVar var) 		$assert (equal bytes sentBytes)++test_HandleLostConnection :: Test+test_HandleLostConnection = assertions "handle-lost-connection" $ do+	(addr, networkSocket) <- listenRandomIPv4+	afterTest (N.sClose networkSocket)+	+	_ <- liftIO $ forkIO $ do+		(s, _) <- NS.accept networkSocket+		sendAll s "123"+		NS.sClose s+	+	t <- liftIO (transportOpen socketTransportOptions addr)+	afterTest (transportClose t)+	+	bytes <- liftIO (transportGet t 4)+	$assert (equal bytes "123")  test_ListenUnknown :: Test test_ListenUnknown = assertions "unknown" $ do

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++-- Copyright (C) 2012 John Millikin <jmillikin@gmail.com>+--+-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.++module DBusTests.Wire (test_Wire) where++import           Test.Chell++import qualified Data.ByteString.Char8 ()++import           DBus++test_Wire :: Suite+test_Wire = suite "Wire"+	test_Unmarshal++test_Unmarshal :: Suite+test_Unmarshal = suite "unmarshal"+	test_UnmarshalUnexpectedEof++test_UnmarshalUnexpectedEof :: Test+test_UnmarshalUnexpectedEof = assertions "unexpected-eof" $ do+	let unmarshaled = unmarshal "0"+	$assert (left unmarshaled)+	+	let Left err = unmarshaled+	$assert (equal+		(unmarshalErrorMessage err)+		"Unexpected end of input while parsing message header.")