diff options
| -rw-r--r-- | Command/Watch.hs | 22 | ||||
| -rw-r--r-- | Utility/Inotify.hs | 111 |
2 files changed, 86 insertions, 47 deletions
diff --git a/Command/Watch.hs b/Command/Watch.hs index e0fa97ac5..a7553a677 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -29,12 +29,15 @@ start = notBareRepo $ do showAction "scanning" state <- Annex.getState id next $ next $ liftIO $ withINotify $ \i -> do - watchDir i notgit (Just $ run state onAdd) Nothing "." + let hook a = Just $ run state a + watchDir i "." (not . gitdir) + (hook onAdd) (hook onAddSymlink) + (hook onDel) (hook onDelDir) putStrLn "(started)" waitForTermination return True where - notgit dir = takeFileName dir /= ".git" + gitdir dir = takeFileName dir /= ".git" {- Inotify events are run in separate threads, and so each is a - self-contained Annex monad. Exceptions by the handlers are ignored, @@ -51,5 +54,16 @@ run startstate a f = do _ <- shutdown True return () -onAdd :: FilePath -> Annex Bool -onAdd file = doCommand $ Add.start file +onAdd :: FilePath -> Annex () +onAdd file = void $ doCommand $ do + showStart "add" file + next $ Add.perform file + +onAddSymlink :: FilePath -> Annex () +onAddSymlink link = liftIO $ print $ "add symlink " ++ link + +onDel :: FilePath -> Annex () +onDel file = liftIO $ print $ "del " ++ file + +onDelDir :: FilePath -> Annex () +onDelDir dir = liftIO $ print $ "del dir " ++ dir diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs index d41e997d6..dc4c352bf 100644 --- a/Utility/Inotify.hs +++ b/Utility/Inotify.hs @@ -1,3 +1,10 @@ +{- higher-level inotify interface + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + {-# LANGUAGE CPP #-} module Utility.Inotify where @@ -9,19 +16,12 @@ import System.Posix.Terminal import Control.Concurrent.MVar import System.Posix.Signals -demo :: IO () -demo = withINotify $ \i -> do - watchDir i (const True) (Just add) (Just del) "/home/joey/tmp/me" - putStrLn "started" - waitForTermination - where - add file = putStrLn $ "add " ++ file - del file = putStrLn $ "del " ++ file +type Hook = Maybe (FilePath -> IO ()) {- Watches for changes to files in a directory, and all its subdirectories - - that match a test, using inotify. This function returns after its initial - - setup is complete, leaving a thread running. Then callbacks are made for - - adding and deleting files. + - that are not ignored, using inotify. This function returns after + - its initial scan is complete, leaving a thread running. Callbacks are + - made for different events. - - Inotify is weak at recursive directory watching; the whole directory - tree must be walked and watches set explicitly for each subdirectory. @@ -37,51 +37,76 @@ demo = withINotify $ \i -> do - Note: Due to the race amelioration, multiple add events may occur - for the same file. - - - Note: Moving a file may involve deleting it from its old location and - - adding it to the new location. + - Note: Moving a file will cause events deleting it from its old location + - and adding it to the new location. - - Note: Modification of files is not detected, and it's assumed that when - - a file that was open for write is closed, it's done being written + - a file that was open for write is closed, it's finished being written - to, and can be added. - - Note: inotify has a limit to the number of watches allowed, - /proc/sys/fs/inotify/max_user_watches (default 8192). - - So This will fail if there are too many subdirectories. + - So this will fail if there are too many subdirectories. -} -watchDir :: INotify -> (FilePath -> Bool) -> Maybe (FilePath -> IO ()) -> Maybe (FilePath -> IO ()) -> FilePath -> IO () -watchDir i test add del dir = watchDir' False i test add del dir -watchDir' :: Bool -> INotify -> (FilePath -> Bool) -> Maybe (FilePath -> IO ()) -> Maybe (FilePath -> IO ()) -> FilePath -> IO () -watchDir' scan i test add del dir = do - if test dir - then void $ do - _ <- addWatch i watchevents dir go - mapM walk =<< dirContents dir - else noop +watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Hook -> Hook -> Hook -> Hook -> IO () +watchDir i dir ignored add addsymlink del deldir + | ignored dir = noop + | otherwise = void $ do + _ <- addWatch i watchevents dir go + mapM walk =<< filter (not . dirCruft) <$> + getDirectoryContents dir where - watchevents - | isJust add && isJust del = - [Create, MoveIn, MoveOut, Delete, CloseWrite] - | isJust add = [Create, MoveIn, CloseWrite] - | isJust del = [Create, MoveOut, Delete] - | otherwise = [Create] + recurse d = watchDir i d ignored add addsymlink del deldir + + -- Select only inotify events required by the enabled + -- hooks, but always include Create so new directories can + -- be walked. + watchevents = Create : addevents ++ delevents + addevents + | isJust add || isJust addsymlink = [MoveIn, CloseWrite] + | otherwise = [] + delevents + | isJust del || isJust deldir = [MoveOut, Delete] + | otherwise = [] - recurse = watchDir' scan i test add del - walk f = ifM (catchBoolIO $ Files.isDirectory <$> getFileStatus f) - ( recurse f - , when (scan && isJust add) $ fromJust add f - ) + walk f = do + let fullf = indir f + r <- catchMaybeIO $ getSymbolicLinkStatus fullf + case r of + Nothing -> return () + Just s + | Files.isDirectory s -> recurse fullf + | Files.isSymbolicLink s -> addsymlink <@> f + | Files.isRegularFile s -> add <@> f + | otherwise -> return () - go (Created { isDirectory = False }) = noop - go (Created { filePath = subdir }) = Just recurse <@> subdir - go (Closed { maybeFilePath = Just f }) = add <@> f - go (MovedIn { isDirectory = False, filePath = f }) = add <@> f - go (MovedOut { isDirectory = False, filePath = f }) = del <@> f - go (Deleted { isDirectory = False, filePath = f }) = del <@> f + -- Ignore creation events for regular files, which won't be + -- done being written when initially created, but handle for + -- directories and symlinks. + go (Created { isDirectory = True, filePath = subdir }) = recurse $ indir subdir + go (Created { isDirectory = False, filePath = f }) + | isJust addsymlink = + ifM (catchBoolIO $ Files.isSymbolicLink <$> getSymbolicLinkStatus (indir f)) + ( addsymlink <@> f + , noop + ) + | otherwise = noop + -- Closing a file is assumed to mean it's done being written. + go (Closed { isDirectory = False, maybeFilePath = Just f }) = add <@> f + -- When a file or directory is moved in, walk it to add new + -- stuff. + go (MovedIn { filePath = f }) = walk f + go (MovedOut { isDirectory = True, filePath = d }) = deldir <@> d + go (MovedOut { filePath = f }) = del <@> f + go (Deleted { isDirectory = True, filePath = d }) = deldir <@> d + go (Deleted { filePath = f }) = del <@> f go _ = noop - - Just a <@> f = a $ dir </> f + + Just a <@> f = a $ indir f Nothing <@> _ = noop + indir f = dir </> f + {- Pauses the main thread, letting children run until program termination. -} waitForTermination :: IO () waitForTermination = do |