diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Inotify.hs | 77 |
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) |