sync: Fix bug in direct mode that caused a file not checked into git to be deleted when merging with a remote that added a file by the same name. (Thanks, jkt)

This commit is contained in:
Joey Hess 2014-03-03 14:57:16 -04:00
parent 04b77328ef
commit 1192d98721
6 changed files with 91 additions and 39 deletions

View file

@ -7,6 +7,7 @@
module Annex.CatFile (
catFile,
catFileDetails,
catObject,
catTree,
catObjectDetails,
@ -34,6 +35,11 @@ catFile branch file = do
h <- catFileHandle
liftIO $ Git.CatFile.catFile h branch file
catFileDetails :: Git.Branch -> FilePath -> Annex (Maybe (L.ByteString, Sha, ObjectType))
catFileDetails branch file = do
h <- catFileHandle
liftIO $ Git.CatFile.catFileDetails h branch file
catObject :: Git.Ref -> Annex L.ByteString
catObject ref = do
h <- catFileHandle

View file

@ -33,6 +33,7 @@ import Utility.CopyFile
import Annex.Perms
import Annex.ReplaceFile
import Annex.Exception
import Annex.VariantFile
{- Uses git ls-files to find files that need to be committed, and stages
- them into the index. Returns True if some changes were staged. -}
@ -142,9 +143,6 @@ addDirect file cache = do
{- In direct mode, git merge would usually refuse to do anything, since it
- sees present direct mode files as type changed files. To avoid this,
- merge is run with the work tree set to a temp directory.
-
- This should only be used once any changes to the real working tree have
- already been committed, because it overwrites files in the working tree.
-}
mergeDirect :: FilePath -> Git.Ref -> Git.Repo -> IO Bool
mergeDirect d branch g = do
@ -193,18 +191,42 @@ mergeDirectCleanup d oldsha newsha = do
void $ tryIO $ removeDirectory $ parentDir f
{- If the file is already present, with the right content for the
- key, it's left alone. Otherwise, create the symlink and then
- if possible, replace it with the content. -}
- key, it's left alone.
-
- If the file is already present, and does not exist in the
- oldsha branch, preserve this local file.
-
- Otherwise, create the symlink and then if possible, replace it
- with the content. -}
movein k f = unlessM (goodContent k f) $ do
preserveUnannexed f
l <- inRepo $ gitAnnexLink f k
replaceFile f $ makeAnnexLink l
toDirect k f
{- Any new, modified, or renamed files were written to the temp
- directory by the merge, and are moved to the real work tree. -}
movein_raw f item = liftIO $ do
createDirectoryIfMissing True $ parentDir f
void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f
movein_raw f item = do
preserveUnannexed f
liftIO $ do
createDirectoryIfMissing True $ parentDir f
void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f
{- If the file is present in the work tree, but did not exist in
- the oldsha branch, preserve this local, unannexed file. -}
preserveUnannexed f = whenM (liftIO $ exists f) $
whenM (isNothing <$> catFileDetails oldsha f) $
liftIO $ findnewname (0 :: Int)
where
exists = isJust <$$> catchMaybeIO . getSymbolicLinkStatus
findnewname n = do
let localf = mkVariant f
("local" ++ if n > 0 then show n else "")
ifM (exists localf)
( findnewname (n+1)
, rename f localf
`catchIO` const (findnewname (n+1))
)
{- If possible, converts a symlink in the working tree into a direct
- mode file. If the content is not available, leaves the symlink

45
Annex/VariantFile.hs Normal file
View file

@ -0,0 +1,45 @@
{- git-annex .variant files for automatic merge conflict resolution
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.VariantFile where
import Common.Annex
import Types.Key
import Data.Hash.MD5
variantMarker :: String
variantMarker = ".variant-"
mkVariant :: FilePath -> String -> FilePath
mkVariant file variant = takeDirectory file
</> dropExtension (takeFileName file)
++ variantMarker ++ variant
++ takeExtension file
{- The filename to use when resolving a conflicted merge of a file,
- that points to a key.
-
- Something derived from the key needs to be included in the filename,
- but rather than exposing the whole key to the user, a very weak hash
- is used. There is a very real, although still unlikely, chance of
- conflicts using this hash.
-
- In the event that there is a conflict with the filename generated
- for some other key, that conflict will itself be handled by the
- conflicted merge resolution code. That case is detected, and the full
- key is used in the filename.
-}
variantFile :: FilePath -> Key -> FilePath
variantFile file key
| doubleconflict = mkVariant file (key2file key)
| otherwise = mkVariant file (shortHash $ key2file key)
where
doubleconflict = variantMarker `isInfixOf` file
shortHash :: String -> String
shortHash = take 4 . md5s . md5FilePath