1 files changed, 57 insertions, 20 deletions

diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs
index 8504b21d0..c6faddadb 100644
--- a/Utility/Inotify.hs
+++ b/Utility/Inotify.hs
@@ -15,7 +15,15 @@ import qualified System.Posix.Files as Files
 import System.IO.Error
 import Control.Exception (throw)
 
-type Hook = Maybe (FilePath -> IO ())
+type Hook a = Maybe (a -> IO ())
+
+data WatchHooks = WatchHooks
+	{ addHook :: Hook FilePath
+	, addSymlinkHook :: Hook FilePath
+	, delHook :: Hook FilePath
+	, delDirHook :: Hook FilePath
+	, errHook :: Hook String -- error message
+	}
 
 {- Watches for changes to files in a directory, and all its subdirectories
  - that are not ignored, using inotify. This function returns after
@@ -46,10 +54,10 @@ 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. The
- - toomany hook is called when this happens.
+ - errHook is called when this happens.
  -}
-watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Hook -> Hook -> Hook -> Hook -> Hook -> IO ()
-watchDir i dir ignored toomany add addsymlink del deldir
+watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> WatchHooks -> IO ()
+watchDir i dir ignored hooks
 	| ignored dir = noop
 	| otherwise = do
 		lock <- newLock
@@ -60,17 +68,17 @@ watchDir i dir ignored toomany add addsymlink del deldir
 			mapM_ walk =<< filter (not . dirCruft) <$>
 				getDirectoryContents dir
 	where
-		recurse d = watchDir i d ignored toomany add addsymlink del deldir
+		recurse d = watchDir i d ignored hooks
 
 		-- Select only inotify events required by the enabled
 		-- hooks, but always include Create so new directories can
 		-- be walked.
 		watchevents = Create : addevents ++ delevents
 		addevents
-			| isJust add || isJust addsymlink = [MoveIn, CloseWrite]
+			| hashook addHook || hashook addSymlinkHook = [MoveIn, CloseWrite]
 			| otherwise = []
 		delevents
-			| isJust del || isJust deldir = [MoveOut, Delete]
+			| hashook delHook || hashook delDirHook = [MoveOut, Delete]
 			| otherwise = []
 
 		walk f = unless (ignored f) $ do
@@ -80,8 +88,8 @@ watchDir i dir ignored toomany add addsymlink del deldir
 				Nothing -> return ()
 				Just s
 					| Files.isDirectory s -> recurse fullf
-					| Files.isSymbolicLink s -> addsymlink <@> f
-					| Files.isRegularFile s -> add <@> f
+					| Files.isSymbolicLink s -> addSymlinkHook <@> f
+					| Files.isRegularFile s -> addHook <@> f
 					| otherwise -> return ()
 
 		-- Ignore creation events for regular files, which won't be
@@ -89,33 +97,36 @@ watchDir i dir ignored toomany add addsymlink del deldir
 		-- directories and symlinks.
 		go (Created { isDirectory = isd, filePath = f })
 			| isd = recurse $ indir f
-			| isJust addsymlink =
+			| hashook addSymlinkHook =
 				whenM (filetype Files.isSymbolicLink f) $
-					addsymlink <@> f
+					addSymlinkHook <@> f
 			| otherwise = noop
 		-- Closing a file is assumed to mean it's done being written.
 		go (Closed { isDirectory = False, maybeFilePath = Just f }) =
 			whenM (filetype Files.isRegularFile f) $
-				add <@> f
+				addHook <@> f
 		-- When a file or directory is moved in, walk it to add new
 		-- stuff.
 		go (MovedIn { filePath = f }) = walk f
 		go (MovedOut { isDirectory = isd, filePath = f })
-			| isd = deldir <@> f
-			| otherwise = del <@> f
+			| isd = delDirHook <@> f
+			| otherwise = delHook <@> f
 		-- Verify that the deleted item really doesn't exist,
 		-- since there can be spurious deletion events for items
 		-- in a directory that has been moved out, but is still
 		-- being watched.
 		go (Deleted { isDirectory = isd, filePath = f })
-			| isd = guarded $ deldir <@> f
-			| otherwise = guarded $ del <@> f
+			| isd = guarded $ delDirHook <@> f
+			| otherwise = guarded $ delHook <@> f
 			where
 				guarded = unlessM (filetype (const True) f)
 		go _ = noop
 
-		Just a <@> f = unless (ignored f) $ a $ indir f
-		Nothing <@> _ = noop
+		hashook h = isJust $ h hooks
+
+		h <@> f
+			| ignored f = noop
+			| otherwise = maybe noop (\a -> a $ indir f) (h hooks)
 
 		indir f = dir </> f
 
@@ -125,7 +136,33 @@ watchDir i dir ignored toomany add addsymlink del deldir
 		-- disk full error.
 		failedaddwatch e
 			| isFullError e =
-				case toomany of
+				case errHook hooks of
 					Nothing -> throw e
-					Just hook -> hook dir
+					Just hook -> tooManyWatches hook dir
 			| otherwise = throw e
+
+tooManyWatches :: (String -> IO ()) -> FilePath -> IO ()
+tooManyWatches hook dir = do
+	sysctlval <- querySysctl [Param maxwatches] :: IO (Maybe Integer)
+	hook $ 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"
+			]
+
+querySysctl :: Read a => [CommandParam] -> IO (Maybe a)
+querySysctl ps = do
+	v <- catchMaybeIO $ hPipeFrom "sysctl" $ toCommand ps
+	case v of
+		Nothing -> return Nothing
+		Just (pid, h) -> do
+			val <- parsesysctl <$> hGetContentsStrict h
+			void $ getProcessStatus True False $ processID pid
+			return val
+	where
+		parsesysctl s = readish =<< lastMaybe (words s)