summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
Diffstat (limited to 'Annex')
-rw-r--r--Annex/CatFile.hs8
-rw-r--r--Annex/Direct.hs68
-rw-r--r--Annex/Hook.hs42
-rw-r--r--Annex/Version.hs18
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