diff options
| -rw-r--r-- | Assistant/Watcher.hs | 49 | ||||
| -rw-r--r-- | Utility/DirWatcher.hs | 53 | ||||
| -rw-r--r-- | Utility/INotify.hs (renamed from Utility/Inotify.hs) | 13 | ||||
| -rw-r--r-- | Utility/Kqueue.hs | 25 | ||||
| -rw-r--r-- | Utility/Types/DirWatcher.hs | 22 | ||||
| -rw-r--r-- | debian/changelog | 7 |
6 files changed, 115 insertions, 54 deletions
diff --git a/Assistant/Watcher.hs b/Assistant/Watcher.hs index 7e0a16f40..a2ca2396e 100644 --- a/Assistant/Watcher.hs +++ b/Assistant/Watcher.hs @@ -13,7 +13,8 @@ import Common.Annex import Assistant.ThreadedMonad import Assistant.DaemonStatus import Assistant.Committer -import Utility.ThreadScheduler +import Utility.DirWatcher +import Utility.Types.DirWatcher import qualified Annex.Queue import qualified Git.Command import qualified Git.UpdateIndex @@ -29,25 +30,12 @@ import Control.Concurrent.STM import Data.Bits.Utils import qualified Data.ByteString.Lazy as L -#ifdef WITH_INOTIFY -import Utility.Inotify -import System.INotify -#endif -#ifdef WITH_KQUEUE -import qualified Utility.Kqueue as Kqueue -#endif - checkCanWatch :: Annex () -checkCanWatch = do -#if (WITH_INOTIFY || WITH_KQUEUE) - unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) $ - needLsof -#else -#if defined linux_HOST_OS -#warning "Building without inotify support; watch mode will be disabled." -#endif - error "watch mode is not available on this system" -#endif +checkCanWatch + | canWatch = + unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) $ + needLsof + | otherwise = error "watch mode is not available on this system" needLsof :: Annex () needLsof = error $ unlines @@ -58,13 +46,9 @@ needLsof = error $ unlines ] watchThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () -#ifdef WITH_INOTIFY -watchThread st dstatus changechan = withINotify $ \i -> do - statupScan st dstatus $ - watchDir i "." ignored hooks - -- Let the inotify thread run. - waitForTermination +watchThread st dstatus changechan = watchDir "." ignored hooks startup where + startup = statupScan st dstatus hook a = Just $ runHandler st dstatus changechan a hooks = WatchHooks { addHook = hook onAdd @@ -73,21 +57,6 @@ watchThread st dstatus changechan = withINotify $ \i -> do , delDirHook = hook onDelDir , errHook = hook onErr } -#else -#ifdef WITH_KQUEUE -watchThread st dstatus changechan = do - kq <- statupScan st dstatus $ - Kqueue.initKqueue "." ignored - go kq - where - go kq = do - (kq', changes) <- Kqueue.waitChange kq - print $ "detected a change in " ++ show changes - go kq' -#else -watchThread = undefined -#endif /* WITH_KQUEUE */ -#endif /* WITH_INOTIFY */ {- Initial scartup scan. The action should return once the scan is complete. -} statupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a diff --git a/Utility/DirWatcher.hs b/Utility/DirWatcher.hs new file mode 100644 index 000000000..575036190 --- /dev/null +++ b/Utility/DirWatcher.hs @@ -0,0 +1,53 @@ +{- generic directory watching interface + - + - Uses either inotify or kqueue to watch a directory (and subdirectories) + - for changes, and runs hooks for different sorts of events as they occur. + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Utility.DirWatcher where + +import Utility.Types.DirWatcher + +#if WITH_INOTIFY +import qualified Utility.INotify as INotify +import qualified System.INotify as INotify +import Utility.ThreadScheduler +#endif +#if WITH_KQUEUE +import qualified Utility.Kqueue as Kqueue +#endif + +type Pruner = FilePath -> Bool + +canWatch :: Bool +#if (WITH_INOTIFY || WITH_KQUEUE) +canWatch = True +#else +#if defined linux_HOST_OS +#warning "Building without inotify support" +#endif +canWatch = False +#endif + +#if WITH_INOTIFY +watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO () +watchDir dir prune hooks runstartup = INotify.withINotify $ \i -> do + runstartup $ INotify.watchDir i dir prune hooks + waitForTermination -- Let the inotify thread run. +#else +#if WITH_KQUEUE +watchDir :: FilePath -> Pruner -> WatchHooks -> (IO Kqueue.Kqueue -> IO Kqueue.Kqueue) -> IO () +watchDir dir ignored hooks runstartup = do + kq <- runstartup $ Kqueue.initKqueue dir ignored + Kqueue.runHooks kq hooks +#else +watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO () +watchDir = undefined +#endif +#endif diff --git a/Utility/Inotify.hs b/Utility/INotify.hs index 9ad947f31..bf87f4e71 100644 --- a/Utility/Inotify.hs +++ b/Utility/INotify.hs @@ -5,26 +5,17 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Utility.Inotify where +module Utility.INotify where import Common hiding (isDirectory) import Utility.ThreadLock +import Utility.Types.DirWatcher import System.INotify import qualified System.Posix.Files as Files import System.IO.Error import Control.Exception (throw) -type Hook a = Maybe (a -> Maybe FileStatus -> IO ()) - -data WatchHooks = WatchHooks - { addHook :: Hook FilePath - , addSymlinkHook :: Hook FilePath - , delHook :: Hook FilePath - , delDirHook :: Hook FilePath - , errHook :: Hook String -- error message - } - {- Watches for changes to files in a directory, and all its subdirectories - that are not ignored, using inotify. This function returns after - its initial scan is complete, leaving a thread running. Callbacks are diff --git a/Utility/Kqueue.hs b/Utility/Kqueue.hs index 5b4920f2f..30218bc29 100644 --- a/Utility/Kqueue.hs +++ b/Utility/Kqueue.hs @@ -15,9 +15,11 @@ module Utility.Kqueue ( changedFile, isAdd, isDelete, + runHooks, ) where import Common +import Utility.Types.DirWatcher import System.Posix.Types import Foreign.C.Types @@ -187,3 +189,26 @@ handleChange (Kqueue h dirmap pruner) fd olddirinfo = -- remove it from our map. newmap <- removeSubDir dirmap (dirName olddirinfo) return (Kqueue h newmap pruner, []) + +{- Processes changes on the Kqueue, calling the hooks as appropriate. + - Never returns. -} +runHooks :: Kqueue -> WatchHooks -> IO () +runHooks kq hooks = do + (kq', changes) <- Kqueue.waitChange kq + forM_ changes $ dispatch kq' + runHooks kq' hooks + where + -- Kqueue returns changes for both whole directories + -- being added and deleted, and individual files being + -- added and deleted. + dispatch q change status + | isAdd change = withstatus s (dispatchadd q) + | isDelete change = callhook delDirHook change + dispatchadd q change s + | Files.isSymbolicLink = callhook addSymlinkHook change + | Files.isDirectory = print $ "TODO: recursive directory add: " ++ show change + | Files.isRegularFile = callhook addHook change + | otherwise = noop + callhook h change = hooks h $ changedFile change + withstatus change a = maybe noop (a change) =<< + (catchMaybeIO (getSymbolicLinkStatus (changedFile change) diff --git a/Utility/Types/DirWatcher.hs b/Utility/Types/DirWatcher.hs new file mode 100644 index 000000000..c828a0593 --- /dev/null +++ b/Utility/Types/DirWatcher.hs @@ -0,0 +1,22 @@ +{- generic directory watching types + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Utility.Types.DirWatcher where + +import Common + +type Hook a = Maybe (a -> Maybe FileStatus -> IO ()) + +data WatchHooks = WatchHooks + { addHook :: Hook FilePath + , addSymlinkHook :: Hook FilePath + , delHook :: Hook FilePath + , delDirHook :: Hook FilePath + , errHook :: Hook String -- error message + } diff --git a/debian/changelog b/debian/changelog index 9a47447ce..f756a8538 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,9 @@ git-annex (3.20120616) UNRELEASED; urgency=low - * watch: New subcommand, which uses inotify to watch for changes to - files and automatically annexes new files, etc, so you don't need - to manually run git commands when manipulating files. + * watch: New subcommand, a daemon which notices changes to + files and automatically annexes new files, etc, so you don't + need to manually run git commands when manipulating files. + Available on Linux, BSDs, and OSX! * Enable diskfree on kfreebsd, using statvfs. -- Joey Hess <joeyh@debian.org> Tue, 12 Jun 2012 11:35:59 -0400 |