diff options
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Threads/MountWatcher.hs | 89 | ||||
-rw-r--r-- | Assistant/Threads/Watcher.hs | 2 |
2 files changed, 89 insertions, 2 deletions
diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs new file mode 100644 index 000000000..f3b9c0a3a --- /dev/null +++ b/Assistant/Threads/MountWatcher.hs @@ -0,0 +1,89 @@ +{- git-annex assistant mount watcher, using either dbus or mtab polling + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Assistant.Threads.MountWatcher where + +import Common.Annex +import Assistant.ThreadedMonad +import Assistant.DaemonStatus +import Utility.ThreadScheduler +import Utility.Mounts + +import Control.Concurrent +import qualified Data.Set as S + +#if WITH_DBUS +import DBus.Client +#else +#warning Building without dbus support; will use mtab polling +#endif + +mountWatcherThread :: ThreadState -> DaemonStatusHandle -> IO () +mountWatcherThread st handle = +#if WITH_DBUS + dbusThread st handle +#else + pollingThread st handle +#endif + +#if WITH_DBUS +dbusThread :: ThreadState -> DaemonStatusHandle -> IO () +dbusThread st handle = do + r <- tryIO connectSession + case r of + Left e -> do + print $ "Failed to connect to dbus; falling back to mtab polling (" ++ show e ++ ")" + pollingThread st handle + Right client -> do + {- Store the current mount points in an mvar, + - to be compared later. We could in theory work + - out the mount point from the dbus message, but + - this is easier. -} + mvar <- newMVar =<< currentMountPoints + -- Spawn a listener thread, and returns. + listen client mountadded (go mvar) + where + mountadded = matchAny + { matchInterface = Just "org.gtk.Private.RemoteVolumeMonitor" + , matchMember = Just "MountAdded" + } + go mvar event = do + nowmounted <- currentMountPoints + wasmounted <- swapMVar mvar nowmounted + handleMounts st handle wasmounted nowmounted + +#endif + +pollingThread :: ThreadState -> DaemonStatusHandle -> IO () +pollingThread st handle = go =<< currentMountPoints + where + go wasmounted = do + threadDelaySeconds (Seconds 10) + nowmounted <- currentMountPoints + handleMounts st handle wasmounted nowmounted + go nowmounted + +handleMounts :: ThreadState -> DaemonStatusHandle -> MountPoints -> MountPoints -> IO () +handleMounts st handle wasmounted nowmounted = mapM_ (handleMount st handle) $ + S.toList $ newMountPoints wasmounted nowmounted + +handleMount :: ThreadState -> DaemonStatusHandle -> FilePath -> IO () +handleMount st handle mountpoint = do + putStrLn $ "mounted: " ++ mountpoint + +type MountPoints = S.Set FilePath + +{- Reads mtab, getting the current set of mount points. -} +currentMountPoints :: IO MountPoints +currentMountPoints = S.fromList . map mnt_dir <$> read_mtab + +{- Finds new mount points, given an old and a new set. -} +newMountPoints :: MountPoints -> MountPoints -> MountPoints +newMountPoints old new = S.difference new old diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 9f0eba74e..ae4fafb78 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -5,8 +5,6 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} - module Assistant.Threads.Watcher where import Common.Annex |