add annex.delayadd configuration
This commit is contained in:
parent
da8c8c3ccd
commit
355ef8f3ea
3 changed files with 32 additions and 19 deletions
|
@ -93,7 +93,7 @@ check st dstatus transferqueue changechan = do
|
||||||
runThreadState st $ warning msg
|
runThreadState st $ warning msg
|
||||||
void $ addAlert dstatus $ sanityCheckFixAlert msg
|
void $ addAlert dstatus $ sanityCheckFixAlert msg
|
||||||
addsymlink file s = do
|
addsymlink file s = do
|
||||||
Watcher.runHandler thisThread st dstatus
|
Watcher.runHandler thisThread Nothing st dstatus
|
||||||
transferqueue changechan
|
transferqueue changechan
|
||||||
Watcher.onAddSymlink file s
|
Watcher.onAddSymlink file s
|
||||||
insanity $ "found unstaged symlink: " ++ file
|
insanity $ "found unstaged symlink: " ++ file
|
||||||
|
|
|
@ -34,6 +34,8 @@ import qualified Command.Add
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.CatFile
|
import Annex.CatFile
|
||||||
import Git.Types
|
import Git.Types
|
||||||
|
import Config
|
||||||
|
import Utility.ThreadScheduler
|
||||||
|
|
||||||
import Data.Bits.Utils
|
import Data.Bits.Utils
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
@ -58,17 +60,19 @@ needLsof = error $ unlines
|
||||||
|
|
||||||
watchThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> NamedThread
|
watchThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> NamedThread
|
||||||
watchThread st dstatus transferqueue changechan = NamedThread thisThread $ do
|
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", "."]
|
debug thisThread [ "watching", "."]
|
||||||
where
|
where
|
||||||
startup = startupScan st dstatus
|
startup = startupScan st dstatus
|
||||||
hook a = Just $ runHandler thisThread st dstatus transferqueue changechan a
|
hook delay a = Just $ runHandler thisThread delay st dstatus transferqueue changechan a
|
||||||
hooks = WatchHooks
|
hooks delayadd = WatchHooks
|
||||||
{ addHook = hook onAdd
|
{ addHook = hook (Seconds <$> delayadd) onAdd
|
||||||
, delHook = hook onDel
|
, delHook = hook Nothing onDel
|
||||||
, addSymlinkHook = hook onAddSymlink
|
, addSymlinkHook = hook Nothing onAddSymlink
|
||||||
, delDirHook = hook onDelDir
|
, delDirHook = hook Nothing onDelDir
|
||||||
, errHook = hook onErr
|
, errHook = hook Nothing onErr
|
||||||
}
|
}
|
||||||
|
|
||||||
{- Initial scartup scan. The action should return once the scan is complete. -}
|
{- Initial scartup scan. The action should return once the scan is complete. -}
|
||||||
|
@ -96,22 +100,22 @@ ignored = ig . takeFileName
|
||||||
ig ".gitattributes" = True
|
ig ".gitattributes" = True
|
||||||
ig _ = False
|
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
|
{- Runs an action handler, inside the Annex monad, and if there was a
|
||||||
- change, adds it to the ChangeChan.
|
- change, adds it to the ChangeChan.
|
||||||
-
|
-
|
||||||
- Exceptions are ignored, otherwise a whole watcher thread could be crashed.
|
- Exceptions are ignored, otherwise a whole watcher thread could be crashed.
|
||||||
-}
|
-}
|
||||||
runHandler :: ThreadName -> ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
|
runHandler :: ThreadName -> Maybe Seconds -> ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
|
||||||
runHandler threadname st dstatus transferqueue changechan handler file filestatus = void $ do
|
runHandler threadname delay st dstatus transferqueue changechan handler file filestatus = void $ do
|
||||||
r <- tryIO go
|
r <- tryIO go
|
||||||
case r of
|
case r of
|
||||||
Left e -> print e
|
Left e -> print e
|
||||||
Right Nothing -> noop
|
Right Nothing -> noop
|
||||||
Right (Just change) -> recordChange changechan change
|
Right (Just change) -> recordChange changechan change
|
||||||
where
|
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
|
{- 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
|
- 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.
|
- the add.
|
||||||
-}
|
-}
|
||||||
onAdd :: Handler
|
onAdd :: Handler
|
||||||
onAdd threadname file filestatus dstatus _
|
onAdd threadname delay file filestatus dstatus _
|
||||||
| maybe False isRegularFile filestatus =
|
| maybe False isRegularFile filestatus =
|
||||||
ifM (scanComplete <$> liftIO (getDaemonStatus dstatus))
|
ifM (scanComplete <$> liftIO (getDaemonStatus dstatus))
|
||||||
( go
|
( go
|
||||||
|
@ -144,7 +148,9 @@ onAdd threadname file filestatus dstatus _
|
||||||
| otherwise = noChange
|
| otherwise = noChange
|
||||||
where
|
where
|
||||||
go = do
|
go = do
|
||||||
liftIO $ debug threadname ["file added", file]
|
liftIO $ do
|
||||||
|
debug threadname ["file added", file]
|
||||||
|
maybe noop threadDelaySeconds delay
|
||||||
pendingAddChange =<< Command.Add.lockDown file
|
pendingAddChange =<< Command.Add.lockDown file
|
||||||
|
|
||||||
{- A symlink might be an arbitrary symlink, which is just added.
|
{- A symlink might be an arbitrary symlink, which is just added.
|
||||||
|
@ -152,7 +158,7 @@ onAdd threadname file filestatus dstatus _
|
||||||
- before adding it.
|
- before adding it.
|
||||||
-}
|
-}
|
||||||
onAddSymlink :: Handler
|
onAddSymlink :: Handler
|
||||||
onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
|
onAddSymlink threadname _ file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
|
||||||
where
|
where
|
||||||
go (Just (key, _)) = do
|
go (Just (key, _)) = do
|
||||||
link <- calcGitLink file key
|
link <- calcGitLink file key
|
||||||
|
@ -213,7 +219,7 @@ onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.l
|
||||||
| otherwise = noop
|
| otherwise = noop
|
||||||
|
|
||||||
onDel :: Handler
|
onDel :: Handler
|
||||||
onDel threadname file _ _dstatus _ = do
|
onDel threadname _ file _ _dstatus _ = do
|
||||||
liftIO $ debug threadname ["file deleted", file]
|
liftIO $ debug threadname ["file deleted", file]
|
||||||
Annex.Queue.addUpdateIndex =<<
|
Annex.Queue.addUpdateIndex =<<
|
||||||
inRepo (Git.UpdateIndex.unstageFile file)
|
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
|
- command to get the recursive list of files in the directory, so rm is
|
||||||
- just as good. -}
|
- just as good. -}
|
||||||
onDelDir :: Handler
|
onDelDir :: Handler
|
||||||
onDelDir threadname dir _ _dstatus _ = do
|
onDelDir threadname _ dir _ _dstatus _ = do
|
||||||
liftIO $ debug threadname ["directory deleted", dir]
|
liftIO $ debug threadname ["directory deleted", dir]
|
||||||
Annex.Queue.addCommand "rm"
|
Annex.Queue.addCommand "rm"
|
||||||
[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
|
[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. -}
|
{- Called when there's an error with inotify or kqueue. -}
|
||||||
onErr :: Handler
|
onErr :: Handler
|
||||||
onErr _ msg _ dstatus _ = do
|
onErr _ _ msg _ dstatus _ = do
|
||||||
warning msg
|
warning msg
|
||||||
void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
|
void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
|
||||||
return Nothing
|
return Nothing
|
||||||
|
|
|
@ -679,6 +679,13 @@ Here are all the supported configuration settings.
|
||||||
set to `false`. Then data will only be committed when
|
set to `false`. Then data will only be committed when
|
||||||
running `git annex merge` (or by automatic merges) or `git annex sync`.
|
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`
|
* `remote.<name>.annex-cost`
|
||||||
|
|
||||||
When determining which repository to
|
When determining which repository to
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue