summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command/Watch.hs18
-rw-r--r--Utility/Inotify.hs49
2 files changed, 37 insertions, 30 deletions
diff --git a/Command/Watch.hs b/Command/Watch.hs
index 6f85c124c..b97a4212d 100644
--- a/Command/Watch.hs
+++ b/Command/Watch.hs
@@ -68,7 +68,7 @@ import System.INotify
type ChangeChan = TChan Change
-type Handler = FilePath -> Annex (Maybe Change)
+type Handler = FilePath -> Maybe FileStatus -> Annex (Maybe Change)
data Change = Change
{ changeTime :: UTCTime
@@ -181,9 +181,9 @@ runChangeChan = atomically
-
- Exceptions are ignored, otherwise a whole watcher thread could be crashed.
-}
-runHandler :: MVar Annex.AnnexState -> ChangeChan -> Handler -> FilePath -> IO ()
-runHandler st changechan handler file = void $ do
- r <- tryIO (runStateMVar st $ handler file)
+runHandler :: MVar Annex.AnnexState -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
+runHandler st changechan handler file filestatus = void $ do
+ r <- tryIO (runStateMVar st $ handler file filestatus)
case r of
Left e -> print e
Right Nothing -> noop
@@ -214,7 +214,7 @@ noChange = return Nothing
- startup.
-}
onAdd :: Handler
-onAdd file = do
+onAdd file _filestatus = do
ifM (Annex.getState Annex.fast)
( go -- initial directory scan is complete
, do -- expensive check done only during startup scan
@@ -243,7 +243,7 @@ onAdd file = do
- already exist.
-}
onAddSymlink :: Handler
-onAddSymlink file = go =<< Backend.lookupFile file
+onAddSymlink file filestatus = go =<< Backend.lookupFile file
where
go Nothing = addlink =<< liftIO (readSymbolicLink file)
go (Just (key, _)) = do
@@ -270,7 +270,7 @@ onAddSymlink file = go =<< Backend.lookupFile file
madeChange file "link"
onDel :: Handler
-onDel file = do
+onDel file _filestatus = do
Annex.Queue.addUpdateIndex =<<
inRepo (Git.UpdateIndex.unstageFile file)
madeChange file "rm"
@@ -283,14 +283,14 @@ onDel file = do
- command to get the recursive list of files in the directory, so rm is
- just as good. -}
onDelDir :: Handler
-onDelDir dir = do
+onDelDir dir _filestatus = do
Annex.Queue.addCommand "rm"
[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
madeChange dir "rmdir"
{- Called when there's an error with inotify. -}
onErr :: Handler
-onErr msg = do
+onErr msg _ = do
warning msg
return Nothing
diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs
index 6eb7be31c..9ad947f31 100644
--- a/Utility/Inotify.hs
+++ b/Utility/Inotify.hs
@@ -15,7 +15,7 @@ import qualified System.Posix.Files as Files
import System.IO.Error
import Control.Exception (throw)
-type Hook a = Maybe (a -> IO ())
+type Hook a = Maybe (a -> Maybe FileStatus -> IO ())
data WatchHooks = WatchHooks
{ addHook :: Hook FilePath
@@ -84,15 +84,18 @@ watchDir i dir ignored hooks
| otherwise = []
scan f = unless (ignored f) $ do
- let fullf = indir f
- r <- catchMaybeIO $ getSymbolicLinkStatus fullf
- case r of
+ ms <- getstatus f
+ case ms of
Nothing -> return ()
Just s
- | Files.isDirectory s -> recurse fullf
- | Files.isSymbolicLink s -> addSymlinkHook <@> f
- | Files.isRegularFile s -> addHook <@> f
- | otherwise -> return ()
+ | 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
@@ -100,39 +103,43 @@ watchDir i dir ignored hooks
go (Created { isDirectory = isd, filePath = f })
| isd = recurse $ indir f
| hashook addSymlinkHook =
- whenM (filetype Files.isSymbolicLink f) $
- addSymlinkHook <@> f
+ 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 }) =
- whenM (filetype Files.isRegularFile f) $
- addHook <@> 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 = delDirHook <@> f
- | otherwise = delHook <@> 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 $ delDirHook <@> f
- | otherwise = guarded $ delHook <@> 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
+ runhook h f s
| ignored f = noop
- | otherwise = maybe noop (\a -> a $ indir f) (h hooks)
- h <@> f = runhook h f
+ | 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
@@ -144,10 +151,10 @@ watchDir i dir ignored hooks
Just hook -> tooManyWatches hook dir
| otherwise = throw e
-tooManyWatches :: (String -> IO ()) -> FilePath -> IO ()
+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
+ hook (unlines $ basewarning : maybe withoutsysctl withsysctl sysctlval) Nothing
where
maxwatches = "fs.inotify.max_user_watches"
basewarning = "Too many directories to watch! (Not watching " ++ dir ++")"