v5 for direct mode, with automatic upgrade

This includes storing the current state of the HEAD ref, which git annex
sync is going to need, but does not make sync use it.

2 files changed, 36 insertions, 12 deletions

diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index ea2b577b9..7b0dbc1e0 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -8,13 +8,17 @@
 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 Git.Sha
 import Git.FilePath
 import Git.Types
+import Config
 import Annex.CatFile
 import qualified Annex.Queue
 import Logs.Location
@@ -231,3 +235,29 @@ changedDirect oldk f = do
 	locs <- removeAssociatedFile oldk f
 	whenM (pure (null locs) <&&> not <$> inAnnex oldk) $
 		logStatus oldk InfoMissing
+
+{- Since direct mode repositories use core.bare=true, pushes are allowed
+ - that overwrite the master branch (or whatever branch is currently
+ - checked out) at any time. But committing when a change has been pushed
+ - to the current branch and not merged into the work tree will have the
+ - effect of reverting the pushed changes.
+ -
+ - To avoid this problem, when git annex commits in a direct mode
+ - repository, it does not commit to HEAD, but instead to annexhead.
+ - This ref always contains the last local commit.
+ -}
+annexheadRef :: Ref
+annexheadRef = Ref $ "refs" </> "annexhead"
+
+{- Enable/disable direct mode. -}
+setDirect :: Bool -> Annex ()
+setDirect wantdirect = do
+	when wantdirect $ do
+		f <- fromRepo $ Git.Ref.file annexheadRef
+		v <- inRepo $ Git.Ref.sha Git.Ref.headRef
+		liftIO $ maybe (nukeFile f) (writeFile f . show) v
+	setConfig (annexConfig "direct") val
+	setConfig (ConfigKey Git.Config.coreBare) val
+	Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect }
+  where
+	val = Git.Config.boolConfig wantdirect
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