summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Assistant/Threads/SanityChecker.hs2
-rw-r--r--Assistant/Threads/Watcher.hs42
-rw-r--r--doc/git-annex.mdwn7
3 files changed, 32 insertions, 19 deletions
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index 148ae1435..b99d72802 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -93,7 +93,7 @@ check st dstatus transferqueue changechan = do
runThreadState st $ warning msg
void $ addAlert dstatus $ sanityCheckFixAlert msg
addsymlink file s = do
- Watcher.runHandler thisThread st dstatus
+ Watcher.runHandler thisThread Nothing st dstatus
transferqueue changechan
Watcher.onAddSymlink file s
insanity $ "found unstaged symlink: " ++ file
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 17ec0b81f..fa8b7b379 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -34,6 +34,8 @@ import qualified Command.Add
import Annex.Content
import Annex.CatFile
import Git.Types
+import Config
+import Utility.ThreadScheduler
import Data.Bits.Utils
import qualified Data.ByteString.Lazy as L
@@ -58,17 +60,19 @@ needLsof = error $ unlines
watchThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> NamedThread
watchThread st dstatus transferqueue changechan = NamedThread thisThread $ do
- void $ watchDir "." ignored hooks startup
+ delayadd <- runThreadState st $
+ readish <$> getConfig (annexConfig "delayadd") ""
+ void $ watchDir "." ignored (hooks delayadd) startup
debug thisThread [ "watching", "."]
where
startup = startupScan st dstatus
- hook a = Just $ runHandler thisThread st dstatus transferqueue changechan a
- hooks = WatchHooks
- { addHook = hook onAdd
- , delHook = hook onDel
- , addSymlinkHook = hook onAddSymlink
- , delDirHook = hook onDelDir
- , errHook = hook onErr
+ hook delay a = Just $ runHandler thisThread delay st dstatus transferqueue changechan a
+ hooks delayadd = WatchHooks
+ { addHook = hook (Seconds <$> delayadd) onAdd
+ , delHook = hook Nothing onDel
+ , addSymlinkHook = hook Nothing onAddSymlink
+ , delDirHook = hook Nothing onDelDir
+ , errHook = hook Nothing onErr
}
{- Initial scartup scan. The action should return once the scan is complete. -}
@@ -96,22 +100,22 @@ ignored = ig . takeFileName
ig ".gitattributes" = True
ig _ = False
-type Handler = ThreadName -> FilePath -> Maybe FileStatus -> DaemonStatusHandle -> TransferQueue -> Annex (Maybe Change)
+type Handler = ThreadName -> Maybe Seconds -> FilePath -> Maybe FileStatus -> DaemonStatusHandle -> TransferQueue -> Annex (Maybe Change)
{- Runs an action handler, inside the Annex monad, and if there was a
- change, adds it to the ChangeChan.
-
- Exceptions are ignored, otherwise a whole watcher thread could be crashed.
-}
-runHandler :: ThreadName -> ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
-runHandler threadname st dstatus transferqueue changechan handler file filestatus = void $ do
+runHandler :: ThreadName -> Maybe Seconds -> ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
+runHandler threadname delay st dstatus transferqueue changechan handler file filestatus = void $ do
r <- tryIO go
case r of
Left e -> print e
Right Nothing -> noop
Right (Just change) -> recordChange changechan change
where
- go = runThreadState st $ handler threadname file filestatus dstatus transferqueue
+ go = runThreadState st $ handler threadname delay file filestatus dstatus transferqueue
{- During initial directory scan, this will be run for any regular files
- that are already checked into git. We don't want to turn those into
@@ -132,7 +136,7 @@ runHandler threadname st dstatus transferqueue changechan handler file filestatu
- the add.
-}
onAdd :: Handler
-onAdd threadname file filestatus dstatus _
+onAdd threadname delay file filestatus dstatus _
| maybe False isRegularFile filestatus =
ifM (scanComplete <$> liftIO (getDaemonStatus dstatus))
( go
@@ -144,7 +148,9 @@ onAdd threadname file filestatus dstatus _
| otherwise = noChange
where
go = do
- liftIO $ debug threadname ["file added", file]
+ liftIO $ do
+ debug threadname ["file added", file]
+ maybe noop threadDelaySeconds delay
pendingAddChange =<< Command.Add.lockDown file
{- A symlink might be an arbitrary symlink, which is just added.
@@ -152,7 +158,7 @@ onAdd threadname file filestatus dstatus _
- before adding it.
-}
onAddSymlink :: Handler
-onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
+onAddSymlink threadname _ file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
where
go (Just (key, _)) = do
link <- calcGitLink file key
@@ -213,7 +219,7 @@ onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.l
| otherwise = noop
onDel :: Handler
-onDel threadname file _ _dstatus _ = do
+onDel threadname _ file _ _dstatus _ = do
liftIO $ debug threadname ["file deleted", file]
Annex.Queue.addUpdateIndex =<<
inRepo (Git.UpdateIndex.unstageFile file)
@@ -227,7 +233,7 @@ onDel threadname file _ _dstatus _ = do
- command to get the recursive list of files in the directory, so rm is
- just as good. -}
onDelDir :: Handler
-onDelDir threadname dir _ _dstatus _ = do
+onDelDir threadname _ dir _ _dstatus _ = do
liftIO $ debug threadname ["directory deleted", dir]
Annex.Queue.addCommand "rm"
[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
@@ -235,7 +241,7 @@ onDelDir threadname dir _ _dstatus _ = do
{- Called when there's an error with inotify or kqueue. -}
onErr :: Handler
-onErr _ msg _ dstatus _ = do
+onErr _ _ msg _ dstatus _ = do
warning msg
void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
return Nothing
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index e2c881dfb..6cc1fb39d 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -679,6 +679,13 @@ Here are all the supported configuration settings.
set to `false`. Then data will only be committed when
running `git annex merge` (or by automatic merges) or `git annex sync`.
+* `annex.delayadd`
+
+ Makes the watch and assistant commands delay for the specified number of
+ seconds before adding a newly created file to the annex. Normally this
+ is not needed, because they already wait for all writers of the file
+ to close it.
+
* `remote.<name>.annex-cost`
When determining which repository to