diff options
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/CatFile.hs | 8 | ||||
-rw-r--r-- | Annex/Direct.hs | 68 | ||||
-rw-r--r-- | Annex/Hook.hs | 42 | ||||
-rw-r--r-- | Annex/Version.hs | 18 |
4 files changed, 119 insertions, 17 deletions
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 407b4ddae..812d032c6 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -27,6 +27,7 @@ import qualified Annex import Git.Types import Git.FilePath import Git.FileMode +import qualified Git.Ref catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do @@ -109,9 +110,6 @@ catKeyChecked needhead ref@(Ref r) = {- From a file in the repository back to the key. - - - Prefixing the file with ./ makes this work even if in a subdirectory - - of a repo. - - - Ideally, this should reflect the key that's staged in the index, - not the key that's committed to HEAD. Unfortunately, git cat-file - does not refresh the index file after it's started up, so things @@ -134,8 +132,8 @@ catKeyChecked needhead ref@(Ref r) = catKeyFile :: FilePath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) ( catKeyFileHEAD f - , catKeyChecked True (Ref $ ":./" ++ f) + , catKeyChecked True $ Git.Ref.fileRef f ) catKeyFileHEAD :: FilePath -> Annex (Maybe Key) -catKeyFileHEAD f = catKeyChecked False (Ref $ "HEAD:./" ++ f) +catKeyFileHEAD f = catKeyChecked False $ Git.Ref.fileFromRef Git.Ref.headRef f diff --git a/Annex/Direct.hs b/Annex/Direct.hs index ea2b577b9..d4b73860e 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -8,13 +8,18 @@ module Annex.Direct where import Common.Annex +import qualified Annex import qualified Git import qualified Git.LsFiles import qualified Git.Merge import qualified Git.DiffTree as DiffTree +import qualified Git.Config +import qualified Git.Ref +import qualified Git.Branch import Git.Sha import Git.FilePath import Git.Types +import Config import Annex.CatFile import qualified Annex.Queue import Logs.Location @@ -231,3 +236,66 @@ changedDirect oldk f = do locs <- removeAssociatedFile oldk f whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ logStatus oldk InfoMissing + +{- Enable/disable direct mode. -} +setDirect :: Bool -> Annex () +setDirect wantdirect = do + if wantdirect + then do + switchHEAD + setbare + else do + setbare + switchHEADBack + setConfig (annexConfig "direct") val + Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect } + where + val = Git.Config.boolConfig wantdirect + setbare = setConfig (ConfigKey Git.Config.coreBare) val + +{- Since direct mode sets core.bare=true, incoming pushes could change + - the currently checked out branch. To avoid this problem, HEAD + - is changed to a internal ref that nothing is going to push to. + - + - For refs/heads/master, use refs/heads/annex/direct/master; + - this way things that show HEAD (eg shell prompts) will + - hopefully show just "master". -} +directBranch :: Ref -> Ref +directBranch orighead = case split "/" $ show orighead of + ("refs":"heads":"annex":"direct":_) -> orighead + ("refs":"heads":rest) -> + Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest + _ -> Ref $ "refs/heads/" ++ show (Git.Ref.base orighead) + +{- Converts a directBranch back to the original branch. + - + - Any other ref is left unchanged. + -} +fromDirectBranch :: Ref -> Ref +fromDirectBranch directhead = case split "/" $ show directhead of + ("refs":"heads":"annex":"direct":rest) -> + Ref $ "refs/heads/" ++ intercalate "/" rest + _ -> directhead + +switchHEAD :: Annex () +switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch orighead = do + let newhead = directBranch orighead + maybe noop (inRepo . Git.Branch.update newhead) + =<< inRepo (Git.Ref.sha orighead) + inRepo $ Git.Branch.checkout newhead + +switchHEADBack :: Annex () +switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch currhead = do + let orighead = fromDirectBranch currhead + v <- inRepo $ Git.Ref.sha currhead + case v of + Just headsha + | orighead /= currhead -> do + inRepo $ Git.Branch.update orighead headsha + inRepo $ Git.Branch.checkout orighead + inRepo $ Git.Branch.delete currhead + _ -> inRepo $ Git.Branch.checkout orighead diff --git a/Annex/Hook.hs b/Annex/Hook.hs new file mode 100644 index 000000000..7301a0958 --- /dev/null +++ b/Annex/Hook.hs @@ -0,0 +1,42 @@ +{- git-annex git hooks + - + - Note that it's important that the scripts not change, otherwise + - removing old hooks using an old version of the script would fail. + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Hook where + +import Common.Annex +import qualified Git.Hook as Git +import Utility.Shell +import Config + +preCommitHook :: Git.Hook +preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") + +mkHookScript :: String -> String +mkHookScript s = unlines + [ shebang_local + , "# automatically configured by git-annex" + , s + ] + +hookWrite :: Git.Hook -> Annex () +hookWrite h = + -- cannot have git hooks in a crippled filesystem (no execute bit) + unlessM crippledFileSystem $ + unlessM (inRepo $ Git.hookWrite h) $ + hookWarning h "already exists, not configuring" + +hookUnWrite :: Git.Hook -> Annex () +hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $ + hookWarning h "contents modified; not deleting. Edit it to remove call to git annex." + +hookWarning :: Git.Hook -> String -> Annex () +hookWarning h msg = do + r <- gitRepo + warning $ Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg diff --git a/Annex/Version.hs b/Annex/Version.hs index 05b3f0227..2b4a49fd2 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -19,18 +19,21 @@ defaultVersion :: Version defaultVersion = "3" directModeVersion :: Version -directModeVersion = "4" +directModeVersion = "5" supportedVersions :: [Version] supportedVersions = [defaultVersion, directModeVersion] upgradableVersions :: [Version] #ifndef mingw32_HOST_OS -upgradableVersions = ["0", "1", "2"] +upgradableVersions = ["0", "1", "2", "4"] #else -upgradableVersions = ["2"] +upgradableVersions = ["2", "4"] #endif +autoUpgradeableVersions :: [Version] +autoUpgradeableVersions = ["4"] + versionField :: ConfigKey versionField = annexConfig "version" @@ -42,12 +45,3 @@ setVersion = setConfig versionField removeVersion :: Annex () removeVersion = unsetConfig versionField - -checkVersion :: Version -> Annex () -checkVersion v - | v `elem` supportedVersions = noop - | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade" - | otherwise = err "Upgrade git-annex." - where - err msg = error $ "Repository version " ++ v ++ - " is not supported. " ++ msg |