mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactor the restage runner

Browse source 
Sponsored-by: Dartmouth College's DANDI project
This commit is contained in:
Joey Hess 2022-09-23 13:10:49 -04:00
parent 4822121728
commit 8718125ae4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 99 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

95
Annex/Link.hs
View file

@ -177,7 +177,7 @@ newtype Restage = Restage Bool
- gets to look at it. - gets to look at it.
-} -}
restagePointerFile :: Restage -> RawFilePath -> InodeCache -> Annex () restagePointerFile :: Restage -> RawFilePath -> InodeCache -> Annex ()
restagePointerFile (Restage False) f _ = restagePointerFile (Restage False) f orig = do
toplevelWarning True $ unableToRestage $ Just $ fromRawFilePath f toplevelWarning True $ unableToRestage $ Just $ fromRawFilePath f
restagePointerFile (Restage True) f orig = withTSDelta $ \tsd -> restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
-- Avoid refreshing the index if run by the -- Avoid refreshing the index if run by the
@ -190,57 +190,58 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
-- fails on "../../repo/path/file" when cwd is not in the repo -- fails on "../../repo/path/file" when cwd is not in the repo
-- being acted on. Avoid these problems with an absolute path. -- being acted on. Avoid these problems with an absolute path.
absf <- liftIO $ absPath f absf <- liftIO $ absPath f
Annex.Queue.addFlushAction runner [(absf, isunmodified tsd, inodeCacheFileSize orig)] Annex.Queue.addFlushAction restagePointerFileRunner
[(absf, isunmodified tsd, inodeCacheFileSize orig)]
where where
isunmodified tsd = genInodeCache f tsd >>= return . \case isunmodified tsd = genInodeCache f tsd >>= return . \case
Nothing -> False Nothing -> False
Just new -> compareStrong orig new Just new -> compareStrong orig new
-- Other changes to the files may have been staged before this -- Other changes to the files may have been staged before this
-- gets a chance to run. To avoid a race with any staging of -- gets a chance to run. To avoid a race with any staging of
-- changes, first lock the index file. Then run git update-index -- changes, first lock the index file. Then run git update-index
-- on all still-unmodified files, using a copy of the index file, -- on all still-unmodified files, using a copy of the index file,
-- to bypass the lock. Then replace the old index file with the new -- to bypass the lock. Then replace the old index file with the new
-- updated index file. -- updated index file.
runner :: Git.Queue.FlushActionRunner Annex restagePointerFileRunner :: Git.Queue.FlushActionRunner Annex
runner = Git.Queue.FlushActionRunner "restagePointerFile" $ \r l -> do restagePointerFileRunner = Git.Queue.FlushActionRunner "restagePointerFile" $ \r l -> do
-- Flush any queued changes to the keys database, so they -- Flush any queued changes to the keys database, so they
-- are visible to child processes. -- are visible to child processes.
-- The database is closed because that may improve behavior -- The database is closed because that may improve behavior
-- when run in Windows's WSL1, which has issues with -- when run in Windows's WSL1, which has issues with
-- multiple writers to SQL databases. -- multiple writers to SQL databases.
liftIO . Database.Keys.Handle.closeDbHandle liftIO . Database.Keys.Handle.closeDbHandle
=<< Annex.getRead Annex.keysdbhandle =<< Annex.getRead Annex.keysdbhandle
realindex <- liftIO $ Git.Index.currentIndexFile r realindex <- liftIO $ Git.Index.currentIndexFile r
let lock = fromRawFilePath (Git.Index.indexFileLock realindex) let lock = fromRawFilePath (Git.Index.indexFileLock realindex)
lockindex = liftIO $ catchMaybeIO $ Git.LockFile.openLock' lock lockindex = liftIO $ catchMaybeIO $ Git.LockFile.openLock' lock
unlockindex = liftIO . maybe noop Git.LockFile.closeLock unlockindex = liftIO . maybe noop Git.LockFile.closeLock
showwarning = warning $ unableToRestage Nothing showwarning = warning $ unableToRestage Nothing
go Nothing = showwarning go Nothing = showwarning
go (Just _) = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex" $ \tmpdir -> do go (Just _) = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex" $ \tmpdir -> do
let tmpindex = toRawFilePath (tmpdir </> "index") let tmpindex = toRawFilePath (tmpdir </> "index")
let updatetmpindex = do let updatetmpindex = do
r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv
=<< Git.Index.indexEnvVal tmpindex =<< Git.Index.indexEnvVal tmpindex
-- Avoid git warning about CRLF munging. -- Avoid git warning about CRLF munging.
let r'' = r' { gitGlobalOpts = gitGlobalOpts r' ++ let r'' = r' { gitGlobalOpts = gitGlobalOpts r' ++
[ Param "-c" [ Param "-c"
, Param $ "core.safecrlf=" ++ boolConfig False , Param $ "core.safecrlf=" ++ boolConfig False
] } ] }
configfilterprocess l $ runsGitAnnexChildProcessViaGit' r'' $ \r''' -> configfilterprocess l $ runsGitAnnexChildProcessViaGit' r'' $ \r''' ->
liftIO $ Git.UpdateIndex.refreshIndex r''' $ \feed -> liftIO $ Git.UpdateIndex.refreshIndex r''' $ \feed ->
forM_ l $ \(f', checkunmodified, _) -> forM_ l $ \(f', checkunmodified, _) ->
whenM checkunmodified $ whenM checkunmodified $
feed f' feed f'
let replaceindex = catchBoolIO $ do let replaceindex = catchBoolIO $ do
moveFile tmpindex realindex moveFile tmpindex realindex
return True return True
ok <- liftIO (createLinkOrCopy realindex tmpindex) ok <- liftIO (createLinkOrCopy realindex tmpindex)
<&&> updatetmpindex <&&> updatetmpindex
<&&> liftIO replaceindex <&&> liftIO replaceindex
unless ok showwarning unless ok showwarning
bracket lockindex unlockindex go bracket lockindex unlockindex go
where
{- filter.annex.process configured to use git-annex filter-process {- filter.annex.process configured to use git-annex filter-process
- is sometimes faster and sometimes slower than using - is sometimes faster and sometimes slower than using
- git-annex smudge. The latter is run once per file, while - git-annex smudge. The latter is run once per file, while

51
Logs/Restage.hs Normal file
View file

@ -0,0 +1,51 @@
{- git-annex restage log file
-
- Copyright 2022 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Logs.Restage where
import Annex.Common
import Git.FilePath
import Logs.File
import qualified Data.ByteString.Lazy as L
-- | Log a file whose pointer needs to be restaged in git.
-- The content of the file may not be a pointer, if it is populated with
-- the annex content. The InodeCache is used to verify that the file
-- still contains the content, and it's still safe to restage its pointer.
writeRestageLog :: TopFilePath -> InodeCache -> Annex ()
writeRestageLog f ic = do
logf <- fromRepo gitAnnexRestageLog
lckf <- fromRepo gitAnnexRestageLock
appendLogFile logf lckf $ L.fromStrict $
encodeBS (showInodeCache ic) <> ":" <> getTopFilePath f
-- | Streams the content of the restage log, and then empties the log at
-- the end.
--
-- If the action is interrupted or throws an exception, the log file is
-- left unchanged.
--
-- Locking is used to prevent new items being added to the log while this
-- is running.
streamSmudged :: (TopFilePath -> InodeCache -> Annex ()) -> Annex ()
streamSmudged a = do
logf <- fromRepo gitAnnexRestageLog
lckf <- fromRepo gitAnnexRestageLock
streamLogFile (fromRawFilePath logf) lckf $ \l ->
case parse l of
Nothing -> noop
Just (k, f) -> a f ic
where
parse l =
let (ics, f) = separate (== ':') l
in do
ic <- readInodeCache ics
return (asTopFilePath (toRawFilePath f), ic)