handle running out of watch descriptors

Command/Watch.hs

@@ -44,6 +44,7 @@ start = notBareRepo $ do
 	next $ next $ liftIO $ withINotify $ \i -> do
 		let hook a = Just $ runAnnex mvar a
 		watchDir i "." (ignored . takeFileName)
+			(hook onTooMany)
 			(hook onAdd) (hook onAddSymlink)
 			(hook onDel) (hook onDelDir)
 		putStrLn "(started)"
@@ -119,6 +120,32 @@ onDelDir :: FilePath -> Annex ()
 onDelDir dir = inRepo $ Git.Command.run "rm"
 	[Params "--quiet -r --cached --ignore-unmatch --", File dir]
 
+{- There are too many directories for inotify to watch them all. -}
+onTooMany :: FilePath -> Annex ()
+onTooMany dir = do
+	sysctlval <- liftIO $ runsysctl [Param maxwatches]
+	warning $ unlines $
+		basewarning : maybe withoutsysctl withsysctl sysctlval
+	where
+		maxwatches = "fs.inotify.max_user_watches"
+		basewarning = "Too many directories to watch! (Not watching " ++ dir ++")"
+		withoutsysctl = ["Increase the value in /proc/sys/fs/inotify/max_user_watches"]
+		withsysctl n = let new = n * 10 in
+			[ "Increase the limit by running:"
+			, "  echo " ++ maxwatches ++ "=" ++ show new ++
+			  " | sudo tee -a /etc/sysctl.conf; sudo sysctl -p"
+			]
+		runsysctl ps = do
+			v <- catchMaybeIO $ hPipeFrom "sysctl" $ toCommand ps
+			case v of
+				Nothing -> return Nothing
+				Just (pid, h) -> do
+					val <- parsesysctl <$> liftIO (hGetContentsStrict h)
+					void $ getProcessStatus True False $ processID pid
+					return val
+		parsesysctl :: String -> Maybe Integer
+		parsesysctl s = readish =<< lastMaybe (words s)
+
 {- Adds a symlink to the index, without ever accessing the actual symlink
  - on disk. -}
 stageSymlink :: FilePath -> String -> Git.Repo -> IO ()

Utility/Inotify.hs

@@ -14,6 +14,8 @@ import Utility.ThreadLock
 
 import System.INotify
 import qualified System.Posix.Files as Files
+import System.IO.Error
+import Control.Exception (throw)
 
 type Hook = Maybe (FilePath -> IO ())
 
@@ -45,18 +47,22 @@ type Hook = Maybe (FilePath -> IO ())
  -
  - 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. The
+ - toomany hook is called when this happens.
  -}
-watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Hook -> Hook -> Hook -> Hook -> IO ()
-watchDir i dir ignored add addsymlink del deldir = unless (ignored dir) $ do
-	lock <- newLock
-	void $ addWatch i watchevents dir $ \event ->
-		withLock lock (void $ go event)
-	withLock lock $
-		mapM_ walk =<< filter (not . dirCruft) <$>
-			getDirectoryContents dir
+watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Hook -> Hook -> Hook -> Hook -> Hook -> IO ()
+watchDir i dir ignored toomany add addsymlink del deldir
+	| ignored dir = noop
+	| otherwise = do
+		lock <- newLock
+		let handler event = withLock lock (void $ go event)
+		void (addWatch i watchevents dir handler)
+			`catchIO` failedaddwatch
+		withLock lock $
+			mapM_ walk =<< filter (not . dirCruft) <$>
+				getDirectoryContents dir
 	where
-		recurse d = watchDir i d ignored add addsymlink del deldir
+		recurse d = watchDir i d ignored toomany add addsymlink del deldir
 
 		-- Select only inotify events required by the enabled
 		-- hooks, but always include Create so new directories can
@@ -116,3 +122,12 @@ watchDir i dir ignored add addsymlink del deldir = unless (ignored dir) $ do
 		indir f = dir </> f
 
 		filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f)
+
+		-- Inotify fails when there are too many watches with a
+		-- disk full error.
+		failedaddwatch e
+			| isFullError e =
+				case toomany of
+					Nothing -> throw e
+					Just hook -> hook dir
+			| otherwise = throw e