diff --git a/Annex.hs b/Annex.hs --- a/Annex.hs +++ b/Annex.hs @@ -75,7 +75,6 @@ import Control.Concurrent.Async import Control.Concurrent.STM import qualified Control.Monad.Fail as Fail -import qualified Control.Concurrent.SSem as SSem import qualified Data.Map.Strict as M import qualified Data.Set as S @@ -116,7 +115,6 @@ , daemon :: Bool , branchstate :: BranchState , repoqueue :: Maybe Git.Queue.Queue - , repoqueuesem :: SSem.SSem , catfilehandles :: M.Map FilePath CatFileHandle , hashobjecthandle :: Maybe HashObjectHandle , checkattrhandle :: Maybe CheckAttrHandle @@ -159,7 +157,6 @@ emptyactivekeys <- newTVarIO M.empty o <- newMessageState sc <- newTMVarIO False - qsem <- SSem.new 1 return $ AnnexState { repo = r , repoadjustment = return @@ -175,7 +172,6 @@ , daemon = False , branchstate = startBranchState , repoqueue = Nothing - , repoqueuesem = qsem , catfilehandles = M.empty , hashobjecthandle = Nothing , checkattrhandle = Nothing diff --git a/Annex/Branch.hs b/Annex/Branch.hs --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -177,9 +177,8 @@ where excludeset s = filter (\(r, _) -> S.notMember r s) isnewer (r, _) = inRepo $ Git.Branch.changed fullname r - go branchref dirty tomerge jl = withIndex $ do + go branchref dirty tomerge jl = stagejournalwhen dirty jl $ do let (refs, branches) = unzip tomerge - cleanjournal <- if dirty then stageJournal jl else return noop merge_desc <- if null tomerge then commitMessage else return $ "merging " ++ @@ -203,7 +202,9 @@ else commitIndex jl branchref merge_desc commitrefs ) addMergedRefs tomerge - liftIO cleanjournal + stagejournalwhen dirty jl a + | dirty = stageJournal jl a + | otherwise = withIndex a {- Gets the content of a file, which may be in the journal, or in the index - (and committed to the branch). @@ -281,11 +282,10 @@ {- Commits the current index to the branch even without any journalled - changes. -} forceCommit :: String -> Annex () -forceCommit message = lockJournal $ \jl -> do - cleanjournal <- stageJournal jl - ref <- getBranch - withIndex $ commitIndex jl ref message [fullname] - liftIO cleanjournal +forceCommit message = lockJournal $ \jl -> + stageJournal jl $ do + ref <- getBranch + commitIndex jl ref message [fullname] {- Commits the staged changes in the index to the branch. - @@ -447,9 +447,9 @@ writeLogFile f $ fromRef ref ++ "\n" runAnnexHook postUpdateAnnexHook -{- Stages the journal into the index and returns an action that will - - clean up the staged journal files, which should only be run once - - the index has been committed to the branch. +{- Stages the journal into the index, and runs an action that + - commits the index to the branch. Note that the action is run + - inside withIndex so will automatically use the branch's index. - - Before staging, this removes any existing git index file lock. - This is safe to do because stageJournal is the only thing that @@ -458,17 +458,18 @@ - stale, and the journal must contain any data that was in the process - of being written to the index file when it crashed. -} -stageJournal :: JournalLocked -> Annex (IO ()) -stageJournal jl = withIndex $ do +stageJournal :: JournalLocked -> Annex () -> Annex () +stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do prepareModifyIndex jl g <- gitRepo let dir = gitAnnexJournalDir g - (jlogf, jlogh) <- openjlog + (jlogf, jlogh) <- openjlog tmpdir h <- hashObjectHandle withJournalHandle $ \jh -> Git.UpdateIndex.streamUpdateIndex g [genstream dir h jh jlogh] - return $ cleanup dir jlogh jlogf + commitindex + liftIO $ cleanup dir jlogh jlogf where genstream dir h jh jlogh streamer = readDirectory jh >>= \case Nothing -> return () @@ -490,8 +491,7 @@ mapM_ (removeFile . (dir )) stagedfs hClose jlogh nukeFile jlogf - openjlog = withOtherTmp $ \tmpdir -> - liftIO $ openTempFile tmpdir "jlog" + openjlog tmpdir = liftIO $ openTempFile tmpdir "jlog" {- This is run after the refs have been merged into the index, - but before the result is committed to the branch. diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs --- a/Annex/Concurrent.hs +++ b/Annex/Concurrent.hs @@ -43,9 +43,7 @@ st <- Annex.getState id return $ st { Annex.workers = [] - -- each thread has its own repoqueue, but the repoqueuesem - -- is shared to prevent more than one thread flushing its - -- queue at the same time + -- each thread has its own repoqueue , Annex.repoqueue = Nothing -- avoid sharing eg, open file handles , Annex.catfilehandles = M.empty diff --git a/Annex/Locations.hs b/Annex/Locations.hs --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -61,6 +61,7 @@ gitAnnexMergeDir, gitAnnexJournalDir, gitAnnexJournalLock, + gitAnnexGitQueueLock, gitAnnexPreCommitLock, gitAnnexMergeLock, gitAnnexIndex, @@ -409,6 +410,11 @@ {- Lock file for the journal. -} gitAnnexJournalLock :: Git.Repo -> FilePath gitAnnexJournalLock r = gitAnnexDir r "journal.lck" + +{- Lock file for flushing a git queue that writes to the git index or + - other git state that should only have one writer at a time. -} +gitAnnexGitQueueLock :: Git.Repo -> FilePath +gitAnnexGitQueueLock r = gitAnnexDir r "gitqueue.lck" {- Lock file for the pre-commit hook. -} gitAnnexPreCommitLock :: Git.Repo -> FilePath diff --git a/Annex/Queue.hs b/Annex/Queue.hs --- a/Annex/Queue.hs +++ b/Annex/Queue.hs @@ -1,6 +1,6 @@ {- git-annex command queue - - - Copyright 2011, 2012 Joey Hess + - Copyright 2011, 2012, 2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -20,11 +20,10 @@ import Annex.Common import Annex hiding (new) +import Annex.LockFile import qualified Git.Queue import qualified Git.UpdateIndex -import qualified Control.Concurrent.SSem as SSem - {- Adds a git command to the queue. -} addCommand :: String -> [CommandParam] -> [FilePath] -> Annex () addCommand command params files = do @@ -59,22 +58,16 @@ store =<< flush' q {- When there are multiple worker threads, each has its own queue. + - And of course multiple git-annex processes may be running each with its + - own queue. - - But, flushing two queues at the same time could lead to failures due to - git locking files. So, only one queue is allowed to flush at a time. - - The repoqueuesem is shared between threads. -} flush' :: Git.Queue.Queue -> Annex Git.Queue.Queue -flush' q = bracket lock unlock go - where - lock = do - s <- getState repoqueuesem - liftIO $ SSem.wait s - return s - unlock = liftIO . SSem.signal - go _ = do - showStoringStateAction - inRepo $ Git.Queue.flush q +flush' q = withExclusiveLock gitAnnexGitQueueLock $ do + showStoringStateAction + inRepo $ Git.Queue.flush q {- Gets the size of the queue. -} size :: Annex Int diff --git a/Annex/RemoteTrackingBranch.hs b/Annex/RemoteTrackingBranch.hs --- a/Annex/RemoteTrackingBranch.hs +++ b/Annex/RemoteTrackingBranch.hs @@ -16,6 +16,7 @@ ) where import Annex.Common +import Annex.CatFile import Git.Types import qualified Git.Ref import qualified Git.Branch @@ -49,18 +50,20 @@ - But since we know that the second parent consists entirely of such - import commits, they can be reused when updating the - RemoteTrackingBranch. - - - - The commitsha should have the treesha as its tree. -} -makeRemoteTrackingBranchMergeCommit :: RemoteTrackingBranch -> Sha -> Sha -> Annex Sha -makeRemoteTrackingBranchMergeCommit tb commitsha treesha = +makeRemoteTrackingBranchMergeCommit :: RemoteTrackingBranch -> Sha -> Annex Sha +makeRemoteTrackingBranchMergeCommit tb commitsha = -- Check if the tracking branch exists. inRepo (Git.Ref.sha (fromRemoteTrackingBranch tb)) >>= \case Nothing -> return commitsha Just _ -> inRepo (getHistoryToDepth 1 (fromRemoteTrackingBranch tb)) >>= \case Nothing -> return commitsha Just (History hc _) -> case historyCommitParents hc of - [_, importhistory] -> + [_, importhistory] -> do + treesha <- maybe + (giveup $ "Unable to cat commit " ++ fromRef commitsha) + commitTree + <$> catCommit commitsha makeRemoteTrackingBranchMergeCommit' commitsha importhistory treesha -- Earlier versions of git-annex did not -- make the merge commit, or perhaps @@ -69,7 +72,7 @@ _ -> return commitsha makeRemoteTrackingBranchMergeCommit' :: Sha -> Sha -> Sha -> Annex Sha -makeRemoteTrackingBranchMergeCommit' commitsha importedhistory treesha = +makeRemoteTrackingBranchMergeCommit' commitsha importedhistory treesha = inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit "remote tracking branch" diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,12 @@ +git-annex (7.20190507) upstream; urgency=medium + + * Fix reversion in last release that caused wrong tree to be written + to remote tracking branch after an export of a subtree. + * Improved locking when multiple git-annex processes are writing to + the .git/index file + + -- Joey Hess Tue, 07 May 2019 13:05:33 -0400 + git-annex (7.20190503) upstream; urgency=medium * adb special remote supports being configured with importtree=yes, diff --git a/Command/Export.hs b/Command/Export.hs --- a/Command/Export.hs +++ b/Command/Export.hs @@ -235,7 +235,7 @@ Nothing -> noop Just (tb, commitsha) -> whenM (liftIO $ fromAllFilled <$> takeMVar allfilledvar) $ - makeRemoteTrackingBranchMergeCommit tb commitsha newtree + makeRemoteTrackingBranchMergeCommit tb commitsha >>= setRemoteTrackingBranch tb liftIO $ fromFileUploaded <$> takeMVar cvar diff --git a/Git/Ref.hs b/Git/Ref.hs --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -143,10 +143,13 @@ , Param $ fromRef oldvalue ] -{- Gets the sha of the tree a ref uses. -} +{- Gets the sha of the tree a ref uses. + - + - The ref may be something like a branch name, and it could contain + - ":subdir" if a subtree is wanted. -} tree :: Ref -> Repo -> IO (Maybe Sha) tree (Ref ref) = extractSha <$$> pipeReadStrict - [ Param "rev-parse", Param ref' ] + [ Param "rev-parse", Param "--verify", Param "--quiet", Param ref' ] where ref' = if ":" `isInfixOf` ref then ref diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -209,6 +209,7 @@ [ testCase "add dup" test_add_dup , testCase "add extras" test_add_extras , testCase "export_import" test_export_import + , testCase "export_import_subdir" test_export_import_subdir , testCase "shared clone" test_shared_clone , testCase "log" test_log , testCase "import" test_import @@ -1777,3 +1778,47 @@ ((v==) <$> readFile ("dir" f)) @? ("did not find expected content of " ++ "dir" f) writedir f = writecontent ("dir" f) + +test_export_import_subdir :: Assertion +test_export_import_subdir = intmpclonerepoInDirect $ do + createDirectory "dir" + git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") @? "initremote failed" + git_annex "get" [] @? "get of files failed" + annexed_present annexedfile + + createDirectory subdir + boolSystem "git" [Param "mv", File annexedfile, File subannexedfile] + @? "git mv failed" + boolSystem "git" [Param "commit", Param "-m", Param "moved"] + @? "git commit failed" + + -- Run three times because there was a bug that took a couple + -- of runs to lead to the wrong tree being written to the remote + -- tracking branch. + testimport + testexport + testimport + testexport + testimport + testexport + where + dircontains f v = + ((v==) <$> readFile ("dir" f)) + @? ("did not find expected content of " ++ "dir" f) + + subdir = "subdir" + subannexedfile = "subdir" annexedfile + + testexport = do + git_annex "export" ["master:"++subdir, "--to", "foo"] @? "export of subdir failed" + dircontains annexedfile (content annexedfile) + + testimport = do + git_annex "import" ["master:"++subdir, "--from", "foo"] @? "import of subdir failed" + up <- Git.Merge.mergeUnrelatedHistoriesParam + let mergeps = [Param "merge", Param "foo/master", Param "-mmerge"] ++ maybeToList up + boolSystem "git" mergeps @? "git merge foo/master failed" + + -- Make sure that import did not import the file to the top + -- of the repo. + checkdoesnotexist annexedfile diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -862,15 +862,15 @@ * `annex.securehashesonly` Set to true to indicate that the repository should only use - cryptographically secure hashes - (SHA2, SHA3) and not insecure hashes (MD5, SHA1) for content. + cryptographically secure hashes (SHA2, SHA3) and not insecure + hashes (MD5, SHA1) for content. When this is set, the contents of files using cryptographically insecure hashes will not be allowed to be added to the repository. - + Also, git-annex fsck` will complain about any files present in the repository that use insecure hashes. - + To configure the behavior in new clones of the repository, this can be set in [[git-annex-config]]. diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 7.20190503 +Version: 7.20190507 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess