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:
parent
e433c6f0bb
commit
76911a446a
5 changed files with 43 additions and 27 deletions
|
@ -64,11 +64,11 @@ verifyLocationLog key file = do
|
||||||
|
|
||||||
case (present, u `elem` uuids) of
|
case (present, u `elem` uuids) of
|
||||||
(True, False) -> do
|
(True, False) -> do
|
||||||
fix g u ValuePresent
|
fix u ValuePresent
|
||||||
-- There is no data loss, so do not fail.
|
-- There is no data loss, so do not fail.
|
||||||
return True
|
return True
|
||||||
(False, True) -> do
|
(False, True) -> do
|
||||||
fix g u ValueMissing
|
fix u ValueMissing
|
||||||
warning $
|
warning $
|
||||||
"** Based on the location log, " ++ file
|
"** Based on the location log, " ++ file
|
||||||
++ "\n** was expected to be present, " ++
|
++ "\n** was expected to be present, " ++
|
||||||
|
@ -77,7 +77,6 @@ verifyLocationLog key file = do
|
||||||
_ -> return True
|
_ -> return True
|
||||||
|
|
||||||
where
|
where
|
||||||
fix g u s = do
|
fix u s = do
|
||||||
showNote "fixing location log"
|
showNote "fixing location log"
|
||||||
_ <- liftIO $ logChange g key u s
|
logStatusFor u key s
|
||||||
return ()
|
|
||||||
|
|
|
@ -7,19 +7,15 @@
|
||||||
|
|
||||||
module Command.Move where
|
module Command.Move where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Command.Drop
|
import qualified Command.Drop
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified AnnexQueue
|
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Types
|
import Types
|
||||||
import Content
|
import Content
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
import Messages
|
||||||
import Utility
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "move" paramPath seek
|
command = [repoCommand "move" paramPath seek
|
||||||
|
@ -57,10 +53,8 @@ showAction False file = showStart "copy" file
|
||||||
- for bare repos. -}
|
- for bare repos. -}
|
||||||
remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
|
remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
|
||||||
remoteHasKey remote key present = do
|
remoteHasKey remote key present = do
|
||||||
g <- Annex.gitRepo
|
|
||||||
let remoteuuid = Remote.uuid remote
|
let remoteuuid = Remote.uuid remote
|
||||||
logfile <- liftIO $ logChange g key remoteuuid status
|
logStatusFor remoteuuid key status
|
||||||
AnnexQueue.add "add" [Param "--"] logfile
|
|
||||||
where
|
where
|
||||||
status = if present then ValuePresent else ValueMissing
|
status = if present then ValuePresent else ValueMissing
|
||||||
|
|
||||||
|
|
16
Content.hs
16
Content.hs
|
@ -9,6 +9,7 @@ module Content (
|
||||||
inAnnex,
|
inAnnex,
|
||||||
calcGitLink,
|
calcGitLink,
|
||||||
logStatus,
|
logStatus,
|
||||||
|
logStatusFor,
|
||||||
getViaTmp,
|
getViaTmp,
|
||||||
getViaTmpUnchecked,
|
getViaTmpUnchecked,
|
||||||
checkDiskSpace,
|
checkDiskSpace,
|
||||||
|
@ -61,7 +62,8 @@ calcGitLink file key = do
|
||||||
return $ relPathDirToFile (parentDir absfile)
|
return $ relPathDirToFile (parentDir absfile)
|
||||||
(Git.workTree g) </> ".git" </> annexLocation key
|
(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.
|
- Note that the LocationLog is not updated in bare repositories.
|
||||||
- Operations that change a bare repository should be done from
|
- Operations that change a bare repository should be done from
|
||||||
|
@ -69,11 +71,19 @@ calcGitLink file key = do
|
||||||
- updated instead. -}
|
- updated instead. -}
|
||||||
logStatus :: Key -> LogStatus -> Annex ()
|
logStatus :: Key -> LogStatus -> Annex ()
|
||||||
logStatus key status = do
|
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
|
g <- Annex.gitRepo
|
||||||
unless (Git.repoIsLocalBare g) $ do
|
unless (Git.repoIsLocalBare g) $ do
|
||||||
u <- getUUID g
|
|
||||||
logfile <- liftIO $ logChange g key u status
|
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,
|
{- Runs an action, passing it a temporary filename to download,
|
||||||
- and if the action succeeds, moves the temp file into
|
- and if the action succeeds, moves the temp file into
|
||||||
|
|
35
GitRepo.hs
35
GitRepo.hs
|
@ -21,8 +21,8 @@ module GitRepo (
|
||||||
repoDescribe,
|
repoDescribe,
|
||||||
repoLocation,
|
repoLocation,
|
||||||
workTree,
|
workTree,
|
||||||
|
workTreeFile,
|
||||||
gitDir,
|
gitDir,
|
||||||
relative,
|
|
||||||
urlPath,
|
urlPath,
|
||||||
urlHost,
|
urlHost,
|
||||||
urlPort,
|
urlPort,
|
||||||
|
@ -59,7 +59,7 @@ module GitRepo (
|
||||||
prop_idempotent_deencode
|
prop_idempotent_deencode
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (unless, when)
|
import Control.Monad (unless)
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.Posix.Directory
|
import System.Posix.Directory
|
||||||
|
@ -236,27 +236,38 @@ workTree r@(Repo { location = Url _ }) = urlPath r
|
||||||
workTree (Repo { location = Dir d }) = d
|
workTree (Repo { location = Dir d }) = d
|
||||||
workTree Repo { location = Unknown } = undefined
|
workTree Repo { location = Unknown } = undefined
|
||||||
|
|
||||||
{- Given a relative or absolute filename in a repository, calculates the
|
{- Given a relative or absolute filename inside a git repository's
|
||||||
- name to use to refer to the file relative to a git repository's top.
|
- workTree, calculates the name to use to refer to that file to git.
|
||||||
- This is the same form displayed and used by git. -}
|
-
|
||||||
relative :: Repo -> FilePath -> IO FilePath
|
- This is complicated because the best choice can vary depending on
|
||||||
relative repo@(Repo { location = Dir d }) file = do
|
- 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
|
cwd <- getCurrentDirectory
|
||||||
let file' = absfile cwd
|
let file' = absfile cwd
|
||||||
let len = length absrepo
|
unless (inrepo file') $
|
||||||
when (take len file' /= absrepo) $
|
|
||||||
error $ file ++ " is not located inside git repository " ++ absrepo
|
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
|
where
|
||||||
-- normalize both repo and file, so that repo
|
-- normalize both repo and file, so that repo
|
||||||
-- will be substring of file
|
-- will be substring of file
|
||||||
absrepo = case (absNormPath "/" d) of
|
absrepo = case (absNormPath "/" d) of
|
||||||
Just f -> f ++ "/"
|
Just f -> addTrailingPathSeparator f
|
||||||
Nothing -> error $ "bad repo" ++ repoDescribe repo
|
Nothing -> error $ "bad repo" ++ repoDescribe repo
|
||||||
absfile c = case (secureAbsNormPath c file) of
|
absfile c = case (secureAbsNormPath c file) of
|
||||||
Just f -> f
|
Just f -> f
|
||||||
Nothing -> file
|
Nothing -> file
|
||||||
relative repo _ = assertLocal repo $ error "internal"
|
inrepo f = absrepo `isPrefixOf` f
|
||||||
|
workTreeFile repo _ = assertLocal repo $ error "internal"
|
||||||
|
|
||||||
{- Path of an URL repo. -}
|
{- Path of an URL repo. -}
|
||||||
urlPath :: Repo -> String
|
urlPath :: Repo -> String
|
||||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -4,6 +4,8 @@ git-annex (0.20110421) UNRELEASED; urgency=low
|
||||||
* Remove testpack from build depends, as it is not available
|
* Remove testpack from build depends, as it is not available
|
||||||
on all architectures. The test suite will not be run if it
|
on all architectures. The test suite will not be run if it
|
||||||
cannot be compiled.
|
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
|
-- Joey Hess <joeyh@debian.org> Thu, 21 Apr 2011 16:35:27 -0400
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue