2012-06-13 16:36:33 +00:00
|
|
|
{- git-annex assistant tree watcher
|
|
|
|
-
|
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
|
|
|
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
|
2012-06-13 16:36:33 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2013-10-03 02:59:07 +00:00
|
|
|
{-# LANGUAGE DeriveDataTypeable, CPP #-}
|
2013-01-27 11:43:05 +00:00
|
|
|
|
2012-07-20 23:29:59 +00:00
|
|
|
module Assistant.Threads.Watcher (
|
|
|
|
watchThread,
|
2013-10-26 20:54:49 +00:00
|
|
|
WatcherControl(..),
|
2012-07-20 23:29:59 +00:00
|
|
|
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
|
2012-07-29 15:31:06 +00:00
|
|
|
import Assistant.Alert
|
2012-06-19 03:47:48 +00:00
|
|
|
import Utility.DirWatcher
|
2013-03-11 02:24:13 +00:00
|
|
|
import Utility.DirWatcher.Types
|
2013-10-03 20:57:21 +00:00
|
|
|
import qualified Utility.Lsof as Lsof
|
2012-06-20 23:04:16 +00:00
|
|
|
import qualified Annex
|
2012-06-13 16:36:33 +00:00
|
|
|
import qualified Annex.Queue
|
2012-12-24 18:24:13 +00:00
|
|
|
import qualified Git
|
2012-06-13 16:36:33 +00:00
|
|
|
import qualified Git.UpdateIndex
|
2012-12-24 18:24:13 +00:00
|
|
|
import qualified Git.LsFiles as LsFiles
|
2012-06-13 16:36:33 +00:00
|
|
|
import qualified Backend
|
2012-12-25 19:48:15 +00:00
|
|
|
import Annex.Direct
|
|
|
|
import Annex.Content.Direct
|
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
|
2013-03-29 20:17:13 +00:00
|
|
|
import Annex.FileMatcher
|
2013-05-17 19:59:37 +00:00
|
|
|
import Annex.ReplaceFile
|
2012-06-13 16:36:33 +00:00
|
|
|
import Git.Types
|
2012-12-24 18:42:19 +00:00
|
|
|
import Config
|
2013-01-27 11:43:05 +00:00
|
|
|
import Utility.ThreadScheduler
|
2012-06-13 16:36:33 +00:00
|
|
|
|
|
|
|
import Data.Bits.Utils
|
2013-01-27 11:43:05 +00:00
|
|
|
import Data.Typeable
|
2012-06-13 16:36:33 +00:00
|
|
|
import qualified Data.ByteString.Lazy as L
|
2013-01-27 11:43:05 +00:00
|
|
|
import qualified Control.Exception as E
|
2013-03-11 19:14:42 +00:00
|
|
|
import Data.Time.Clock
|
2012-06-13 16:36:33 +00:00
|
|
|
|
2012-06-17 18:02:58 +00:00
|
|
|
checkCanWatch :: Annex ()
|
2012-06-19 03:47:48 +00:00
|
|
|
checkCanWatch
|
2012-12-14 19:52:44 +00:00
|
|
|
| canWatch = do
|
2013-12-09 20:56:15 +00:00
|
|
|
#ifndef mingw32_HOST_OS
|
2013-10-03 20:57:21 +00:00
|
|
|
liftIO Lsof.setup
|
2012-09-13 04:57:52 +00:00
|
|
|
unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force)
|
2012-06-19 03:47:48 +00:00
|
|
|
needLsof
|
2013-12-09 20:56:15 +00:00
|
|
|
#else
|
|
|
|
noop
|
|
|
|
#endif
|
2012-06-19 03:47:48 +00:00
|
|
|
| otherwise = error "watch mode is not available on this system"
|
2012-06-17 18:02:58 +00:00
|
|
|
|
|
|
|
needLsof :: Annex ()
|
|
|
|
needLsof = error $ 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."
|
|
|
|
]
|
|
|
|
|
2013-01-27 11:43:05 +00:00
|
|
|
{- A special exception that can be thrown to pause or resume the watcher. -}
|
2013-10-26 20:54:49 +00:00
|
|
|
data WatcherControl = PauseWatcher | ResumeWatcher
|
2013-01-27 11:43:05 +00:00
|
|
|
deriving (Show, Eq, Typeable)
|
|
|
|
|
2013-10-26 20:54:49 +00:00
|
|
|
instance E.Exception WatcherControl
|
2013-01-27 11:43:05 +00:00
|
|
|
|
2012-10-29 13:55:40 +00:00
|
|
|
watchThread :: NamedThread
|
2013-01-27 11:43:05 +00:00
|
|
|
watchThread = namedThread "Watcher" $
|
|
|
|
ifM (liftAnnex $ annexAutoCommit <$> Annex.getGitConfig)
|
|
|
|
( runWatcher
|
|
|
|
, waitFor ResumeWatcher runWatcher
|
|
|
|
)
|
|
|
|
|
|
|
|
runWatcher :: Assistant ()
|
|
|
|
runWatcher = do
|
2012-10-30 21:14:26 +00:00
|
|
|
startup <- asIO1 startupScan
|
2013-10-03 02:59:07 +00:00
|
|
|
matcher <- liftAnnex largeFilesMatcher
|
2012-12-24 18:42:19 +00:00
|
|
|
direct <- liftAnnex isDirect
|
2013-04-10 23:57:11 +00:00
|
|
|
symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig
|
|
|
|
addhook <- hook $ if direct
|
|
|
|
then onAddDirect symlinkssupported matcher
|
|
|
|
else onAdd matcher
|
2012-10-29 13:55:40 +00:00
|
|
|
delhook <- hook onDel
|
2013-03-04 18:25:18 +00:00
|
|
|
addsymlinkhook <- hook $ onAddSymlink direct
|
2012-10-29 13:55:40 +00:00
|
|
|
deldirhook <- hook onDelDir
|
|
|
|
errhook <- hook onErr
|
|
|
|
let hooks = mkWatchHooks
|
|
|
|
{ addHook = addhook
|
|
|
|
, delHook = delhook
|
|
|
|
, addSymlinkHook = addsymlinkhook
|
|
|
|
, delDirHook = deldirhook
|
|
|
|
, errHook = errhook
|
2012-10-29 04:15:43 +00:00
|
|
|
}
|
2013-01-27 11:43:05 +00:00
|
|
|
handle <- liftIO $ watchDir "." ignored hooks startup
|
2012-10-29 13:55:40 +00:00
|
|
|
debug [ "watching", "."]
|
2013-01-27 11:43:05 +00:00
|
|
|
|
|
|
|
{- Let the DirWatcher thread run until signalled to pause it,
|
|
|
|
- then wait for a resume signal, and restart. -}
|
|
|
|
waitFor PauseWatcher $ do
|
|
|
|
liftIO $ stopWatchDir handle
|
|
|
|
waitFor ResumeWatcher runWatcher
|
2012-10-29 13:55:40 +00:00
|
|
|
where
|
|
|
|
hook a = Just <$> asIO2 (runHandler a)
|
2012-06-13 16:36:33 +00:00
|
|
|
|
2013-10-26 20:54:49 +00:00
|
|
|
waitFor :: WatcherControl -> Assistant () -> Assistant ()
|
2013-01-27 11:43:05 +00:00
|
|
|
waitFor sig next = do
|
2013-10-03 02:59:07 +00:00
|
|
|
r <- liftIO (E.try pause :: IO (Either E.SomeException ()))
|
2013-01-27 11:43:05 +00:00
|
|
|
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. -}
|
2012-10-29 13:55:40 +00:00
|
|
|
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.
|
2012-12-24 18:24:13 +00:00
|
|
|
top <- liftAnnex $ fromRepo Git.repoPath
|
|
|
|
(fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [top]
|
|
|
|
forM_ fs $ \f -> do
|
2013-04-24 21:46:46 +00:00
|
|
|
liftAnnex $ onDel' f
|
2012-12-24 18:24:13 +00:00
|
|
|
maybe noop recordChange =<< madeChange f RmChange
|
2013-10-03 02:59:07 +00:00
|
|
|
void $ liftIO cleanup
|
2012-12-24 18:24:13 +00:00
|
|
|
|
|
|
|
liftAnnex $ showAction "started"
|
2013-01-15 17:34:59 +00:00
|
|
|
liftIO $ putStrLn ""
|
2012-07-30 06:07:02 +00:00
|
|
|
|
2012-10-30 19:39:15 +00:00
|
|
|
modifyDaemonStatus_ $ \s -> s { scanComplete = True }
|
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
|
2012-06-18 17:01:58 +00:00
|
|
|
ignored = ig . takeFileName
|
2012-10-29 04:15:43 +00:00
|
|
|
where
|
2012-06-18 17:01:58 +00:00
|
|
|
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
|
2012-06-18 17:01:58 +00:00
|
|
|
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 file)
|
|
|
|
( noChange
|
|
|
|
, a
|
|
|
|
)
|
|
|
|
|
2012-10-29 13:55:40 +00:00
|
|
|
type Handler = FilePath -> Maybe FileStatus -> Assistant (Maybe Change)
|
2012-06-13 16:36:33 +00:00
|
|
|
|
2012-10-29 13:55:40 +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.
|
|
|
|
-}
|
2012-10-29 13:55:40 +00:00
|
|
|
runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
|
|
|
|
runHandler handler file filestatus = void $ do
|
2013-04-02 20:20:23 +00:00
|
|
|
r <- tryIO <~> handler (normalize file) filestatus
|
2012-06-13 16:36:33 +00:00
|
|
|
case r of
|
2012-10-29 13:55:40 +00:00
|
|
|
Left e -> liftIO $ print e
|
2012-06-13 16:36:33 +00:00
|
|
|
Right Nothing -> noop
|
2012-10-29 13:55:40 +00:00
|
|
|
Right (Just change) -> do
|
|
|
|
-- Just in case the commit thread is not
|
|
|
|
-- flushing the queue fast enough.
|
2013-10-03 02:59:07 +00:00
|
|
|
liftAnnex Annex.Queue.flushWhenFull
|
2012-10-29 23:30:23 +00:00
|
|
|
recordChange change
|
2013-04-02 20:20:23 +00:00
|
|
|
where
|
|
|
|
normalize f
|
|
|
|
| "./" `isPrefixOf` file = drop 2 f
|
|
|
|
| otherwise = f
|
2012-06-13 16:36:33 +00:00
|
|
|
|
2013-03-29 20:54:59 +00:00
|
|
|
{- Small files are added to git as-is, while large ones go into the annex. -}
|
|
|
|
add :: FileMatcher -> FilePath -> Assistant (Maybe Change)
|
|
|
|
add bigfilematcher file = ifM (liftAnnex $ checkFileMatcher bigfilematcher file)
|
2013-03-29 20:17:13 +00:00
|
|
|
( pendingAddChange file
|
2013-03-29 20:54:59 +00:00
|
|
|
, do
|
|
|
|
liftAnnex $ Annex.Queue.addCommand "add"
|
|
|
|
[Params "--force --"] [file]
|
|
|
|
madeChange file AddFileChange
|
2013-03-29 20:17:13 +00:00
|
|
|
)
|
|
|
|
|
|
|
|
onAdd :: FileMatcher -> Handler
|
|
|
|
onAdd matcher file filestatus
|
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
|
|
|
| maybe False isRegularFile filestatus =
|
|
|
|
unlessIgnored file $
|
|
|
|
add matcher file
|
2012-10-29 23:30:23 +00:00
|
|
|
| otherwise = noChange
|
2012-06-13 16:36:33 +00:00
|
|
|
|
2013-11-13 18:27:17 +00:00
|
|
|
shouldRestage :: DaemonStatus -> Bool
|
|
|
|
shouldRestage ds = scanComplete ds || forceRestage ds
|
|
|
|
|
2012-12-25 19:48:15 +00:00
|
|
|
{- In direct mode, add events are received for both new files, and
|
2013-04-10 23:57:11 +00:00
|
|
|
- modified existing files.
|
|
|
|
-}
|
|
|
|
onAddDirect :: Bool -> FileMatcher -> Handler
|
|
|
|
onAddDirect symlinkssupported matcher file fs = do
|
2013-01-05 19:26:22 +00:00
|
|
|
v <- liftAnnex $ catKeyFile file
|
2012-12-25 19:48:15 +00:00
|
|
|
case (v, fs) of
|
|
|
|
(Just key, Just filestatus) ->
|
2013-02-22 21:01:48 +00:00
|
|
|
ifM (liftAnnex $ sameFileStatus key filestatus)
|
2013-04-02 16:58:56 +00:00
|
|
|
{- 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,
|
|
|
|
- so it symlink is restaged to make sure. -}
|
2013-11-13 18:27:17 +00:00
|
|
|
( ifM (shouldRestage <$> getDaemonStatus)
|
2013-04-25 01:20:29 +00:00
|
|
|
( do
|
|
|
|
link <- liftAnnex $ inRepo $ gitAnnexLink file key
|
|
|
|
addLink file link (Just key)
|
|
|
|
, noChange
|
|
|
|
)
|
2013-04-10 23:57:11 +00:00
|
|
|
, guardSymlinkStandin (Just key) $ do
|
2013-04-02 16:58:56 +00:00
|
|
|
debug ["changed direct", file]
|
2012-12-25 19:48:15 +00:00
|
|
|
liftAnnex $ changedDirect key file
|
2013-03-29 20:54:59 +00:00
|
|
|
add matcher file
|
2012-12-25 19:48:15 +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
|
|
|
_ -> unlessIgnored file $
|
|
|
|
guardSymlinkStandin Nothing $ do
|
|
|
|
debug ["add direct", file]
|
|
|
|
add matcher file
|
2013-04-10 23:57:11 +00:00
|
|
|
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 file
|
|
|
|
case linktarget of
|
|
|
|
Nothing -> a
|
|
|
|
Just lt -> do
|
|
|
|
case fileKey $ takeFileName lt of
|
|
|
|
Nothing -> noop
|
|
|
|
Just key -> void $ liftAnnex $
|
|
|
|
addAssociatedFile key file
|
|
|
|
onAddSymlink' linktarget mk True file fs
|
2012-12-25 19:48:15 +00:00
|
|
|
|
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.
|
|
|
|
-}
|
2013-03-04 18:25:18 +00:00
|
|
|
onAddSymlink :: Bool -> Handler
|
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
|
|
|
onAddSymlink isdirect file filestatus = unlessIgnored file $ do
|
2013-04-10 23:57:11 +00:00
|
|
|
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
|
|
|
|
kv <- liftAnnex (Backend.lookupFile file)
|
|
|
|
onAddSymlink' linktarget (fmap fst kv) isdirect file filestatus
|
|
|
|
|
|
|
|
onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler
|
|
|
|
onAddSymlink' linktarget mk isdirect file filestatus = go mk
|
2012-10-29 04:15:43 +00:00
|
|
|
where
|
2013-04-10 23:57:11 +00:00
|
|
|
go (Just key) = do
|
2013-03-04 18:25:18 +00:00
|
|
|
when isdirect $
|
|
|
|
liftAnnex $ void $ addAssociatedFile key file
|
2013-04-04 19:46:33 +00:00
|
|
|
link <- liftAnnex $ inRepo $ gitAnnexLink file key
|
2013-04-10 23:57:11 +00:00
|
|
|
if linktarget == Just link
|
|
|
|
then ensurestaged (Just link) =<< getDaemonStatus
|
|
|
|
else do
|
2013-04-02 17:13:42 +00:00
|
|
|
unless isdirect $
|
|
|
|
liftAnnex $ replaceFile file $
|
|
|
|
makeAnnexLink link
|
2013-04-02 16:58:56 +00:00
|
|
|
addLink file link (Just key)
|
2013-04-10 23:57:11 +00:00
|
|
|
-- other symlink, not git-annex
|
|
|
|
go Nothing = ensurestaged linktarget =<< getDaemonStatus
|
2012-10-29 04:15:43 +00:00
|
|
|
|
|
|
|
{- 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.)
|
|
|
|
-}
|
2013-04-10 23:57:11 +00:00
|
|
|
ensurestaged (Just link) daemonstatus
|
2013-11-13 18:27:17 +00:00
|
|
|
| shouldRestage daemonstatus = addLink file link mk
|
2012-10-29 04:15:43 +00:00
|
|
|
| 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
|
2013-04-02 16:58:56 +00:00
|
|
|
_ -> addLink file link mk
|
2013-04-10 23:57:11 +00:00
|
|
|
ensurestaged Nothing _ = noChange
|
2012-10-29 04:15:43 +00:00
|
|
|
|
2013-04-02 16:58:56 +00:00
|
|
|
{- For speed, tries to reuse the existing blob for symlink target. -}
|
|
|
|
addLink :: FilePath -> FilePath -> Maybe Key -> Assistant (Maybe Change)
|
|
|
|
addLink file link mk = do
|
|
|
|
debug ["add symlink", file]
|
|
|
|
liftAnnex $ do
|
|
|
|
v <- catObjectDetails $ Ref $ ':':file
|
|
|
|
case v of
|
2013-10-20 21:50:51 +00:00
|
|
|
Just (currlink, sha, _type)
|
2013-04-02 16:58:56 +00:00
|
|
|
| s2w8 link == L.unpack currlink ->
|
|
|
|
stageSymlink file sha
|
|
|
|
_ -> stageSymlink file =<< hashSymlink link
|
|
|
|
madeChange file $ LinkChange mk
|
2012-07-05 16:58:49 +00:00
|
|
|
|
2012-06-13 16:36:33 +00:00
|
|
|
onDel :: Handler
|
2012-10-29 13:55:40 +00:00
|
|
|
onDel file _ = do
|
|
|
|
debug ["file deleted", file]
|
2013-04-24 21:46:46 +00:00
|
|
|
liftAnnex $ onDel' file
|
2012-10-29 23:30:23 +00:00
|
|
|
madeChange file RmChange
|
2012-06-13 16:36:33 +00:00
|
|
|
|
2013-04-24 21:46:46 +00:00
|
|
|
onDel' :: FilePath -> Annex ()
|
|
|
|
onDel' file = do
|
2013-04-24 22:04:59 +00:00
|
|
|
whenM isDirect $ do
|
|
|
|
mkey <- catKeyFile file
|
|
|
|
case mkey of
|
|
|
|
Nothing -> noop
|
|
|
|
Just key -> void $ removeAssociatedFile key file
|
2013-04-24 21:46:46 +00:00
|
|
|
Annex.Queue.addUpdateIndex =<<
|
|
|
|
inRepo (Git.UpdateIndex.unstageFile 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,
|
2013-03-11 19:14:42 +00:00
|
|
|
- use --cached to only delete it from the index.
|
2012-06-13 16:36:33 +00:00
|
|
|
-
|
2013-03-11 19:14:42 +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
|
2012-10-29 13:55:40 +00:00
|
|
|
onDelDir dir _ = do
|
|
|
|
debug ["directory deleted", dir]
|
2013-03-11 19:14:42 +00:00
|
|
|
(fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [dir]
|
|
|
|
|
2013-04-24 21:46:46 +00:00
|
|
|
liftAnnex $ mapM_ onDel' fs
|
2013-03-11 19:14:42 +00:00
|
|
|
|
|
|
|
-- Get the events queued up as fast as possible, so the
|
|
|
|
-- committer sees them all in one block.
|
|
|
|
now <- liftIO getCurrentTime
|
2013-04-24 21:46:46 +00:00
|
|
|
recordChanges $ map (\f -> Change now f RmChange) fs
|
2013-03-11 19:14:42 +00:00
|
|
|
|
2013-10-03 02:59:07 +00:00
|
|
|
void $ liftIO clean
|
|
|
|
liftAnnex Annex.Queue.flushWhenFull
|
2013-03-11 19:14:42 +00:00
|
|
|
noChange
|
2012-06-13 16:36:33 +00:00
|
|
|
|
2012-09-06 17:56:23 +00:00
|
|
|
{- Called when there's an error with inotify or kqueue. -}
|
2012-06-13 16:36:33 +00:00
|
|
|
onErr :: Handler
|
2012-10-29 13:55:40 +00:00
|
|
|
onErr msg _ = do
|
|
|
|
liftAnnex $ warning msg
|
2012-10-30 19:39:15 +00:00
|
|
|
void $ addAlert $ warningAlert "watcher" msg
|
2012-10-29 23:30:23 +00:00
|
|
|
noChange
|