detect KDE automounting

Best dbus events I could find were setupDone from org.kde.Solid.Device.
There may be some spurious events, but that's ok, the code will only
check to see if new mounts are available.

It does not try to auto-start this service if it's not running.

Assistant/Threads/MountWatcher.hs

@@ -19,6 +19,7 @@ import Utility.Mounts
 import Control.Concurrent
 import qualified Control.Exception as E
 import qualified Data.Set as S
+import System.Log.Logger
 
 #if WITH_DBUS
 import DBus.Client
@@ -48,10 +49,11 @@ dbusThread st handle = E.catch (go =<< connectSession) onerr
 				 - work out the mount point from the dbus
 				 - message, but this is easier. -}
 				mvar <- newMVar =<< currentMountPoints
-				listen client mountAdded $ \_event -> do
+				forM_ mountAdded $ \matcher ->
-					nowmounted <- currentMountPoints
+					listen client matcher $ \_event -> do
-					wasmounted <- swapMVar mvar nowmounted
+						nowmounted <- currentMountPoints
-					handleMounts st handle wasmounted nowmounted			
+						wasmounted <- swapMVar mvar nowmounted
+						handleMounts st handle wasmounted nowmounted
 			, do
 				runThreadState st $
 					warning "No known volume monitor available through dbus; falling back to mtab polling"
@@ -64,8 +66,10 @@ dbusThread st handle = E.catch (go =<< connectSession) onerr
 			pollinstead
 		pollinstead = pollingThread st handle
 
-listClientNames :: Client -> IO [String]
+type ServiceName = String
-listClientNames client = do
+
+listServiceNames :: Client -> IO [ServiceName]
+listServiceNames client = do
 	reply <- callDBus client "ListNames" []
 	return $ fromMaybe [] $ fromVariant (methodReturnBody reply !! 0)
 
@@ -76,31 +80,53 @@ callDBus client name params = call_ client $
 		, methodCallBody = params
 		}
 
-{- Examine the list of clients connected to dbus, to see if there
+{- Examine the list of services connected to dbus, to see if there
  - are any we can use to monitor mounts. If not, will attempt to start one. -}
 checkMountMonitor :: Client -> IO Bool
-checkMountMonitor client = ifM isrunning
+checkMountMonitor client = do
-	( return True
+	running <- filter (`elem` usableservices)
-	, startclient knownclients
+		<$> listServiceNames client
-	)
+	if null running
+		then startOneService client startableservices
+		else do
+			myDebug [ "Using running DBUS service"
+				, Prelude.head running
+				, "to monitor mount events."
+				]
+			return True
 	where
-		isrunning = any (`elem` knownclients) <$> listClientNames client
+		startableservices = [gvfs]
-		knownclients = ["org.gtk.Private.GduVolumeMonitor"]
+		usableservices = startableservices ++ [kde]
-		startclient [] = return False
+		gvfs = "org.gtk.Private.GduVolumeMonitor"
-		startclient (c:cs) = do
+		kde = "org.kde.DeviceNotifications"
-			_ <- callDBus client "StartServiceByName"
+
-				[toVariant c, toVariant (0 :: Word32)]
+startOneService :: Client -> [ServiceName] -> IO Bool
-			ifM isrunning
+startOneService _ [] = return False
-				( return True
+startOneService client (x:xs) = do
-				, startclient cs
+	_ <- callDBus client "StartServiceByName"
-				)
+		[toVariant x, toVariant (0 :: Word32)]
+	ifM (elem x <$> listServiceNames client)
+		( do
+			myDebug [ "Started DBUS service"
+				, x
+				, "to monitor mount events."
+				]
+			return True
+		, startOneService client xs
+		)
 
 {- Filter matching events recieved when drives are mounted. -}	
-mountAdded ::MatchRule
+mountAdded :: [MatchRule]
-mountAdded = matchAny
+mountAdded = [gvfs, kde]
-	{ matchInterface = Just "org.gtk.Private.RemoteVolumeMonitor"
+	where
-	, matchMember = Just "MountAdded"
+		gvfs = matchAny
-	}
+			{ matchInterface = Just "org.gtk.Private.RemoteVolumeMonitor"
+			, matchMember = Just "MountAdded"
+			}
+		kde = matchAny
+			{ matchInterface = Just "org.kde.Solid.Device"
+			, matchMember = Just "setupDone"
+			}
 
 #endif
 
@@ -119,7 +145,7 @@ handleMounts st handle wasmounted nowmounted = mapM_ (handleMount st handle) $
 
 handleMount :: ThreadState -> DaemonStatusHandle -> Mntent -> IO ()
 handleMount st handle mntent = do
-	putStrLn $ "mounted: " ++ mnt_dir mntent
+	myDebug ["detected mount of",  mnt_dir mntent]
 
 type MountPoints = S.Set Mntent
 
@@ -130,3 +156,6 @@ currentMountPoints = S.fromList <$> getMounts
 {- Finds new mount points, given an old and a new set. -}
 newMountPoints :: MountPoints -> MountPoints -> MountPoints
 newMountPoints old new = S.difference new old
+
+myDebug :: [String] -> IO ()
+myDebug ms = debugM "MountWatcher" $ unwords ("MountWatcher:":ms)