fix reversion in relative paths to local remotes of direct mode repos

0980f3dae6 broke support for local remotes
from direct mode repos, because the relative path was taken to be from the
gitdir, rather than from the work tree.
This commit is contained in:
Joey Hess 2013-11-26 18:11:37 -04:00
parent bc0517fc86
commit b25abdb3e6
2 changed files with 39 additions and 22 deletions

View file

@ -40,12 +40,11 @@ import Control.Concurrent
import Common
import qualified Git
import qualified Git.Config
import Git.Types hiding (remotes)
import Annex.Direct.Fixup
import Git.CatFile
import Git.CheckAttr
import Git.CheckIgnore
import Git.SharedRepository
import Git.Config
import qualified Git.Queue
import Types.Backend
import Types.GitConfig
@ -112,9 +111,9 @@ data AnnexState = AnnexState
, useragent :: Maybe String
}
newState :: Git.Repo -> AnnexState
newState r = AnnexState
{ repo = if annexDirect c then fixupDirect r else r
newState :: GitConfig -> Git.Repo -> AnnexState
newState c r = AnnexState
{ repo = r
, gitconfig = c
, backends = []
, remotes = []
@ -145,13 +144,14 @@ newState r = AnnexState
, inodeschanged = Nothing
, useragent = Nothing
}
where
c = extractGitConfig r
{- Makes an Annex state object for the specified git repo.
- Ensures the config is read, if it was not already. -}
new :: Git.Repo -> IO AnnexState
new = newState <$$> Git.Config.read
new r = do
r' <- Git.Config.read r
let c = extractGitConfig r'
newState c <$> if annexDirect c then fixupDirect r' else return r'
{- Performs an action in the Annex monad from a starting state,
- returning a new state. -}
@ -250,17 +250,3 @@ withCurrentState :: Annex a -> Annex (IO a)
withCurrentState a = do
s <- getState id
return $ eval s a
{- Direct mode repos have core.bare=true, but are not really bare.
- Fix up the Repo to be a non-bare repo, and arrange for git commands
- run by git-annex to be passed parameters that override this setting. -}
fixupDirect :: Git.Repo -> Git.Repo
fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) =
r
{ location = l { worktree = Just (parentDir d) }
, gitGlobalOpts = gitGlobalOpts r ++
[ Param "-c"
, Param $ coreBare ++ "=" ++ boolConfig False
]
}
fixupDirect r = r

31
Annex/Direct/Fixup.hs Normal file
View file

@ -0,0 +1,31 @@
{- git-annex direct mode guard fixup
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.Direct.Fixup where
import Git.Types
import Git.Config
import qualified Git.Construct as Construct
import Utility.Path
import Utility.SafeCommand
{- Direct mode repos have core.bare=true, but are not really bare.
- Fix up the Repo to be a non-bare repo, and arrange for git commands
- run by git-annex to be passed parameters that override this setting. -}
fixupDirect :: Repo -> IO Repo
fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do
let r' = r
{ location = l { worktree = Just (parentDir d) }
, gitGlobalOpts = gitGlobalOpts r ++
[ Param "-c"
, Param $ coreBare ++ "=" ++ boolConfig False
]
}
-- Recalc now that the worktree is correct.
rs' <- Construct.fromRemotes r'
return $ r' { remotes = rs' }
fixupDirect r = return r