diff options
author | Joey Hess <joey@kitenet.net> | 2014-03-03 14:57:16 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-03-03 14:57:16 -0400 |
commit | a9067868a8594577ead2ecbe55f9563bef12f26d (patch) | |
tree | 1694cea1754589a7cf0d8ed3096e03d9d430b99d /Command/Sync.hs | |
parent | 8d6edac6f48a4bf1522b68a30db579193c097e7a (diff) |
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)
Diffstat (limited to 'Command/Sync.hs')
-rw-r--r-- | Command/Sync.hs | 33 |
1 files changed, 2 insertions, 31 deletions
diff --git a/Command/Sync.hs b/Command/Sync.hs index 04086eab2..e8e1d345f 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -28,7 +28,6 @@ import qualified Git import Git.Types (BlobType(..)) import qualified Types.Remote import qualified Remote.Git -import Types.Key import Config import Annex.ReplaceFile import Git.FileMode @@ -39,9 +38,9 @@ import qualified Command.Move import Logs.Location import Annex.Drop import Annex.UUID +import Annex.VariantFile import qualified Data.Set as S -import Data.Hash.MD5 import Control.Concurrent.MVar def :: [Command] @@ -415,7 +414,7 @@ resolveMerge' u file = LsFiles.unmergedFile u issymlink select = select (LsFiles.unmergedBlobType u) `elem` [Just SymlinkBlob, Nothing] makelink key = do - let dest = mergeFile file key + let dest = variantFile file key l <- inRepo $ gitAnnexLink dest key replaceFile dest $ makeAnnexLink l stageSymlink dest =<< hashSymlink l @@ -478,34 +477,6 @@ cleanConflictCruft resolvedfs top = do matchesresolved f = S.member (base f) s base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f -{- 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. - -} -mergeFile :: FilePath -> Key -> FilePath -mergeFile file key - | doubleconflict = go $ key2file key - | otherwise = go $ shortHash $ key2file key - where - varmarker = ".variant-" - doubleconflict = varmarker `isInfixOf` file - go v = takeDirectory file - </> dropExtension (takeFileName file) - ++ varmarker ++ v - ++ takeExtension file - -shortHash :: String -> String -shortHash = take 4 . md5s . md5FilePath - changed :: Remote -> Git.Ref -> Annex Bool changed remote b = do let r = remoteBranch remote b |