mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

don't automerge when the symlinks cannot be parsed as keys

Browse source
This commit is contained in:
Joey Hess 2012-06-27 13:35:02 -04:00
parent 048b64024a
commit abd36ed336
1 changed files with 18 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
Command/Sync.hs
View file

@ -195,19 +195,21 @@ resolveMerge = do
resolveMerge' :: LsFiles.Unmerged -> Annex Bool resolveMerge' :: LsFiles.Unmerged -> Annex Bool
resolveMerge' u resolveMerge' u
| issymlink LsFiles.valUs && issymlink LsFiles.valThem = do | issymlink LsFiles.valUs && issymlink LsFiles.valThem =
keyUs <- getkey LsFiles.valUs withKey LsFiles.valUs $ \keyUs ->
keyThem <- getkey LsFiles.valThem withKey LsFiles.valThem $ \keyThem -> go keyUs keyThem
if (keyUs == keyThem) | otherwise = return False
then makelink keyUs (file ++ "." ++ show keyUs) where
else do go keyUs keyThem
| keyUs == keyThem = do
makelink keyUs (file ++ "." ++ show keyUs)
return True
| otherwise = do
void $ liftIO $ tryIO $ removeFile file void $ liftIO $ tryIO $ removeFile file
Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file] Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
makelink keyUs (file ++ "." ++ show keyUs) makelink keyUs (file ++ "." ++ show keyUs)
makelink keyThem (file ++ "." ++ show keyThem) makelink keyThem (file ++ "." ++ show keyThem)
return True return True
| otherwise = return False
where
file = LsFiles.unmergedFile u file = LsFiles.unmergedFile u
issymlink select = any (select (LsFiles.unmergedBlobType u) ==) issymlink select = any (select (LsFiles.unmergedBlobType u) ==)
[Just SymlinkBlob, Nothing] [Just SymlinkBlob, Nothing]
@ -216,12 +218,15 @@ resolveMerge' u
liftIO $ createSymbolicLink l f liftIO $ createSymbolicLink l f
Annex.Queue.addCommand "add" [Param "--force", Param "--"] [f] Annex.Queue.addCommand "add" [Param "--force", Param "--"] [f]
makelink _ _ = noop makelink _ _ = noop
getkey select = do withKey select a = do
let msha = select $ LsFiles.unmergedSha u let msha = select $ LsFiles.unmergedSha u
case msha of case msha of
Nothing -> return Nothing Nothing -> a Nothing
Just sha -> fileKey . takeFileName Just sha -> do
. encodeW8 . L.unpack <$> catObject sha key <- fileKey . takeFileName
. encodeW8 . L.unpack
<$> catObject sha
maybe (return False) (a . Just) key
changed :: Remote -> Git.Ref -> Annex Bool changed :: Remote -> Git.Ref -> Annex Bool
changed remote b = do changed remote b = do