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?
This commit is contained in:
parent
037961aa5d
commit
b133a76f96
1 changed files with 66 additions and 0 deletions
66
Utility/Inotify.hs
Normal file
66
Utility/Inotify.hs
Normal file
|
@ -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 ()
|
Loading…
Add table
Add a link
Reference in a new issue