{- 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.
-}
import Annex.CatFile
import Annex.InodeSentinal
import Annex.CurrentBranch
+import Annex.FileMatcher
import qualified Annex
import Utility.InodeCache
import qualified Database.Keys
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
(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
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,
- 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
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
| 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
, 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
import Annex.CatFile
import Annex.CheckIgnore
import Annex.Link
-import Annex.FileMatcher
import Annex.Content
import Annex.ReplaceFile
import Annex.InodeSentinal
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
| "./" `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 =
-> (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) ->
, 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
projects / git-annex.git / commitdiff