From 76911a446a7156ffb23679c6325fa8aab1edce13 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 25 Apr 2011 14:54:24 -0400 Subject: [PATCH] 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. --- Command/Fsck.hs | 9 ++++----- Command/Move.hs | 8 +------- Content.hs | 16 +++++++++++++--- GitRepo.hs | 35 +++++++++++++++++++++++------------ debian/changelog | 2 ++ 5 files changed, 43 insertions(+), 27 deletions(-) diff --git a/Command/Fsck.hs b/Command/Fsck.hs index bedb9fb992..20ef2c8083 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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 diff --git a/Command/Move.hs b/Command/Move.hs index e5e78d2495..476bf866a0 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -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 diff --git a/Content.hs b/Content.hs index 576eecb319..bf94562218 100644 --- a/Content.hs +++ b/Content.hs @@ -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 diff --git a/GitRepo.hs b/GitRepo.hs index 3e177cf1be..2bf320eda2 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -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 diff --git a/debian/changelog b/debian/changelog index 872277d0f5..c6dfb1ff32 100644 --- a/debian/changelog +++ b/debian/changelog @@ -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 Thu, 21 Apr 2011 16:35:27 -0400