diff options
author | 2012-06-04 13:22:56 -0400 | |
---|---|---|
committer | 2012-06-04 13:22:56 -0400 | |
commit | 23dbff4b4381628fab2827e693e8234243a63511 (patch) | |
tree | 6f8272b8b25abe0c6587f478a59095c4c963a8a1 /Utility/Inotify.hs | |
parent | eab3872d9145e7733cf69d4e8c696ff075081081 (diff) |
add events for symlink creation and directory removal
Improved the inotify code, so it will also notice directory removal
and symlink creation.
In the watch code, optimised away a stat of a file that's being added,
that's done by Command.Add.start. This is the reason symlink creation is
handled separately from file creation, since during initial tree walk
at startup, a stat was already done, and can be reused.
Diffstat (limited to 'Utility/Inotify.hs')
-rw-r--r-- | Utility/Inotify.hs | 111 |
1 files changed, 68 insertions, 43 deletions
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 |