diff options
| -rw-r--r-- | Assistant.hs | 7 | ||||
| -rw-r--r-- | Assistant/Threads/MountWatcher.hs | 89 | ||||
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 2 | ||||
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | debian/control | 1 | ||||
| -rw-r--r-- | git-annex.cabal | 11 |
6 files changed, 108 insertions, 6 deletions
diff --git a/Assistant.hs b/Assistant.hs index 06484b086..51639584c 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -46,6 +46,11 @@ - Wakes up periodically and records the daemon's status to disk. - Thread 12: sanity checker - Wakes up periodically (rarely) and does sanity checks. + - Thread 13: mount watcher + - Either uses dbus to watch for drive mount events, or, when + - there's no dbus, polls to find newly mounted filesystems. + - Once a filesystem that contains a remote is mounted, syncs + - with it. - - ThreadState: (MVar) - The Annex state is stored here, which allows resuscitating the @@ -92,6 +97,7 @@ import Assistant.Threads.Merger import Assistant.Threads.TransferWatcher import Assistant.Threads.Transferrer import Assistant.Threads.SanityChecker +import Assistant.Threads.MountWatcher import qualified Utility.Daemon import Utility.LogFile import Utility.ThreadScheduler @@ -127,6 +133,7 @@ startDaemon assistant foreground , transfererThread st dstatus transferqueue transferslots , daemonStatusThread st dstatus , sanityCheckerThread st dstatus transferqueue changechan + , mountWatcherThread st dstatus , watchThread st dstatus transferqueue changechan ] waitForTermination 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 @@ -1,11 +1,11 @@ bins=git-annex mans=git-annex.1 git-annex-shell.1 -sources=Build/SysConfig.hs Utility/Touch.hs +sources=Build/SysConfig.hs Utility/Touch.hs Utility/Mounts.hs all=$(bins) $(mans) docs OS:=$(shell uname | sed 's/[-_].*//') ifeq ($(OS),Linux) -BASEFLAGS_OPTS+=-DWITH_INOTIFY +BASEFLAGS_OPTS+=-DWITH_INOTIFY -DWITH_DBUS clibs=Utility/libdiskfree.o else BASEFLAGS_OPTS+=-DWITH_KQUEUE diff --git a/debian/control b/debian/control index 79702ed29..35cbfde05 100644 --- a/debian/control +++ b/debian/control @@ -22,6 +22,7 @@ Build-Depends: libghc-edit-distance-dev, libghc-hinotify-dev [linux-any], libghc-stm-dev (>= 2.3), + libghc-dbus-dev, ikiwiki, perlmagick, git, diff --git a/git-annex.cabal b/git-annex.cabal index e58bd4d95..00f57319d 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -31,6 +31,9 @@ Flag S3 Flag Inotify Description: Enable inotify support +Flag Dbus + Description: Enable dbus support + Flag Assistant Description: Enable git-annex assistant and watch command @@ -41,8 +44,8 @@ Executable git-annex pcre-light, extensible-exceptions, dataenc, SHA, process, json, HTTP, base == 4.5.*, monad-control, transformers-base, lifted-base, IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process - -- Need to list this because it's generated from a .hsc file. - Other-Modules: Utility.Touch + -- Need to list these because they're generated from .hsc files. + Other-Modules: Utility.Touch Utility.Mounts C-Sources: Utility/libdiskfree.c Extensions: CPP GHC-Options: -threaded @@ -59,6 +62,10 @@ Executable git-annex Build-Depends: hinotify CPP-Options: -DWITH_INOTIFY + if flag(Dbus) + Build-Depends: dbus + CPP-Options: -DWITH_DBUS + Test-Suite test Type: exitcode-stdio-1.0 Main-Is: test.hs |