bugfix: avoid staging but not committing changes to git-annex branch
Branch.get is not able to see changes that have been staged to the index
but not committed. This is a limitation of git cat-file --batch; when
reading from the index, as opposed to from a branch, it does not notice
changes made after the first time it reads the index.
So, had to revert the changes made in 1f73db3469
to make annex.alwayscommit=false stage changes.
Also, ensure that Branch.change and Branch.get always see changes
at all points during a commit, by not deleting journal files when
staging to the index. Delete them only after committing the branch.
Before, there was a race during commits where a different git-annex
could see out-of-date info from the branch while a commit was in progress.
That's also done when updating the branch to merge in remote branches.
In the case where the local git-annex branch has had changes pushed into it
that are not yet reflected in the index, and there are journalled changes
as well, a merge commit has to be done.
	
	
This commit is contained in:
		
					parent
					
						
							
								a1f93f06fd
							
						
					
				
			
			
				commit
				
					
						750c4ac6c2
					
				
			
		
					 3 changed files with 38 additions and 61 deletions
				
			
		| 
						 | 
					@ -18,7 +18,6 @@ module Annex.Branch (
 | 
				
			||||||
	get,
 | 
						get,
 | 
				
			||||||
	change,
 | 
						change,
 | 
				
			||||||
	commit,
 | 
						commit,
 | 
				
			||||||
	stage,
 | 
					 | 
				
			||||||
	files,
 | 
						files,
 | 
				
			||||||
) where
 | 
					) where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -86,8 +85,7 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
 | 
				
			||||||
		branchsha = inRepo $ Git.Ref.sha fullname
 | 
							branchsha = inRepo $ Git.Ref.sha fullname
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Ensures that the branch and index are up-to-date; should be
 | 
					{- Ensures that the branch and index are up-to-date; should be
 | 
				
			||||||
 - called before data is read from it. Runs only once per git-annex run.
 | 
					 - called before data is read from it. Runs only once per git-annex run. -}
 | 
				
			||||||
 -}
 | 
					 | 
				
			||||||
update :: Annex ()
 | 
					update :: Annex ()
 | 
				
			||||||
update = runUpdateOnce $ void $ updateTo =<< siblingBranches
 | 
					update = runUpdateOnce $ void $ updateTo =<< siblingBranches
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -108,24 +106,31 @@ forceUpdate = updateTo =<< siblingBranches
 | 
				
			||||||
 - later get staged, and might overwrite changes made during the merge.
 | 
					 - later get staged, and might overwrite changes made during the merge.
 | 
				
			||||||
 - This is only done if some of the Refs do need to be merged.
 | 
					 - This is only done if some of the Refs do need to be merged.
 | 
				
			||||||
 -
 | 
					 -
 | 
				
			||||||
 - Even when no Refs need to be merged, the index may still be updated
 | 
					 | 
				
			||||||
 - if the branch has gotten ahead of the index.
 | 
					 | 
				
			||||||
 -
 | 
					 | 
				
			||||||
 - Returns True if any refs were merged in, False otherwise.
 | 
					 - Returns True if any refs were merged in, False otherwise.
 | 
				
			||||||
 -}
 | 
					 -}
 | 
				
			||||||
updateTo :: [(Git.Ref, Git.Branch)] -> Annex Bool
 | 
					updateTo :: [(Git.Ref, Git.Branch)] -> Annex Bool
 | 
				
			||||||
updateTo pairs = do
 | 
					updateTo pairs = do
 | 
				
			||||||
	-- ensure branch exists, and get its current ref
 | 
						-- ensure branch exists, and get its current ref
 | 
				
			||||||
	branchref <- getBranch
 | 
						branchref <- getBranch
 | 
				
			||||||
	-- check what needs updating before taking the lock
 | 
						dirty <- journalDirty
 | 
				
			||||||
	dirty <- unCommitted
 | 
					 | 
				
			||||||
	(refs, branches) <- unzip <$> filterM isnewer pairs
 | 
						(refs, branches) <- unzip <$> filterM isnewer pairs
 | 
				
			||||||
	if null refs
 | 
						if null refs
 | 
				
			||||||
		then whenM (needUpdateIndex branchref) $ do
 | 
					 		{- Even when no refs need to be merged, the index
 | 
				
			||||||
			when dirty stageJournal
 | 
							 - may still be updated if the branch has gotten ahead 
 | 
				
			||||||
 | 
							 - of the index. -}
 | 
				
			||||||
 | 
							then whenM (needUpdateIndex branchref) $ lockJournal $ do
 | 
				
			||||||
			forceUpdateIndex branchref
 | 
								forceUpdateIndex branchref
 | 
				
			||||||
		else withIndex $ lockJournal $ do
 | 
								{- When there are journalled changes
 | 
				
			||||||
			when dirty stageJournal
 | 
								 - as well as the branch being updated,
 | 
				
			||||||
 | 
								 - a commit needs to be done. -}
 | 
				
			||||||
 | 
								when dirty $
 | 
				
			||||||
 | 
									go branchref True [] []
 | 
				
			||||||
 | 
							else lockJournal $ go branchref dirty refs branches
 | 
				
			||||||
 | 
						return $ not $ null refs
 | 
				
			||||||
 | 
						where
 | 
				
			||||||
 | 
							isnewer (r, _) = inRepo $ Git.Branch.changed fullname r
 | 
				
			||||||
 | 
							go branchref dirty refs branches = withIndex $ do
 | 
				
			||||||
 | 
								cleanjournal <- if dirty then stageJournal else return noop
 | 
				
			||||||
			let merge_desc = if null branches
 | 
								let merge_desc = if null branches
 | 
				
			||||||
				then "update"
 | 
									then "update"
 | 
				
			||||||
				else "merging " ++
 | 
									else "merging " ++
 | 
				
			||||||
| 
						 | 
					@ -142,9 +147,7 @@ updateTo pairs = do
 | 
				
			||||||
				else commitBranch branchref merge_desc
 | 
									else commitBranch branchref merge_desc
 | 
				
			||||||
					(nub $ fullname:refs)
 | 
										(nub $ fullname:refs)
 | 
				
			||||||
			invalidateCache
 | 
								invalidateCache
 | 
				
			||||||
	return $ not $ null refs
 | 
								liftIO cleanjournal
 | 
				
			||||||
	where
 | 
					 | 
				
			||||||
		isnewer (r, _) = inRepo $ Git.Branch.changed fullname r
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Gets the content of a file, which may be in the journal, or committed
 | 
					{- Gets the content of a file, which may be in the journal, or committed
 | 
				
			||||||
 - to the branch. Due to limitatons of git cat-file, does *not* get content
 | 
					 - to the branch. Due to limitatons of git cat-file, does *not* get content
 | 
				
			||||||
| 
						 | 
					@ -195,16 +198,11 @@ set file content = do
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Stages the journal, and commits staged changes to the branch. -}
 | 
					{- Stages the journal, and commits staged changes to the branch. -}
 | 
				
			||||||
commit :: String -> Annex ()
 | 
					commit :: String -> Annex ()
 | 
				
			||||||
commit message = whenM unCommitted $ lockJournal $ do
 | 
					commit message = whenM journalDirty $ lockJournal $ do
 | 
				
			||||||
	stageJournal
 | 
						cleanjournal <- stageJournal
 | 
				
			||||||
	ref <- getBranch
 | 
						ref <- getBranch
 | 
				
			||||||
	withIndex $ commitBranch ref message [fullname]
 | 
						withIndex $ commitBranch ref message [fullname]
 | 
				
			||||||
 | 
						liftIO $ cleanjournal
 | 
				
			||||||
{- Stages the journal, not making a commit to the branch. -}
 | 
					 | 
				
			||||||
stage :: Annex ()
 | 
					 | 
				
			||||||
stage = whenM journalDirty $ lockJournal $ do
 | 
					 | 
				
			||||||
	stageJournal
 | 
					 | 
				
			||||||
	setUnCommitted
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Commits the staged changes in the index to the branch.
 | 
					{- Commits the staged changes in the index to the branch.
 | 
				
			||||||
 - 
 | 
					 - 
 | 
				
			||||||
| 
						 | 
					@ -236,7 +234,6 @@ commitBranch' branchref message parents = do
 | 
				
			||||||
	parentrefs <- commitparents <$> catObject committedref
 | 
						parentrefs <- commitparents <$> catObject committedref
 | 
				
			||||||
	when (racedetected branchref parentrefs) $
 | 
						when (racedetected branchref parentrefs) $
 | 
				
			||||||
		fixrace committedref parentrefs
 | 
							fixrace committedref parentrefs
 | 
				
			||||||
	setCommitted
 | 
					 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		-- look for "parent ref" lines and return the refs
 | 
							-- look for "parent ref" lines and return the refs
 | 
				
			||||||
		commitparents = map (Git.Ref . snd) . filter isparent .
 | 
							commitparents = map (Git.Ref . snd) . filter isparent .
 | 
				
			||||||
| 
						 | 
					@ -336,39 +333,24 @@ setIndexSha ref = do
 | 
				
			||||||
	liftIO $ writeFile lock $ show ref ++ "\n"
 | 
						liftIO $ writeFile lock $ show ref ++ "\n"
 | 
				
			||||||
	setAnnexPerm lock
 | 
						setAnnexPerm lock
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Checks if there are uncommitted changes in the branch's index or journal. -}
 | 
					{- Stages the journal into the index and returns an action that will
 | 
				
			||||||
unCommitted :: Annex Bool
 | 
					 - clean up the staged journal files, which should only be run once
 | 
				
			||||||
unCommitted = do
 | 
					 - the index has been committed to the branch. Should be run within
 | 
				
			||||||
	d <- liftIO . doesFileExist =<< fromRepo gitAnnexIndexDirty
 | 
					 - lockJournal, to prevent others from modifying the journal. -}
 | 
				
			||||||
	if d
 | 
					stageJournal :: Annex (IO ())
 | 
				
			||||||
		then return d
 | 
					stageJournal = withIndex $ do
 | 
				
			||||||
		else journalDirty
 | 
						g <- gitRepo
 | 
				
			||||||
 | 
						let dir = gitAnnexJournalDir g
 | 
				
			||||||
setUnCommitted :: Annex ()
 | 
					 | 
				
			||||||
setUnCommitted = do
 | 
					 | 
				
			||||||
	file <- fromRepo gitAnnexIndexDirty
 | 
					 | 
				
			||||||
	liftIO $ writeFile file "1"
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
setCommitted :: Annex ()
 | 
					 | 
				
			||||||
setCommitted = void $ do
 | 
					 | 
				
			||||||
	file <- fromRepo gitAnnexIndexDirty
 | 
					 | 
				
			||||||
	liftIO $ tryIO $ removeFile file
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
{- Stages the journal into the index. -}
 | 
					 | 
				
			||||||
stageJournal :: Annex ()
 | 
					 | 
				
			||||||
stageJournal = do
 | 
					 | 
				
			||||||
	fs <- getJournalFiles
 | 
						fs <- getJournalFiles
 | 
				
			||||||
	withIndex $ do
 | 
						liftIO $ do
 | 
				
			||||||
		g <- gitRepo
 | 
							h <- hashObjectStart g
 | 
				
			||||||
		liftIO $ do
 | 
							Git.UpdateIndex.streamUpdateIndex g
 | 
				
			||||||
			h <- hashObjectStart g
 | 
								[genstream dir h fs]
 | 
				
			||||||
			Git.UpdateIndex.streamUpdateIndex g
 | 
							hashObjectStop h
 | 
				
			||||||
				[genstream (gitAnnexJournalDir g) h fs]
 | 
						return $ liftIO $ mapM_ removeFile $ map (dir </>) fs
 | 
				
			||||||
			hashObjectStop h
 | 
					 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		genstream dir h fs streamer = forM_ fs $ \file -> do
 | 
							genstream dir h fs streamer = forM_ fs $ \file -> do
 | 
				
			||||||
			let path = dir </> file
 | 
								let path = dir </> file
 | 
				
			||||||
			sha <- hashFile h path
 | 
								sha <- hashFile h path
 | 
				
			||||||
			_ <- streamer $ Git.UpdateIndex.updateIndexLine
 | 
								streamer $ Git.UpdateIndex.updateIndexLine
 | 
				
			||||||
				sha FileBlob (asTopFilePath $ fileJournal file)
 | 
									sha FileBlob (asTopFilePath $ fileJournal file)
 | 
				
			||||||
			removeFile path
 | 
					 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -301,8 +301,8 @@ saveState :: Bool -> Annex ()
 | 
				
			||||||
saveState oneshot = doSideAction $ do
 | 
					saveState oneshot = doSideAction $ do
 | 
				
			||||||
	Annex.Queue.flush
 | 
						Annex.Queue.flush
 | 
				
			||||||
	unless oneshot $
 | 
						unless oneshot $
 | 
				
			||||||
		ifM alwayscommit
 | 
							whenM alwayscommit $
 | 
				
			||||||
			( Annex.Branch.commit "update" , Annex.Branch.stage)
 | 
								Annex.Branch.commit "update"
 | 
				
			||||||
	where
 | 
						where
 | 
				
			||||||
		alwayscommit = fromMaybe True . Git.Config.isTrue
 | 
							alwayscommit = fromMaybe True . Git.Config.isTrue
 | 
				
			||||||
			<$> getConfig (annexConfig "alwayscommit") ""
 | 
								<$> getConfig (annexConfig "alwayscommit") ""
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -23,7 +23,6 @@ module Locations (
 | 
				
			||||||
	gitAnnexJournalLock,
 | 
						gitAnnexJournalLock,
 | 
				
			||||||
	gitAnnexIndex,
 | 
						gitAnnexIndex,
 | 
				
			||||||
	gitAnnexIndexLock,
 | 
						gitAnnexIndexLock,
 | 
				
			||||||
	gitAnnexIndexDirty,
 | 
					 | 
				
			||||||
	gitAnnexPidFile,
 | 
						gitAnnexPidFile,
 | 
				
			||||||
	gitAnnexDaemonStatusFile,
 | 
						gitAnnexDaemonStatusFile,
 | 
				
			||||||
	gitAnnexLogFile,
 | 
						gitAnnexLogFile,
 | 
				
			||||||
| 
						 | 
					@ -152,10 +151,6 @@ gitAnnexIndex r = gitAnnexDir r </> "index"
 | 
				
			||||||
gitAnnexIndexLock :: Git.Repo -> FilePath
 | 
					gitAnnexIndexLock :: Git.Repo -> FilePath
 | 
				
			||||||
gitAnnexIndexLock r = gitAnnexDir r </> "index.lck"
 | 
					gitAnnexIndexLock r = gitAnnexDir r </> "index.lck"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Flag file for .git/annex/index. -}
 | 
					 | 
				
			||||||
gitAnnexIndexDirty :: Git.Repo -> FilePath
 | 
					 | 
				
			||||||
gitAnnexIndexDirty r = gitAnnexDir r </> "index.dirty"
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
{- Pid file for daemon mode. -}
 | 
					{- Pid file for daemon mode. -}
 | 
				
			||||||
gitAnnexPidFile :: Git.Repo -> FilePath
 | 
					gitAnnexPidFile :: Git.Repo -> FilePath
 | 
				
			||||||
gitAnnexPidFile r = gitAnnexDir r </> "daemon.pid"
 | 
					gitAnnexPidFile r = gitAnnexDir r </> "daemon.pid"
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue