diff options
author | 2012-04-11 20:03:49 -0400 | |
---|---|---|
committer | 2012-04-11 20:09:38 -0400 | |
commit | b133a76f96a340c98f5698ca991e9433165c0817 (patch) | |
tree | f2e4a112dc7d00c103485d65a51637406928c440 /Utility/Inotify.hs | |
parent | 037961aa5d5ac3c4b81642a8bf0962abedd35f26 (diff) |
recursive inotify thing
Recursive inotify has beaten me before, with its bad design and races,
but not this time! (I think.) This is able to follow the strongest
filesystem traffic I can throw at it, and robustly notices every file
add and delete. Mostly that's down to Haskell having a quite nice threaded
inotify library (that does its own buffering). A key insight was realizing
that the inotify directory add race could be dealt with by scanning for
files inside newly added directories.
TODO: Add support for freebsd/osx kqueue; see
http://hackage.haskell.org/package/kqueue
Can a git-annex-monitor be far off?
Diffstat (limited to 'Utility/Inotify.hs')
-rw-r--r-- | Utility/Inotify.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs new file mode 100644 index 000000000..bf3681468 --- /dev/null +++ b/Utility/Inotify.hs @@ -0,0 +1,66 @@ +module Utility.Inotify where + +import Common hiding (isDirectory) +import System.INotify +import qualified System.Posix.Files as Files + +demo :: IO String +demo = withINotify $ \i -> do + watchDir i add del "/home/joey/tmp/me" + putStrLn "started" + getLine -- wait for exit + where + add file = putStrLn $ "add " ++ file + del file = putStrLn $ "del " ++ file + +{- Watches for changes to files in a directory, and all its subdirectories, + - using inotify. This function returns after its initial setup is + - complete, leaving a thread running. Then callbacks are made for adding + - and deleting files. + - + - Inotify is weak at recursive directory watching; the whole directory + - tree must be walked and watches set explicitly for each subdirectory. + - + - To notice newly created subdirectories, inotify is used, and + - watches are registered for those directories. There is a race there; + - things can be added to a directory before the watch gets registered. + - + - To close the inotify race, each time a new directory is found, it also + - recursively scans it, assuming all files in it were just added, + - and registering each subdirectory. + - + - 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: 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 + - 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. + -} +watchDir :: INotify -> (FilePath -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO () +watchDir i add del dir = watchDir' False i add del dir +watchDir' :: Bool -> INotify -> (FilePath -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO () +watchDir' scan i add del dir = do + _ <- addWatch i [MoveIn, MoveOut, Create, Delete, CloseWrite] dir go + _ <- mapM walk =<< dirContents dir + return () + where + recurse = watchDir' scan i add del + walk f = ifM (Files.isDirectory <$> getFileStatus f) + ( recurse f + , if scan then add f else return () + ) + a <@> f = a $ dir </> f + go (Created { isDirectory = False }) = return () + go (Created { filePath = subdir }) = 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 + go _ = return () |