packages feed

git-annex 7.20190503 → 7.20190507

raw patch · 12 files changed

+105/−52 lines, 12 files

Files

Annex.hs view
@@ -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
Annex/Branch.hs view
@@ -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.
Annex/Concurrent.hs view
@@ -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
Annex/Locations.hs view
@@ -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
Annex/Queue.hs view
@@ -1,6 +1,6 @@ {- git-annex command queue  -- - Copyright 2011, 2012 Joey Hess <id@joeyh.name>+ - Copyright 2011, 2012, 2019 Joey Hess <id@joeyh.name>  -  - 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
Annex/RemoteTrackingBranch.hs view
@@ -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"
CHANGELOG view
@@ -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 <id@joeyh.name>  Tue, 07 May 2019 13:05:33 -0400+ git-annex (7.20190503) upstream; urgency=medium    * adb special remote supports being configured with importtree=yes,
Command/Export.hs view
@@ -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
Git/Ref.hs view
@@ -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
Test.hs view
@@ -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
doc/git-annex.mdwn view
@@ -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]]. 
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20190503+Version: 7.20190507 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>