clean up git-remote-annex git-annex branch handling
Implemented alternateJournal, which git-remote-annex
uses to avoid any writes to the git-annex branch while setting up
a special remote from an annex:: url.
That prevents the remote.log from being overwritten with the special
remote configuration from the url, which might not be 100% the same as
the existing special remote configuration.
And it prevents an overwrite deleting of other stuff that was
already in the remote.log.
Also, when the branch was created by git-remote-annex, only delete it
at the end if nothing else has been written to it by another command.
This fixes the race condition described in
797f27ab05
, where git-remote-annex
set up the branch and git-annex init and other commands were
run at the same time and their writes to the branch were lost.
This commit is contained in:
parent
d24d8870c5
commit
adcebbae47
6 changed files with 84 additions and 66 deletions
|
@ -727,7 +727,8 @@ stageJournal :: JournalLocked -> Annex () -> Annex ()
|
|||
stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do
|
||||
prepareModifyIndex jl
|
||||
g <- gitRepo
|
||||
let dir = gitAnnexJournalDir g
|
||||
st <- getState
|
||||
let dir = gitAnnexJournalDir st g
|
||||
(jlogf, jlogh) <- openjlog (fromRawFilePath tmpdir)
|
||||
withHashObjectHandle $ \h ->
|
||||
withJournalHandle gitAnnexJournalDir $ \jh ->
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
- All files in the journal must be a series of lines separated by
|
||||
- newlines.
|
||||
-
|
||||
- Copyright 2011-2022 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2011-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -23,6 +23,8 @@ import qualified Git
|
|||
import Annex.Perms
|
||||
import Annex.Tmp
|
||||
import Annex.LockFile
|
||||
import Annex.BranchState
|
||||
import Types.BranchState
|
||||
import Utility.Directory.Stream
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
|
@ -82,9 +84,10 @@ privateUUIDsKnown' = not . S.null . annexPrivateRepos . Annex.gitconfig
|
|||
-}
|
||||
setJournalFile :: Journalable content => JournalLocked -> RegardingUUID -> RawFilePath -> content -> Annex ()
|
||||
setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do
|
||||
st <- getState
|
||||
jd <- fromRepo =<< ifM (regardingPrivateUUID ru)
|
||||
( return gitAnnexPrivateJournalDir
|
||||
, return gitAnnexJournalDir
|
||||
( return (gitAnnexPrivateJournalDir st)
|
||||
, return (gitAnnexJournalDir st)
|
||||
)
|
||||
-- journal file is written atomically
|
||||
let jfile = journalFile file
|
||||
|
@ -106,9 +109,10 @@ newtype AppendableJournalFile = AppendableJournalFile (RawFilePath, RawFilePath)
|
|||
- branch. -}
|
||||
checkCanAppendJournalFile :: JournalLocked -> RegardingUUID -> RawFilePath -> Annex (Maybe AppendableJournalFile)
|
||||
checkCanAppendJournalFile _jl ru file = do
|
||||
st <- getState
|
||||
jd <- fromRepo =<< ifM (regardingPrivateUUID ru)
|
||||
( return gitAnnexPrivateJournalDir
|
||||
, return gitAnnexJournalDir
|
||||
( return (gitAnnexPrivateJournalDir st)
|
||||
, return (gitAnnexJournalDir st)
|
||||
)
|
||||
let jfile = jd P.</> journalFile file
|
||||
ifM (liftIO $ R.doesPathExist jfile)
|
||||
|
@ -176,14 +180,12 @@ data GetPrivate = GetPrivate Bool
|
|||
-}
|
||||
getJournalFileStale :: GetPrivate -> RawFilePath -> Annex JournalledContent
|
||||
getJournalFileStale (GetPrivate getprivate) file = do
|
||||
-- Optimisation to avoid a second MVar access.
|
||||
st <- Annex.getState id
|
||||
let g = Annex.repo st
|
||||
liftIO $
|
||||
if getprivate && privateUUIDsKnown' st
|
||||
then do
|
||||
x <- getfrom (gitAnnexJournalDir g)
|
||||
getfrom (gitAnnexPrivateJournalDir g) >>= \case
|
||||
x <- getfrom (gitAnnexJournalDir (Annex.branchstate st) (Annex.repo st))
|
||||
getfrom (gitAnnexPrivateJournalDir (Annex.branchstate st) (Annex.repo st)) >>= \case
|
||||
Nothing -> return $ case x of
|
||||
Nothing -> NoJournalledContent
|
||||
Just b -> JournalledContent b
|
||||
|
@ -193,7 +195,7 @@ getJournalFileStale (GetPrivate getprivate) file = do
|
|||
-- happens in a merge of two
|
||||
-- git-annex branches.
|
||||
Just x' -> x' <> y
|
||||
else getfrom (gitAnnexJournalDir g) >>= return . \case
|
||||
else getfrom (gitAnnexJournalDir (Annex.branchstate st) (Annex.repo st)) >>= return . \case
|
||||
Nothing -> NoJournalledContent
|
||||
Just b -> JournalledContent b
|
||||
where
|
||||
|
@ -219,18 +221,20 @@ discardIncompleteAppend v
|
|||
{- List of existing journal files in a journal directory, but without locking,
|
||||
- may miss new ones just being added, or may have false positives if the
|
||||
- journal is staged as it is run. -}
|
||||
getJournalledFilesStale :: (Git.Repo -> RawFilePath) -> Annex [RawFilePath]
|
||||
getJournalledFilesStale :: (BranchState -> Git.Repo -> RawFilePath) -> Annex [RawFilePath]
|
||||
getJournalledFilesStale getjournaldir = do
|
||||
g <- gitRepo
|
||||
fs <- liftIO $ catchDefaultIO [] $
|
||||
getDirectoryContents $ fromRawFilePath (getjournaldir g)
|
||||
st <- Annex.getState id
|
||||
let d = getjournaldir (Annex.branchstate st) (Annex.repo st)
|
||||
fs <- liftIO $ catchDefaultIO [] $
|
||||
getDirectoryContents (fromRawFilePath d)
|
||||
return $ filter (`notElem` [".", ".."]) $
|
||||
map (fileJournal . toRawFilePath) fs
|
||||
|
||||
{- Directory handle open on a journal directory. -}
|
||||
withJournalHandle :: (Git.Repo -> RawFilePath) -> (DirectoryHandle -> IO a) -> Annex a
|
||||
withJournalHandle :: (BranchState -> Git.Repo -> RawFilePath) -> (DirectoryHandle -> IO a) -> Annex a
|
||||
withJournalHandle getjournaldir a = do
|
||||
d <- fromRepo getjournaldir
|
||||
st <- Annex.getState id
|
||||
let d = getjournaldir (Annex.branchstate st) (Annex.repo st)
|
||||
bracket (opendir d) (liftIO . closeDirectory) (liftIO . a)
|
||||
where
|
||||
-- avoid overhead of creating the journal directory when it already
|
||||
|
@ -239,9 +243,10 @@ withJournalHandle getjournaldir a = do
|
|||
`catchIO` (const (createAnnexDirectory d >> opendir d))
|
||||
|
||||
{- Checks if there are changes in the journal. -}
|
||||
journalDirty :: (Git.Repo -> RawFilePath) -> Annex Bool
|
||||
journalDirty :: (BranchState -> Git.Repo -> RawFilePath) -> Annex Bool
|
||||
journalDirty getjournaldir = do
|
||||
d <- fromRawFilePath <$> fromRepo getjournaldir
|
||||
st <- getState
|
||||
d <- fromRawFilePath <$> fromRepo (getjournaldir st)
|
||||
liftIO $
|
||||
(not <$> isDirectoryEmpty d)
|
||||
`catchIO` (const $ doesDirectoryExist d)
|
||||
|
|
|
@ -118,6 +118,7 @@ import Key
|
|||
import Types.UUID
|
||||
import Types.GitConfig
|
||||
import Types.Difference
|
||||
import Types.BranchState
|
||||
import qualified Git
|
||||
import qualified Git.Types as Git
|
||||
import Git.FilePath
|
||||
|
@ -528,15 +529,19 @@ gitAnnexTransferDir r =
|
|||
|
||||
{- .git/annex/journal/ is used to journal changes made to the git-annex
|
||||
- branch -}
|
||||
gitAnnexJournalDir :: Git.Repo -> RawFilePath
|
||||
gitAnnexJournalDir r =
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal"
|
||||
gitAnnexJournalDir :: BranchState -> Git.Repo -> RawFilePath
|
||||
gitAnnexJournalDir st r = P.addTrailingPathSeparator $
|
||||
case alternateJournal st of
|
||||
Nothing -> gitAnnexDir r P.</> "journal"
|
||||
Just d -> d
|
||||
|
||||
{- .git/annex/journal.private/ is used to journal changes regarding private
|
||||
- repositories. -}
|
||||
gitAnnexPrivateJournalDir :: Git.Repo -> RawFilePath
|
||||
gitAnnexPrivateJournalDir r =
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal-private"
|
||||
gitAnnexPrivateJournalDir :: BranchState -> Git.Repo -> RawFilePath
|
||||
gitAnnexPrivateJournalDir st r = P.addTrailingPathSeparator $
|
||||
case alternateJournal st of
|
||||
Nothing -> gitAnnexDir r P.</> "journal-private"
|
||||
Just d -> d
|
||||
|
||||
{- Lock file for the journal. -}
|
||||
gitAnnexJournalLock :: Git.Repo -> RawFilePath
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue