Avoid using absolute paths when staging location log, as that can confuse git when a remote's path contains a symlink. Closes: #621386

This was a real PITA to fix, since location logs can be staged in
both the current repo, as well as in local remote's repos, in
which case the cwd will not be in the repo. And git add needs different
params in both cases, when absolute paths are not used.

In passing, git annex fsck now stages location log fixes.
This commit is contained in:
Joey Hess 2011-04-25 14:54:24 -04:00
parent e433c6f0bb
commit 76911a446a
5 changed files with 43 additions and 27 deletions

View file

@ -64,11 +64,11 @@ verifyLocationLog key file = do
case (present, u `elem` uuids) of
(True, False) -> do
fix g u ValuePresent
fix u ValuePresent
-- There is no data loss, so do not fail.
return True
(False, True) -> do
fix g u ValueMissing
fix u ValueMissing
warning $
"** Based on the location log, " ++ file
++ "\n** was expected to be present, " ++
@ -77,7 +77,6 @@ verifyLocationLog key file = do
_ -> return True
where
fix g u s = do
fix u s = do
showNote "fixing location log"
_ <- liftIO $ logChange g key u s
return ()
logStatusFor u key s

View file

@ -7,19 +7,15 @@
module Command.Move where
import Control.Monad.State (liftIO)
import Command
import qualified Command.Drop
import qualified Annex
import qualified AnnexQueue
import LocationLog
import Types
import Content
import qualified Remote
import UUID
import Messages
import Utility
command :: [Command]
command = [repoCommand "move" paramPath seek
@ -57,10 +53,8 @@ showAction False file = showStart "copy" file
- for bare repos. -}
remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
remoteHasKey remote key present = do
g <- Annex.gitRepo
let remoteuuid = Remote.uuid remote
logfile <- liftIO $ logChange g key remoteuuid status
AnnexQueue.add "add" [Param "--"] logfile
logStatusFor remoteuuid key status
where
status = if present then ValuePresent else ValueMissing

View file

@ -9,6 +9,7 @@ module Content (
inAnnex,
calcGitLink,
logStatus,
logStatusFor,
getViaTmp,
getViaTmpUnchecked,
checkDiskSpace,
@ -61,7 +62,8 @@ calcGitLink file key = do
return $ relPathDirToFile (parentDir absfile)
(Git.workTree g) </> ".git" </> annexLocation key
{- Updates the LocationLog when a key's presence changes.
{- Updates the LocationLog when a key's presence changes in the current
- repository.
-
- Note that the LocationLog is not updated in bare repositories.
- Operations that change a bare repository should be done from
@ -69,11 +71,19 @@ calcGitLink file key = do
- updated instead. -}
logStatus :: Key -> LogStatus -> Annex ()
logStatus key status = do
g <- Annex.gitRepo
u <- getUUID g
logStatusFor u key status
{- Updates the LocationLog when a key's presence changes in a repository
- identified by UUID. -}
logStatusFor :: UUID -> Key -> LogStatus -> Annex ()
logStatusFor u key status = do
g <- Annex.gitRepo
unless (Git.repoIsLocalBare g) $ do
u <- getUUID g
logfile <- liftIO $ logChange g key u status
AnnexQueue.add "add" [Param "--"] logfile
rellogfile <- liftIO $ Git.workTreeFile g logfile
AnnexQueue.add "add" [Param "--"] rellogfile
{- Runs an action, passing it a temporary filename to download,
- and if the action succeeds, moves the temp file into

View file

@ -21,8 +21,8 @@ module GitRepo (
repoDescribe,
repoLocation,
workTree,
workTreeFile,
gitDir,
relative,
urlPath,
urlHost,
urlPort,
@ -59,7 +59,7 @@ module GitRepo (
prop_idempotent_deencode
) where
import Control.Monad (unless, when)
import Control.Monad (unless)
import System.Directory
import System.FilePath
import System.Posix.Directory
@ -236,27 +236,38 @@ workTree r@(Repo { location = Url _ }) = urlPath r
workTree (Repo { location = Dir d }) = d
workTree Repo { location = Unknown } = undefined
{- Given a relative or absolute filename in a repository, calculates the
- name to use to refer to the file relative to a git repository's top.
- This is the same form displayed and used by git. -}
relative :: Repo -> FilePath -> IO FilePath
relative repo@(Repo { location = Dir d }) file = do
{- Given a relative or absolute filename inside a git repository's
- workTree, calculates the name to use to refer to that file to git.
-
- This is complicated because the best choice can vary depending on
- whether the cwd is in a subdirectory of the git repository, or not.
-
- For example, when adding a file "/tmp/repo/foo", it's best to refer
- to it as "foo" if the cwd is outside the repository entirely
- (this avoids a gotcha with using the full path name when /tmp/repo
- is itself a symlink). But, if the cwd is "/tmp/repo/subdir",
- it's best to refer to "../foo".
-}
workTreeFile :: Repo -> FilePath -> IO FilePath
workTreeFile repo@(Repo { location = Dir d }) file = do
cwd <- getCurrentDirectory
let file' = absfile cwd
let len = length absrepo
when (take len file' /= absrepo) $
unless (inrepo file') $
error $ file ++ " is not located inside git repository " ++ absrepo
return $ drop (length absrepo) file'
if (inrepo $ addTrailingPathSeparator cwd)
then return $ relPathDirToFile cwd file'
else return $ drop (length absrepo) file'
where
-- normalize both repo and file, so that repo
-- will be substring of file
absrepo = case (absNormPath "/" d) of
Just f -> f ++ "/"
Just f -> addTrailingPathSeparator f
Nothing -> error $ "bad repo" ++ repoDescribe repo
absfile c = case (secureAbsNormPath c file) of
Just f -> f
Nothing -> file
relative repo _ = assertLocal repo $ error "internal"
inrepo f = absrepo `isPrefixOf` f
workTreeFile repo _ = assertLocal repo $ error "internal"
{- Path of an URL repo. -}
urlPath :: Repo -> String

2
debian/changelog vendored
View file

@ -4,6 +4,8 @@ git-annex (0.20110421) UNRELEASED; urgency=low
* Remove testpack from build depends, as it is not available
on all architectures. The test suite will not be run if it
cannot be compiled.
* Avoid using absolute paths when staging location log, as that can
confuse git when a remote's path contains a symlink. Closes: #621386
-- Joey Hess <joeyh@debian.org> Thu, 21 Apr 2011 16:35:27 -0400