Switch to using relative paths to the git repository.

This allows the git repository to be moved while git-annex is running in
it, with fewer problems.

On Windows, this avoids some of the problems with the absurdly small
MAX_PATH of 260 bytes. In particular, git-annex repositories should
work in deeper/longer directory structures than before. See
http://git-annex.branchable.com/bugs/__34__git-annex:_direct:_1_failed__34___on_Windows/

There are several possible ways this change could break git-annex:

1. If it changes its working directory while it's running, that would
   be Bad News. Good news everyone! git-annex never does so. It would also
   break thread safety, so all such things were stomped out long ago.

2. parentDir "." -> "" which is not a valid path. I had to fix one
   instace of this, and I should probably wipe all calls to parentDir out
   of the git-annex code base; it was never a good idea.

3. Things like relPathDirToFile require absolute input paths,
   and code assumes that the git repo path is absolute and passes it to it
   as-is. In the case of relPathDirToFile, I converted it to not make
   this assumption.

Currently, the test suite has 16 failures.
This commit is contained in:
Joey Hess 2015-01-06 15:31:24 -04:00
parent 550f269828
commit cd865c3b8f
14 changed files with 70 additions and 50 deletions

46
Git.hs
View file

@ -31,6 +31,7 @@ module Git (
hookPath,
assertLocal,
adjustPath,
relPath,
) where
import Network.URI (uriPath, uriScheme, unEscapeString)
@ -141,25 +142,28 @@ hookPath script repo = do
isexecutable f = isExecutable . fileMode <$> getFileStatus f
#endif
{- Adusts the path to a local Repo.
-
- On windows, prefixing a path with \\?\ makes it be processed as a raw
- path (/ is not converted to \). The benefit is that such a path does
- avoids Windows's 260 byte limitation on the entire path. -}
adjustPath :: Repo -> Repo
adjustPath r@(Repo { location = l@(Local { gitdir = d, worktree = w }) }) = r
{ location = l
{ gitdir = adjustPath' d
, worktree = fmap adjustPath' w
}
}
adjustPath r@(Repo { location = LocalUnknown d }) =
r { location = LocalUnknown (adjustPath' d) }
adjustPath r = r
{- Makes the path to a local Repo be relative to the cwd. -}
relPath :: Repo -> IO Repo
relPath = adjustPath torel
where
torel p = do
p' <- relPathCwdToFile p
if null p'
then return "."
else return p'
adjustPath' :: FilePath -> FilePath
#if mingw32_HOST_OS
adjustPath' d = "\\\\?\\" ++ d
#else
adjustPath' = id
#endif
{- Adusts the path to a local Repo using the provided function. -}
adjustPath :: (FilePath -> IO FilePath) -> Repo -> IO Repo
adjustPath f r@(Repo { location = l@(Local { gitdir = d, worktree = w }) }) = do
d' <- f d
w' <- maybe (pure Nothing) (Just <$$> f) w
return $ r
{ location = l
{ gitdir = d'
, worktree = w'
}
}
adjustPath f r@(Repo { location = LocalUnknown d }) = do
d' <- f d
return $ r { location = LocalUnknown d' }
adjustPath _ r = pure r