git-annex/Utility/Inotify.hs

{-# LANGUAGE CPP #-}

module Utility.Inotify where

import Common hiding (isDirectory)
import System.INotify
import qualified System.Posix.Files as Files
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

{- 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.
 -
 - 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 -> 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
	where
		watchevents
			| isJust add && isJust del =
				[Create, MoveIn, MoveOut, Delete, CloseWrite]
			| isJust add = [Create, MoveIn, CloseWrite]
			| isJust del = [Create, MoveOut, Delete]
			| otherwise = [Create]

		recurse = watchDir' scan i test add del
		walk f = ifM (catchBoolIO $ Files.isDirectory <$> getFileStatus f)
			( recurse f
			, when (scan && isJust add) $ fromJust add f
			)

		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
		go _ = noop
		
		Just a <@> f = a $ dir </> f
		Nothing <@> _ = noop

{- Pauses the main thread, letting children run until program termination. -}
waitForTermination :: IO ()
waitForTermination = do
	mv <- newEmptyMVar
	check softwareTermination mv
	whenM (queryTerminal stdInput) $
		check keyboardSignal mv
	takeMVar mv
	where
		check sig mv = void $
			installHandler sig (CatchOnce $ putMVar mv ()) Nothing