addistant: honor annex.delayadd for non-large files

assistant: When adding non-large files to git, honor annex.delayadd
configuration.

Also, don't add non-large files to git when they are still
being written to. This came for free, since the changes to non-large
files get queued up with the ones to large files, and run through the lsof
check.

Sponsored-by: Luke Shumaker on Patreon
This commit is contained in:
Joey Hess 2021-07-13 12:15:40 -04:00
parent 2018cb4a97
commit 8885bd3c5b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 54 additions and 46 deletions

View file

@ -1,6 +1,6 @@
{- git-annex assistant commit thread
-
- Copyright 2012, 2019 Joey Hess <id@joeyh.name>
- Copyright 2012-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -33,6 +33,7 @@ import Annex.Perms
import Annex.CatFile
import Annex.InodeSentinal
import Annex.CurrentBranch
import Annex.FileMatcher
import qualified Annex
import Utility.InodeCache
import qualified Database.Keys
@ -52,6 +53,7 @@ commitThread = namedThread "Committer" $ do
havelsof <- liftIO $ inSearchPath "lsof"
delayadd <- liftAnnex $
fmap Seconds . annexDelayAdd <$> Annex.getGitConfig
largefilematcher <- liftAnnex largeFilesMatcher
msg <- liftAnnex Command.Sync.commitMsg
lockdowndir <- liftAnnex $ fromRepo gitAnnexTmpWatcherDir
liftAnnex $ do
@ -61,7 +63,7 @@ commitThread = namedThread "Committer" $ do
(fromRawFilePath lockdowndir)
void $ createAnnexDirectory lockdowndir
waitChangeTime $ \(changes, time) -> do
readychanges <- handleAdds (fromRawFilePath lockdowndir) havelsof delayadd $
readychanges <- handleAdds (fromRawFilePath lockdowndir) havelsof largefilematcher delayadd $
simplifyChanges changes
if shouldCommit False time (length readychanges) readychanges
then do
@ -239,7 +241,7 @@ commitStaged msg = do
return ok
{- If there are PendingAddChanges, or InProcessAddChanges, the files
- have not yet actually been added to the annex, and that has to be done
- have not yet actually been added, and that has to be done
- now, before committing.
-
- Deferring the adds to this point causes batches to be bundled together,
@ -257,8 +259,8 @@ commitStaged msg = do
- Any pending adds that are not ready yet are put back into the ChangeChan,
- where they will be retried later.
-}
handleAdds :: FilePath -> Bool -> Maybe Seconds -> [Change] -> Assistant [Change]
handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
handleAdds :: FilePath -> Bool -> GetFileMatcher -> Maybe Seconds -> [Change] -> Assistant [Change]
handleAdds lockdowndir havelsof largefilematcher delayadd cs = returnWhen (null incomplete) $ do
let (pending, inprocess) = partition isPendingAddChange incomplete
let lockdownconfig = LockDownConfig
{ lockingFile = False
@ -271,9 +273,12 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
refillChanges postponed
returnWhen (null toadd) $ do
added <- addaction toadd $
catMaybes <$> addunlocked toadd
return $ added ++ otherchanges
(toaddannexed, toaddsmall) <- partitionEithers
<$> mapM checksmall toadd
addsmall toaddsmall
addedannexed <- addaction toadd $
catMaybes <$> addannexed toaddannexed
return $ addedannexed ++ toaddsmall ++ otherchanges
where
(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs
@ -281,25 +286,24 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
| c = return otherchanges
| otherwise = a
add :: LockDownConfig -> Change -> Assistant (Maybe Change)
add lockdownconfig change@(InProcessAddChange { lockedDown = ld }) =
catchDefaultIO Nothing <~> doadd
where
ks = keySource ld
doadd = sanitycheck ks $ do
(mkey, _mcache) <- liftAnnex $ do
showStart "add" (keyFilename ks) (SeekInput [])
ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing
maybe (failedingest change) (done change $ fromRawFilePath $ keyFilename ks) mkey
add _ _ = return Nothing
checksmall change =
ifM (liftAnnex $ checkFileMatcher largefilematcher (toRawFilePath (changeFile change)))
( return (Left change)
, return (Right change)
)
addsmall [] = noop
addsmall toadd = liftAnnex $ Annex.Queue.addCommand [] "add"
[ Param "--force", Param "--"] (map changeFile toadd)
{- Avoid overhead of re-injesting a renamed unlocked file, by
- examining the other Changes to see if a removed file has the
- same InodeCache as the new file. If so, we can just update
- bookkeeping, and stage the file in git.
-}
addunlocked :: [Change] -> Assistant [Maybe Change]
addunlocked toadd = do
addannexed :: [Change] -> Assistant [Maybe Change]
addannexed [] = return []
addannexed toadd = do
ct <- liftAnnex compareInodeCachesWith
m <- liftAnnex $ removedKeysMap ct cs
delta <- liftAnnex getTSDelta
@ -308,16 +312,28 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
, hardlinkFileTmpDir = Just (toRawFilePath lockdowndir)
}
if M.null m
then forM toadd (add cfg)
then forM toadd (addannexed' cfg)
else forM toadd $ \c -> do
mcache <- liftIO $ genInodeCache (toRawFilePath (changeFile c)) delta
case mcache of
Nothing -> add cfg c
Nothing -> addannexed' cfg c
Just cache ->
case M.lookup (inodeCacheToKey ct cache) m of
Nothing -> add cfg c
Nothing -> addannexed' cfg c
Just k -> fastadd c k
addannexed' :: LockDownConfig -> Change -> Assistant (Maybe Change)
addannexed' lockdownconfig change@(InProcessAddChange { lockedDown = ld }) =
catchDefaultIO Nothing <~> doadd
where
ks = keySource ld
doadd = sanitycheck ks $ do
(mkey, _mcache) <- liftAnnex $ do
showStart "add" (keyFilename ks) (SeekInput [])
ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing
maybe (failedingest change) (done change $ fromRawFilePath $ keyFilename ks) mkey
addannexed' _ _ = return Nothing
fastadd :: Change -> Key -> Assistant (Maybe Change)
fastadd change key = do
let source = keySource $ lockedDown change

View file

@ -34,7 +34,6 @@ import Annex.WorkTree
import Annex.CatFile
import Annex.CheckIgnore
import Annex.Link
import Annex.FileMatcher
import Annex.Content
import Annex.ReplaceFile
import Annex.InodeSentinal
@ -89,9 +88,8 @@ watchThread = namedThread "Watcher" $
runWatcher :: Assistant ()
runWatcher = do
startup <- asIO1 startupScan
matcher <- liftAnnex largeFilesMatcher
symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig
addhook <- hook $ onAddUnlocked symlinkssupported matcher
addhook <- hook $ onAddUnlocked symlinkssupported
delhook <- hook onDel
addsymlinkhook <- hook onAddSymlink
deldirhook <- hook onDelDir
@ -193,24 +191,14 @@ runHandler handler file filestatus = void $ do
| "./" `isPrefixOf` file = drop 2 f
| otherwise = f
{- Small files are added to git as-is, while large ones go into the annex. -}
add :: GetFileMatcher -> FilePath -> Assistant (Maybe Change)
add largefilematcher file = ifM (liftAnnex $ checkFileMatcher largefilematcher (toRawFilePath file))
( pendingAddChange file
, do
liftAnnex $ Annex.Queue.addCommand [] "add"
[Param "--force", Param "--"] [file]
madeChange file AddFileChange
)
shouldRestage :: DaemonStatus -> Bool
shouldRestage ds = scanComplete ds || forceRestage ds
onAddUnlocked :: Bool -> GetFileMatcher -> Handler
onAddUnlocked symlinkssupported matcher f fs = do
onAddUnlocked :: Bool -> Handler
onAddUnlocked symlinkssupported f fs = do
mk <- liftIO $ isPointerFile $ toRawFilePath f
case mk of
Nothing -> onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher f fs
Nothing -> onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported f fs
Just k -> addlink f k
where
addassociatedfile key file =
@ -240,9 +228,8 @@ onAddUnlocked'
-> (FilePath -> Key -> Assistant (Maybe Change))
-> (Key -> FilePath -> FileStatus -> Annex Bool)
-> Bool
-> GetFileMatcher
-> Handler
onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher file fs = do
onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported file fs = do
v <- liftAnnex $ catKeyFile (toRawFilePath file)
case (v, fs) of
(Just key, Just filestatus) ->
@ -259,12 +246,12 @@ onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkss
, guardSymlinkStandin (Just key) $ do
debug ["changed", file]
liftAnnex $ contentchanged key file
add matcher file
pendingAddChange file
)
_ -> unlessIgnored file $
guardSymlinkStandin Nothing $ do
debug ["add", file]
add matcher 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