aboutsummaryrefslogtreecommitdiff
path: root/Utility/Inotify.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/Inotify.hs')
-rw-r--r--Utility/Inotify.hs77
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)