diff options
author | 2012-06-18 23:47:48 -0400 | |
---|---|---|
committer | 2012-06-18 23:49:07 -0400 | |
commit | 7a09d74319c0e68dddfa2cf1979731a030e8881e (patch) | |
tree | bc4acc8901ef7aa80091b29ba3ce57a6654c811a /Utility/Inotify.hs | |
parent | 9b7f929e96531ea3e8b93880ab130179c2fd5107 (diff) |
lifted out the kqueue and inotify to a generic DirWatcher interface
Kqueue code for dispatching events is not tested and probably doesn't
build.
Diffstat (limited to 'Utility/Inotify.hs')
-rw-r--r-- | Utility/Inotify.hs | 180 |
1 files changed, 0 insertions, 180 deletions
diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs deleted file mode 100644 index 9ad947f31..000000000 --- a/Utility/Inotify.hs +++ /dev/null @@ -1,180 +0,0 @@ -{- higher-level inotify interface - - - - Copyright 2012 Joey Hess <joey@kitenet.net> - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Utility.Inotify where - -import Common hiding (isDirectory) -import Utility.ThreadLock - -import System.INotify -import qualified System.Posix.Files as Files -import System.IO.Error -import Control.Exception (throw) - -type Hook a = Maybe (a -> Maybe FileStatus -> 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 - - its initial scan is complete, leaving a thread running. Callbacks are - - made for different events. - - - - Inotify is weak at recursive directory watching; the whole directory - - tree must be scanned and watches set explicitly for each subdirectory. - - - - To notice newly created subdirectories, inotify is used, and - - watches are registered for those directories. There is a race there; - - things can be added to a directory before the watch gets registered. - - - - To close the inotify race, each time a new directory is found, it also - - recursively scans it, assuming all files in it were just added, - - and registering each subdirectory. - - - - Note: Due to the race amelioration, multiple add events may occur - - for the same file. - - - - Note: Moving a file will cause events deleting it from its old 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 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. The - - errHook is called when this happens. - -} -watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> WatchHooks -> IO () -watchDir i dir ignored hooks - | ignored dir = noop - | otherwise = do - -- Use a lock to make sure events generated during initial - -- scan come before real inotify events. - lock <- newLock - let handler event = withLock lock (void $ go event) - void (addWatch i watchevents dir handler) - `catchIO` failedaddwatch - withLock lock $ - mapM_ scan =<< filter (not . dirCruft) <$> - getDirectoryContents dir - where - 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 scanned. - watchevents = Create : addevents ++ delevents - addevents - | hashook addHook || hashook addSymlinkHook = [MoveIn, CloseWrite] - | otherwise = [] - delevents - | hashook delHook || hashook delDirHook = [MoveOut, Delete] - | otherwise = [] - - scan f = unless (ignored f) $ do - ms <- getstatus f - case ms of - Nothing -> return () - Just s - | Files.isDirectory s -> - recurse $ indir f - | Files.isSymbolicLink s -> - runhook addSymlinkHook f ms - | Files.isRegularFile s -> - runhook addHook f ms - | otherwise -> - noop - - -- 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 = isd, filePath = f }) - | isd = recurse $ indir f - | hashook addSymlinkHook = - checkfiletype Files.isSymbolicLink addSymlinkHook f - | otherwise = noop - -- Closing a file is assumed to mean it's done being written. - go (Closed { isDirectory = False, maybeFilePath = Just f }) = - checkfiletype Files.isRegularFile addHook f - -- When a file or directory is moved in, scan it to add new - -- stuff. - go (MovedIn { filePath = f }) = scan f - go (MovedOut { isDirectory = isd, filePath = f }) - | isd = runhook delDirHook f Nothing - | otherwise = runhook delHook f Nothing - -- 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 $ runhook delDirHook f Nothing - | otherwise = guarded $ runhook delHook f Nothing - where - guarded = unlessM (filetype (const True) f) - go _ = noop - - hashook h = isJust $ h hooks - - runhook h f s - | ignored f = noop - | otherwise = maybe noop (\a -> a (indir f) s) (h hooks) - - indir f = dir </> f - - getstatus f = catchMaybeIO $ getSymbolicLinkStatus $ indir f - checkfiletype check h f = do - ms <- getstatus f - case ms of - Just s - | check s -> runhook h f ms - _ -> noop - 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 errHook hooks of - Nothing -> throw e - Just hook -> tooManyWatches hook dir - | otherwise = throw e - -tooManyWatches :: (String -> Maybe FileStatus -> IO ()) -> FilePath -> IO () -tooManyWatches hook dir = do - sysctlval <- querySysctl [Param maxwatches] :: IO (Maybe Integer) - hook (unlines $ basewarning : maybe withoutsysctl withsysctl sysctlval) Nothing - 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 permanently by running:" - , " echo " ++ maxwatches ++ "=" ++ show new ++ - " | sudo tee -a /etc/sysctl.conf; sudo sysctl -p" - , "Or temporarily by running:" - , " sudo sysctl -w " ++ maxwatches ++ "=" ++ show new - ] - -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) |