40ecf58d4b
This does not change the overall license of the git-annex program, which was already AGPL due to a number of sources files being AGPL already. Legally speaking, I'm adding a new license under which these files are now available; I already released their current contents under the GPL license. Now they're dual licensed GPL and AGPL. However, I intend for all my future changes to these files to only be released under the AGPL license, and I won't be tracking the dual licensing status, so I'm simply changing the license statement to say it's AGPL. (In some cases, others wrote parts of the code of a file and released it under the GPL; but in all cases I have contributed a significant portion of the code in each file and it's that code that is getting the AGPL license; the GPL license of other contributors allows combining with AGPL code.)
109 lines
3.3 KiB
Haskell
109 lines
3.3 KiB
Haskell
{- Temporarily changing the files git uses.
|
|
-
|
|
- Copyright 2014-2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.GitOverlay where
|
|
|
|
import qualified Control.Exception as E
|
|
|
|
import Annex.Common
|
|
import Git
|
|
import Git.Types
|
|
import Git.Index
|
|
import Git.Env
|
|
import Utility.Env
|
|
import qualified Annex
|
|
import qualified Annex.Queue
|
|
|
|
{- Runs an action using a different git index file. -}
|
|
withIndexFile :: FilePath -> Annex a -> Annex a
|
|
withIndexFile f a = do
|
|
f' <- liftIO $ indexEnvVal f
|
|
withAltRepo
|
|
(usecachedgitenv $ \g -> liftIO $ addGitEnv g indexEnv f')
|
|
(\g g' -> g' { gitEnv = gitEnv g })
|
|
a
|
|
where
|
|
-- This is an optimisation. Since withIndexFile is run repeatedly,
|
|
-- and addGitEnv uses the slow getEnvironment when gitEnv is Nothing,
|
|
-- we cache the environment the first time, and reuse it in
|
|
-- subsequent calls.
|
|
--
|
|
-- (This could be done at another level; eg when creating the
|
|
-- Git object in the first place, but it's more efficient to let
|
|
-- the enviroment be inherited in all calls to git where it
|
|
-- does not need to be modified.)
|
|
usecachedgitenv m g = case gitEnv g of
|
|
Just _ -> m g
|
|
Nothing -> do
|
|
e <- Annex.withState $ \s -> case Annex.cachedgitenv s of
|
|
Nothing -> do
|
|
e <- getEnvironment
|
|
return (s { Annex.cachedgitenv = Just e }, e)
|
|
Just e -> return (s, e)
|
|
m (g { gitEnv = Just e })
|
|
|
|
{- Runs an action using a different git work tree.
|
|
-
|
|
- Smudge and clean filters are disabled in this work tree. -}
|
|
withWorkTree :: FilePath -> Annex a -> Annex a
|
|
withWorkTree d = withAltRepo
|
|
(\g -> return $ g { location = modlocation (location g), gitGlobalOpts = gitGlobalOpts g ++ disableSmudgeConfig })
|
|
(\g g' -> g' { location = location g, gitGlobalOpts = gitGlobalOpts g })
|
|
where
|
|
modlocation l@(Local {}) = l { worktree = Just d }
|
|
modlocation _ = error "withWorkTree of non-local git repo"
|
|
disableSmudgeConfig = map Param
|
|
[ "-c", "filter.annex.smudge="
|
|
, "-c", "filter.annex.clean="
|
|
]
|
|
|
|
{- Runs an action with the git index file and HEAD, and a few other
|
|
- files that are related to the work tree coming from an overlay
|
|
- directory other than the usual. This is done by pointing
|
|
- GIT_COMMON_DIR at the regular git directory, and GIT_DIR at the
|
|
- overlay directory.
|
|
-
|
|
- Needs git 2.2.0 or newer.
|
|
-}
|
|
withWorkTreeRelated :: FilePath -> Annex a -> Annex a
|
|
withWorkTreeRelated d = withAltRepo modrepo unmodrepo
|
|
where
|
|
modrepo g = liftIO $ do
|
|
g' <- addGitEnv g "GIT_COMMON_DIR" =<< absPath (localGitDir g)
|
|
g'' <- addGitEnv g' "GIT_DIR" d
|
|
return (g'' { gitEnvOverridesGitDir = True })
|
|
unmodrepo g g' = g'
|
|
{ gitEnv = gitEnv g
|
|
, gitEnvOverridesGitDir = gitEnvOverridesGitDir g
|
|
}
|
|
|
|
withAltRepo
|
|
:: (Repo -> Annex Repo)
|
|
-- ^ modify Repo
|
|
-> (Repo -> Repo -> Repo)
|
|
-- ^ undo modifications; first Repo is the original and second
|
|
-- is the one after running the action.
|
|
-> Annex a
|
|
-> Annex a
|
|
withAltRepo modrepo unmodrepo a = do
|
|
g <- gitRepo
|
|
g' <- modrepo g
|
|
q <- Annex.Queue.get
|
|
v <- tryNonAsync $ do
|
|
Annex.changeState $ \s -> s
|
|
{ Annex.repo = g'
|
|
-- Start a separate queue for any changes made
|
|
-- with the modified repo.
|
|
, Annex.repoqueue = Nothing
|
|
}
|
|
a
|
|
void $ tryNonAsync Annex.Queue.flush
|
|
Annex.changeState $ \s -> s
|
|
{ Annex.repo = unmodrepo g (Annex.repo s)
|
|
, Annex.repoqueue = Just q
|
|
}
|
|
either E.throw return v
|