2b66492d6e
And for tab completion, by not unnessessarily statting paths to remotes, which used to cause eg, spin-up of removable drives. Got rid of the remotes member of Git.Repo. This was a bit painful. Remote.Git modifies the list of remotes as it reads their configs, so still need a persistent list of remotes. So, put it in as Annex.gitremotes. It's only populated by getGitRemotes, so commands like examinekey that don't care about remotes won't do so. This commit was sponsored by Jake Vosloo on Patreon.
98 lines
3.2 KiB
Haskell
98 lines
3.2 KiB
Haskell
{- git-annex repository fixups
|
|
-
|
|
- Copyright 2013, 2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.Fixup where
|
|
|
|
import Git.Types
|
|
import Git.Config
|
|
import Types.GitConfig
|
|
import qualified Git.BuildVersion
|
|
import Utility.Path
|
|
import Utility.SafeCommand
|
|
import Utility.Directory
|
|
import Utility.Exception
|
|
|
|
import System.IO
|
|
import System.FilePath
|
|
import System.PosixCompat.Files
|
|
import Data.List
|
|
import Control.Monad
|
|
import Control.Monad.IfElse
|
|
import qualified Data.Map as M
|
|
|
|
fixupRepo :: Repo -> GitConfig -> IO Repo
|
|
fixupRepo r c = do
|
|
let r' = disableWildcardExpansion r
|
|
r'' <- fixupSubmodule r' c
|
|
if annexDirect c
|
|
then return (fixupDirect r'')
|
|
else return r''
|
|
|
|
{- Disable git's built-in wildcard expansion, which is not wanted
|
|
- when using it as plumbing by git-annex. -}
|
|
disableWildcardExpansion :: Repo -> Repo
|
|
disableWildcardExpansion r
|
|
| Git.BuildVersion.older "1.8.1" = r
|
|
| otherwise = r
|
|
{ gitGlobalOpts = gitGlobalOpts r ++ [Param "--literal-pathspecs"] }
|
|
|
|
{- 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 -> Repo
|
|
fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do
|
|
r
|
|
{ location = l { worktree = Just (parentDir d) }
|
|
, gitGlobalOpts = gitGlobalOpts r ++
|
|
[ Param "-c"
|
|
, Param $ coreBare ++ "=" ++ boolConfig False
|
|
]
|
|
}
|
|
fixupDirect r = r
|
|
|
|
{- Submodules have their gitdir containing ".git/modules/", and
|
|
- have core.worktree set, and also have a .git file in the top
|
|
- of the repo.
|
|
-
|
|
- We need to unset core.worktree, and change the .git file into a
|
|
- symlink to the git directory. This way, annex symlinks will be
|
|
- of the usual .git/annex/object form, and will consistently work
|
|
- whether a repo is used as a submodule or not, and wheverever the
|
|
- submodule is mounted.
|
|
-
|
|
- When the filesystem doesn't support symlinks, we cannot make .git
|
|
- into a symlink. But we don't need too, since the repo will use direct
|
|
- mode, In this case, we merely adjust the Repo so that
|
|
- symlinks to objects that get checked in will be in the right form.
|
|
-}
|
|
fixupSubmodule :: Repo -> GitConfig -> IO Repo
|
|
fixupSubmodule r@(Repo { location = l@(Local { worktree = Just w, gitdir = d }) }) c
|
|
| needsSubmoduleFixup r = do
|
|
when (coreSymlinks c) $
|
|
replacedotgit
|
|
`catchNonAsync` \_e -> hPutStrLn stderr
|
|
"warning: unable to convert submodule to form that will work with git-annex"
|
|
return $ r
|
|
{ location = if coreSymlinks c
|
|
then l { gitdir = dotgit }
|
|
else l
|
|
, config = M.delete "core.worktree" (config r)
|
|
}
|
|
where
|
|
dotgit = w </> ".git"
|
|
replacedotgit = whenM (doesFileExist dotgit) $ do
|
|
linktarget <- relPathDirToFile w d
|
|
nukeFile dotgit
|
|
createSymbolicLink linktarget dotgit
|
|
maybe (error "unset core.worktree failed") (\_ -> return ())
|
|
=<< Git.Config.unset "core.worktree" r
|
|
fixupSubmodule r _ = return r
|
|
|
|
needsSubmoduleFixup :: Repo -> Bool
|
|
needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) =
|
|
(".git" </> "modules") `isInfixOf` d
|
|
needsSubmoduleFixup _ = False
|