git-annex/Assistant/Threads/Watcher.hs

374 lines
12 KiB
Haskell
Raw Normal View History

2012-06-13 16:36:33 +00:00
{- git-annex assistant tree watcher
-
- Copyright 2012-2015 Joey Hess <id@joeyh.name>
2012-06-13 16:36:33 +00:00
-
- Licensed under the GNU AGPL version 3 or higher.
2012-06-13 16:36:33 +00:00
-}
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, CPP #-}
module Assistant.Threads.Watcher (
watchThread,
WatcherControl(..),
checkCanWatch,
needLsof,
onAddSymlink,
runHandler,
) where
import Assistant.Common
2012-06-13 16:36:33 +00:00
import Assistant.DaemonStatus
2012-06-19 06:40:21 +00:00
import Assistant.Changes
2012-10-29 23:30:23 +00:00
import Assistant.Types.Changes
import Assistant.Alert
import Utility.DirWatcher
import Utility.DirWatcher.Types
import Utility.InodeCache
import qualified Utility.RawFilePath as R
import qualified Annex
2012-06-13 16:36:33 +00:00
import qualified Annex.Queue
import qualified Git
2012-06-13 16:36:33 +00:00
import qualified Git.UpdateIndex
import qualified Git.LsFiles as LsFiles
2015-12-15 19:34:28 +00:00
import Annex.WorkTree
2012-06-13 16:36:33 +00:00
import Annex.CatFile
gitignore support for the assistant and watcher Requires git 1.8.4 or newer. When it's installed, a background git check-ignore process is run, and used to efficiently check ignores whenever a new file is added. Thanks to Adam Spiers, for getting the necessary support into git for this. A complication is what to do about files that are gitignored but have been checked into git anyway. git commands assume the ignore has been overridden in this case, and not need any more overriding to commit a changed version. However, for the assistant to do the same, it would have to run git ls-files to check if the ignored file is in git. This is somewhat expensive. Or it could use the running git-cat-file process to query the file that way, but that requires transferring the whole file content over a pipe, so it can be quite expensive too, for files that are not git-annex symlinks. Now imagine if the user knows that a file or directory tree will be getting frequent changes, and doesn't want the assistant to sync it, so gitignores it. The assistant could overload the system with repeated ls-files checks! So, I've decided that the assistant will not automatically commit changes to files that are gitignored. This is a tradeoff. Hopefully it won't be a problem to adjust .gitignore settings to not ignore files you want the assistant to autocommit, or to manually git annex add files that are listed in .gitignore. (This could be revisited if git-annex gets access to an interface to check the content of the index w/o forking a git command. This could be libgit2, or perhaps a separate git cat-file --batch-check process, so it wouldn't need to ship over the whole file content.) This commit was sponsored by Francois Marier. Thanks!
2013-08-02 23:31:55 +00:00
import Annex.CheckIgnore
fully support core.symlinks=false in all relevant symlink handling code Refactored annex link code into nice clean new library. Audited and dealt with calls to createSymbolicLink. Remaining calls are all safe, because: Annex/Link.hs: ( liftIO $ createSymbolicLink linktarget file only when core.symlinks=true Assistant/WebApp/Configurators/Local.hs: createSymbolicLink link link test if symlinks can be made Command/Fix.hs: liftIO $ createSymbolicLink link file command only works in indirect mode Command/FromKey.hs: liftIO $ createSymbolicLink link file command only works in indirect mode Command/Indirect.hs: liftIO $ createSymbolicLink l f refuses to run if core.symlinks=false Init.hs: createSymbolicLink f f2 test if symlinks can be made Remote/Directory.hs: go [file] = catchBoolIO $ createSymbolicLink file f >> return True fast key linking; catches failure to make symlink and falls back to copy Remote/Git.hs: liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True ditto Upgrade/V1.hs: liftIO $ createSymbolicLink link f v1 repos could not be on a filesystem w/o symlinks Audited and dealt with calls to readSymbolicLink. Remaining calls are all safe, because: Annex/Link.hs: ( liftIO $ catchMaybeIO $ readSymbolicLink file only when core.symlinks=true Assistant/Threads/Watcher.hs: ifM ((==) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) code that fixes real symlinks when inotify sees them It's ok to not fix psdueo-symlinks. Assistant/Threads/Watcher.hs: mlink <- liftIO (catchMaybeIO $ readSymbolicLink file) ditto Command/Fix.hs: stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do command only works in indirect mode Upgrade/V1.hs: getsymlink = takeFileName <$> readSymbolicLink file v1 repos could not be on a filesystem w/o symlinks Audited and dealt with calls to isSymbolicLink. (Typically used with getSymbolicLinkStatus, but that is just used because getFileStatus is not as robust; it also works on pseudolinks.) Remaining calls are all safe, because: Assistant/Threads/SanityChecker.hs: | isSymbolicLink s -> addsymlink file ms only handles staging of symlinks that were somehow not staged (might need to be updated to support pseudolinks, but this is only a belt-and-suspenders check anyway, and I've never seen the code run) Command/Add.hs: if isSymbolicLink s || not (isRegularFile s) avoids adding symlinks to the annex, so not relevant Command/Indirect.hs: | isSymbolicLink s -> void $ flip whenAnnexed f $ only allowed on systems that support symlinks Command/Indirect.hs: whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do ditto Seek.hs:notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f used to find unlocked files, only relevant in indirect mode Utility/FSEvents.hs: | Files.isSymbolicLink s = runhook addSymlinkHook $ Just s Utility/FSEvents.hs: | Files.isSymbolicLink s -> Utility/INotify.hs: | Files.isSymbolicLink s -> Utility/INotify.hs: checkfiletype Files.isSymbolicLink addSymlinkHook f Utility/Kqueue.hs: | Files.isSymbolicLink s = callhook addSymlinkHook (Just s) change all above are lower-level, not relevant Audited and dealt with calls to isSymLink. Remaining calls are all safe, because: Annex/Direct.hs: | isSymLink (getmode item) = This is looking at git diff-tree objects, not files on disk Command/Unused.hs: | isSymLink (LsTree.mode l) = do This is looking at git ls-tree, not file on disk Utility/FileMode.hs:isSymLink :: FileMode -> Bool Utility/FileMode.hs:isSymLink = checkMode symbolicLinkMode low-level Done!!
2013-02-17 19:05:55 +00:00
import Annex.Link
import Annex.Content
import Annex.ReplaceFile
import Annex.InodeSentinal
2012-06-13 16:36:33 +00:00
import Git.Types
import Git.FilePath
import Config.GitConfig
import Utility.ThreadScheduler
import Logs.Location
import qualified Database.Keys
#ifndef mingw32_HOST_OS
import qualified Utility.Lsof as Lsof
#endif
2012-06-13 16:36:33 +00:00
import Data.Typeable
2012-06-13 16:36:33 +00:00
import qualified Data.ByteString.Lazy as L
import qualified Control.Exception as E
import Data.Time.Clock
import System.PosixCompat.Files (fileMode, statusChangeTime)
2012-06-13 16:36:33 +00:00
checkCanWatch :: Annex ()
checkCanWatch
| canWatch = do
#ifndef mingw32_HOST_OS
liftIO Lsof.setup
unlessM (liftIO (inSearchPath "lsof") <||> Annex.getRead Annex.force)
needLsof
#else
noop
#endif
| otherwise = giveup "watch mode is not available on this system"
needLsof :: Annex ()
needLsof = giveup $ unlines
[ "The lsof command is needed for watch mode to be safe, and is not in PATH."
, "To override lsof checks to ensure that files are not open for writing"
, "when added to the annex, you can use --force"
, "Be warned: This can corrupt data in the annex, and make fsck complain."
]
{- A special exception that can be thrown to pause or resume the watcher. -}
data WatcherControl = PauseWatcher | ResumeWatcher
deriving (Show, Eq, Typeable)
instance E.Exception WatcherControl
watchThread :: NamedThread
watchThread = namedThread "Watcher" $
ifM (liftAnnex $ getGitConfigVal annexAutoCommit)
( runWatcher
, waitFor ResumeWatcher runWatcher
)
runWatcher :: Assistant ()
runWatcher = do
startup <- asIO1 startupScan
symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig
addhook <- hook $ onAddFile symlinkssupported
delhook <- hook onDel
addsymlinkhook <- hook onAddSymlink
deldirhook <- hook onDelDir
errhook <- hook onErr
let hooks = mkWatchHooks
{ addHook = addhook
, delHook = delhook
, addSymlinkHook = addsymlinkhook
, delDirHook = deldirhook
, errHook = errhook
}
scanevents <- liftAnnex $ annexStartupScan <$> Annex.getGitConfig
h <- liftIO $ watchDir "." ignored scanevents hooks startup
debug [ "watching", "."]
{- Let the DirWatcher thread run until signalled to pause it,
- then wait for a resume signal, and restart. -}
waitFor PauseWatcher $ do
liftIO $ stopWatchDir h
waitFor ResumeWatcher runWatcher
where
hook a = Just <$> asIO2 (runHandler a)
2012-06-13 16:36:33 +00:00
waitFor :: WatcherControl -> Assistant () -> Assistant ()
waitFor sig next = do
2013-10-03 02:59:07 +00:00
r <- liftIO (E.try pause :: IO (Either E.SomeException ()))
case r of
Left e -> case E.fromException e of
Just s
| s == sig -> next
_ -> noop
_ -> noop
where
pause = runEvery (Seconds 86400) noop
2012-06-19 02:13:39 +00:00
{- Initial scartup scan. The action should return once the scan is complete. -}
startupScan :: IO a -> Assistant a
startupScan scanner = do
liftAnnex $ showAction "scanning"
2012-10-29 20:49:47 +00:00
alertWhile' startupScanAlert $ do
2013-10-03 02:59:07 +00:00
r <- liftIO scanner
2012-06-19 02:13:39 +00:00
2012-07-29 23:05:51 +00:00
-- Notice any files that were deleted before
-- watching was started.
top <- liftAnnex $ fromRepo Git.repoPath
(fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [] [top]
forM_ fs $ \f -> do
let f' = fromRawFilePath f
liftAnnex $ onDel' f'
maybe noop recordChange =<< madeChange f' RmChange
2013-10-03 02:59:07 +00:00
void $ liftIO cleanup
liftAnnex $ showAction "started"
liftIO $ putStrLn ""
modifyDaemonStatus_ $ \s -> s { scanComplete = True }
2012-07-30 20:32:32 +00:00
-- Ensure that the Committer sees any changes
-- that it did not process, and acts on them now that
-- the scan is complete.
refillChanges =<< getAnyChanges
2012-07-30 20:32:32 +00:00
return (True, r)
2012-06-19 02:13:39 +00:00
gitignore support for the assistant and watcher Requires git 1.8.4 or newer. When it's installed, a background git check-ignore process is run, and used to efficiently check ignores whenever a new file is added. Thanks to Adam Spiers, for getting the necessary support into git for this. A complication is what to do about files that are gitignored but have been checked into git anyway. git commands assume the ignore has been overridden in this case, and not need any more overriding to commit a changed version. However, for the assistant to do the same, it would have to run git ls-files to check if the ignored file is in git. This is somewhat expensive. Or it could use the running git-cat-file process to query the file that way, but that requires transferring the whole file content over a pipe, so it can be quite expensive too, for files that are not git-annex symlinks. Now imagine if the user knows that a file or directory tree will be getting frequent changes, and doesn't want the assistant to sync it, so gitignores it. The assistant could overload the system with repeated ls-files checks! So, I've decided that the assistant will not automatically commit changes to files that are gitignored. This is a tradeoff. Hopefully it won't be a problem to adjust .gitignore settings to not ignore files you want the assistant to autocommit, or to manually git annex add files that are listed in .gitignore. (This could be revisited if git-annex gets access to an interface to check the content of the index w/o forking a git command. This could be libgit2, or perhaps a separate git cat-file --batch-check process, so it wouldn't need to ship over the whole file content.) This commit was sponsored by Francois Marier. Thanks!
2013-08-02 23:31:55 +00:00
{- Hardcoded ignores, passed to the DirWatcher so it can avoid looking
- at the entire .git directory. Does not include .gitignores. -}
2012-06-13 16:36:33 +00:00
ignored :: FilePath -> Bool
ignored = ig . takeFileName
where
ig ".git" = True
ig ".gitignore" = True
ig ".gitattributes" = True
2013-01-28 04:13:22 +00:00
#ifdef darwin_HOST_OS
ig ".DS_Store" = True
#endif
ig _ = False
gitignore support for the assistant and watcher Requires git 1.8.4 or newer. When it's installed, a background git check-ignore process is run, and used to efficiently check ignores whenever a new file is added. Thanks to Adam Spiers, for getting the necessary support into git for this. A complication is what to do about files that are gitignored but have been checked into git anyway. git commands assume the ignore has been overridden in this case, and not need any more overriding to commit a changed version. However, for the assistant to do the same, it would have to run git ls-files to check if the ignored file is in git. This is somewhat expensive. Or it could use the running git-cat-file process to query the file that way, but that requires transferring the whole file content over a pipe, so it can be quite expensive too, for files that are not git-annex symlinks. Now imagine if the user knows that a file or directory tree will be getting frequent changes, and doesn't want the assistant to sync it, so gitignores it. The assistant could overload the system with repeated ls-files checks! So, I've decided that the assistant will not automatically commit changes to files that are gitignored. This is a tradeoff. Hopefully it won't be a problem to adjust .gitignore settings to not ignore files you want the assistant to autocommit, or to manually git annex add files that are listed in .gitignore. (This could be revisited if git-annex gets access to an interface to check the content of the index w/o forking a git command. This could be libgit2, or perhaps a separate git cat-file --batch-check process, so it wouldn't need to ship over the whole file content.) This commit was sponsored by Francois Marier. Thanks!
2013-08-02 23:31:55 +00:00
unlessIgnored :: FilePath -> Assistant (Maybe Change) -> Assistant (Maybe Change)
unlessIgnored file a = ifM (liftAnnex $ checkIgnored (CheckGitIgnore True) (toRawFilePath file))
gitignore support for the assistant and watcher Requires git 1.8.4 or newer. When it's installed, a background git check-ignore process is run, and used to efficiently check ignores whenever a new file is added. Thanks to Adam Spiers, for getting the necessary support into git for this. A complication is what to do about files that are gitignored but have been checked into git anyway. git commands assume the ignore has been overridden in this case, and not need any more overriding to commit a changed version. However, for the assistant to do the same, it would have to run git ls-files to check if the ignored file is in git. This is somewhat expensive. Or it could use the running git-cat-file process to query the file that way, but that requires transferring the whole file content over a pipe, so it can be quite expensive too, for files that are not git-annex symlinks. Now imagine if the user knows that a file or directory tree will be getting frequent changes, and doesn't want the assistant to sync it, so gitignores it. The assistant could overload the system with repeated ls-files checks! So, I've decided that the assistant will not automatically commit changes to files that are gitignored. This is a tradeoff. Hopefully it won't be a problem to adjust .gitignore settings to not ignore files you want the assistant to autocommit, or to manually git annex add files that are listed in .gitignore. (This could be revisited if git-annex gets access to an interface to check the content of the index w/o forking a git command. This could be libgit2, or perhaps a separate git cat-file --batch-check process, so it wouldn't need to ship over the whole file content.) This commit was sponsored by Francois Marier. Thanks!
2013-08-02 23:31:55 +00:00
( noChange
, a
)
type Handler = FilePath -> Maybe FileStatus -> Assistant (Maybe Change)
2012-06-13 16:36:33 +00:00
{- Runs an action handler, and if there was a change, adds it to the ChangeChan.
2012-06-13 16:36:33 +00:00
-
- Exceptions are ignored, otherwise a whole watcher thread could be crashed.
-}
runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
runHandler handler file filestatus = void $ do
r <- tryIO <~> handler (normalize file) filestatus
2012-06-13 16:36:33 +00:00
case r of
Left e -> liftAnnex $ warning $ UnquotedString $ show e
2012-06-13 16:36:33 +00:00
Right Nothing -> noop
Right (Just change) -> recordChange change
where
normalize f
| "./" `isPrefixOf` file = drop 2 f
| otherwise = f
2012-06-13 16:36:33 +00:00
shouldRestage :: DaemonStatus -> Bool
shouldRestage ds = scanComplete ds || forceRestage ds
onAddFile :: Bool -> Handler
onAddFile symlinkssupported f fs =
onAddFile' contentchanged addassociatedfile addlink samefilestatus symlinkssupported f fs
where
addassociatedfile key file =
Database.Keys.addAssociatedFile key
=<< inRepo (toTopFilePath (toRawFilePath file))
samefilestatus key file status = do
cache <- Database.Keys.getInodeCaches key
curr <- withTSDelta $ \delta ->
liftIO $ toInodeCache delta (toRawFilePath file) status
case (cache, curr) of
(_, Just c) -> elemInodeCaches c cache
([], Nothing) -> return True
_ -> return False
contentchanged oldkey file = do
Database.Keys.removeAssociatedFile oldkey
=<< inRepo (toTopFilePath (toRawFilePath file))
unlessM (inAnnex oldkey) $
logStatus oldkey InfoMissing
2016-05-16 17:19:02 +00:00
addlink file key = do
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (toRawFilePath file)
liftAnnex $ stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key
2016-05-16 17:19:02 +00:00
madeChange file $ LinkChange (Just key)
onAddFile'
:: (Key -> FilePath -> Annex ())
2016-05-16 17:19:02 +00:00
-> (Key -> FilePath -> Annex ())
-> (FilePath -> Key -> Assistant (Maybe Change))
-> (Key -> FilePath -> FileStatus -> Annex Bool)
-> Bool
-> Handler
onAddFile' contentchanged addassociatedfile addlink samefilestatus symlinkssupported file fs = do
v <- liftAnnex $ catKeyFile (toRawFilePath file)
case (v, fs) of
(Just key, Just filestatus) ->
ifM (liftAnnex $ samefilestatus key file filestatus)
{- It's possible to get an add event for
- an existing file that is not
- really modified, but it might have
- just been deleted and been put back,
2016-05-16 17:19:02 +00:00
- so its annex link is restaged to make sure. -}
( ifM (shouldRestage <$> getDaemonStatus)
2016-05-16 17:19:02 +00:00
( addlink file key
, noChange
)
, guardSymlinkStandin (Just key) $ do
debug ["changed", file]
liftAnnex $ contentchanged key file
pendingAddChange file
)
gitignore support for the assistant and watcher Requires git 1.8.4 or newer. When it's installed, a background git check-ignore process is run, and used to efficiently check ignores whenever a new file is added. Thanks to Adam Spiers, for getting the necessary support into git for this. A complication is what to do about files that are gitignored but have been checked into git anyway. git commands assume the ignore has been overridden in this case, and not need any more overriding to commit a changed version. However, for the assistant to do the same, it would have to run git ls-files to check if the ignored file is in git. This is somewhat expensive. Or it could use the running git-cat-file process to query the file that way, but that requires transferring the whole file content over a pipe, so it can be quite expensive too, for files that are not git-annex symlinks. Now imagine if the user knows that a file or directory tree will be getting frequent changes, and doesn't want the assistant to sync it, so gitignores it. The assistant could overload the system with repeated ls-files checks! So, I've decided that the assistant will not automatically commit changes to files that are gitignored. This is a tradeoff. Hopefully it won't be a problem to adjust .gitignore settings to not ignore files you want the assistant to autocommit, or to manually git annex add files that are listed in .gitignore. (This could be revisited if git-annex gets access to an interface to check the content of the index w/o forking a git command. This could be libgit2, or perhaps a separate git cat-file --batch-check process, so it wouldn't need to ship over the whole file content.) This commit was sponsored by Francois Marier. Thanks!
2013-08-02 23:31:55 +00:00
_ -> unlessIgnored file $
guardSymlinkStandin Nothing $ do
debug ["add", file]
pendingAddChange file
where
{- On a filesystem without symlinks, we'll get changes for regular
- files that git uses to stand-in for symlinks. Detect when
- this happens, and stage the symlink, rather than annexing the
- file. -}
guardSymlinkStandin mk a
| symlinkssupported = a
| otherwise = do
linktarget <- liftAnnex $ getAnnexLinkTarget $
toRawFilePath file
case linktarget of
Nothing -> a
Just lt -> do
case parseLinkTargetOrPointer lt of
Nothing -> noop
Just key -> liftAnnex $
addassociatedfile key file
onAddSymlink' (Just lt) mk file fs
2012-06-13 16:36:33 +00:00
{- A symlink might be an arbitrary symlink, which is just added.
- Or, if it is a git-annex symlink, ensure it points to the content
- before adding it.
-}
onAddSymlink :: Handler
onAddSymlink file filestatus = unlessIgnored file $ do
linktarget <- liftIO (catchMaybeIO $ R.readSymbolicLink file')
kv <- liftAnnex (lookupKey file')
onAddSymlink' linktarget kv file filestatus
where
file' = toRawFilePath file
onAddSymlink' :: Maybe LinkTarget -> Maybe Key -> Handler
onAddSymlink' linktarget mk file filestatus = go mk
where
go (Just key) = do
link <- liftAnnex $ calcRepo $ gitAnnexLink (toRawFilePath file) key
if linktarget == Just link
then ensurestaged (Just link) =<< getDaemonStatus
else do
liftAnnex $ replaceWorkTreeFile file $
makeAnnexLink link
addLink file link (Just key)
-- other symlink, not git-annex
go Nothing = ensurestaged linktarget =<< getDaemonStatus
{- This is often called on symlinks that are already
- staged correctly. A symlink may have been deleted
- and being re-added, or added when the watcher was
- not running. So they're normally restaged to make sure.
-
- As an optimisation, during the startup scan, avoid
- restaging everything. Only links that were created since
- the last time the daemon was running are staged.
- (If the daemon has never ran before, avoid staging
- links too.)
-}
ensurestaged (Just link) daemonstatus
| shouldRestage daemonstatus = addLink file link mk
| otherwise = case filestatus of
2012-10-29 15:58:29 +00:00
Just s
2012-10-29 23:30:23 +00:00
| not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
_ -> addLink file link mk
ensurestaged Nothing _ = noChange
{- For speed, tries to reuse the existing blob for symlink target. -}
addLink :: FilePath -> LinkTarget -> Maybe Key -> Assistant (Maybe Change)
addLink file link mk = do
debug ["add symlink", file]
liftAnnex $ do
v <- catObjectDetails $ Ref $ encodeBS $ ':':file
case v of
2013-10-20 21:50:51 +00:00
Just (currlink, sha, _type)
| L.fromStrict link == currlink ->
stageSymlink (toRawFilePath file) sha
_ -> stageSymlink (toRawFilePath file)
=<< hashSymlink link
madeChange file $ LinkChange mk
2012-06-13 16:36:33 +00:00
onDel :: Handler
onDel file _ = do
debug ["file deleted", file]
liftAnnex $ onDel' file
2012-10-29 23:30:23 +00:00
madeChange file RmChange
2012-06-13 16:36:33 +00:00
onDel' :: FilePath -> Annex ()
onDel' file = do
topfile <- inRepo (toTopFilePath (toRawFilePath file))
withkey $ flip Database.Keys.removeAssociatedFile topfile
Annex.Queue.addUpdateIndex =<<
2023-02-27 19:02:53 +00:00
inRepo (Git.UpdateIndex.unstageFile (toRawFilePath file))
where
withkey a = maybe noop a =<< catKeyFile (toRawFilePath file)
2012-06-13 16:36:33 +00:00
{- A directory has been deleted, or moved, so tell git to remove anything
- that was inside it from its cache. Since it could reappear at any time,
- use --cached to only delete it from the index.
2012-06-13 16:36:33 +00:00
-
- This queues up a lot of RmChanges, which assists the Committer in
- pairing up renamed files when the directory was renamed. -}
2012-06-13 16:36:33 +00:00
onDelDir :: Handler
onDelDir dir _ = do
debug ["directory deleted", dir]
(fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [] [toRawFilePath dir]
let fs' = map fromRawFilePath fs
liftAnnex $ mapM_ onDel' fs'
-- Get the events queued up as fast as possible, so the
-- committer sees them all in one block.
now <- liftIO getCurrentTime
recordChanges $ map (\f -> Change now f RmChange) fs'
2013-10-03 02:59:07 +00:00
void $ liftIO clean
noChange
2012-06-13 16:36:33 +00:00
{- Called when there's an error with inotify or kqueue. -}
2012-06-13 16:36:33 +00:00
onErr :: Handler
onErr msg _ = do
liftAnnex $ warning (UnquotedString msg)
void $ addAlert $ warningAlert "watcher" msg
2012-10-29 23:30:23 +00:00
noChange