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.

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 :: FilePath -> Annex ()
-onAdd file = doCommand $ Add.start file
+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

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 ()
+type Hook = Maybe (FilePath -> 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
+ - that are not ignored, using inotify. This function returns after
- - setup is complete, leaving a thread running. Then callbacks are made for
+ - its initial scan is complete, leaving a thread running. Callbacks are
- - adding and deleting files.
+ - 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
+ - Note: Moving a file will cause events deleting it from its old location
- - adding it to the new 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 :: INotify -> FilePath -> (FilePath -> Bool) -> Hook -> Hook -> Hook -> Hook -> IO ()
-watchDir i test add del dir = watchDir' False i test add del dir
+watchDir i dir ignored add addsymlink del deldir
-watchDir' :: Bool -> INotify -> (FilePath -> Bool) -> Maybe (FilePath -> IO ()) -> Maybe (FilePath -> IO ()) -> FilePath -> IO ()
+	| ignored dir = noop
-watchDir' scan i test add del dir = do
+	| otherwise = void $ do
-	if test dir
+		_ <- addWatch i watchevents dir go
-		then void $ do
+		mapM walk =<< filter (not . dirCruft) <$>
-			_ <- addWatch i watchevents dir go
+			getDirectoryContents dir
-			mapM walk =<< dirContents dir
-		else noop
 	where
-		watchevents
+		recurse d = watchDir i d ignored add addsymlink del deldir
-			| 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
+		-- Select only inotify events required by the enabled
-		walk f = ifM (catchBoolIO $ Files.isDirectory <$> getFileStatus f)
+		-- hooks, but always include Create so new directories can
-			( recurse f
+		-- be walked.
-			, when (scan && isJust add) $ fromJust add f
+		watchevents = Create : addevents ++ delevents
-			)
+		addevents
+			| isJust add || isJust addsymlink = [MoveIn, CloseWrite]
+			| otherwise = []
+		delevents
+			| isJust del || isJust deldir = [MoveOut, Delete]
+			| otherwise = []
 
-		go (Created { isDirectory = False }) = noop
+		walk f = do
-		go (Created { filePath = subdir }) = Just recurse <@> subdir
+			let fullf = indir f
-		go (Closed { maybeFilePath = Just f }) = add <@> f
+			r <- catchMaybeIO $ getSymbolicLinkStatus fullf
-		go (MovedIn { isDirectory = False, filePath = f }) = add <@> f
+			case r of
-		go (MovedOut { isDirectory = False, filePath = f }) = del <@> f
+				Nothing -> return ()
-		go (Deleted { isDirectory = False, filePath = f }) = del <@> f
+				Just s
+					| Files.isDirectory s -> recurse fullf
+					| Files.isSymbolicLink s -> addsymlink <@> f
+					| Files.isRegularFile s -> add <@> f
+					| otherwise -> return ()
+
+		-- 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