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.

12 files changed, 137 insertions, 32 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
diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs
index 88ca8622d..66ea0e0eb 100644
--- a/Command/Upgrade.hs
+++ b/Command/Upgrade.hs
@@ -11,6 +11,7 @@ import Common.Annex
 import Command
 import Upgrade
 import Annex.Version
+import Config
 
 def :: [Command]
 def = [dontCheck repoExists $ -- because an old version may not seem to exist
@@ -23,6 +24,9 @@ seek = [withNothing start]
 start :: CommandStart
 start = do
 	showStart "upgrade" "."
-	r <- upgrade
-	setVersion defaultVersion
+	r <- upgrade False
+	ifM isDirect
+		( setVersion directModeVersion
+		, setVersion defaultVersion
+		)
 	next $ next $ return r
diff --git a/Config.hs b/Config.hs
index 475cb83ec..0c6b64f50 100644
--- a/Config.hs
+++ b/Config.hs
@@ -71,14 +71,6 @@ getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig
 isDirect :: Annex Bool
 isDirect = annexDirect <$> Annex.getGitConfig
 
-setDirect :: Bool -> Annex ()
-setDirect b = do
-	setConfig (annexConfig "direct") val
-	setConfig (ConfigKey Git.Config.coreBare) val
-	Annex.changeGitConfig $ \c -> c { annexDirect = b }
-  where
-	val = Git.Config.boolConfig b
-
 crippledFileSystem :: Annex Bool
 crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig
 
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 954b61a2e..9706f8b6c 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -40,6 +40,11 @@ exists :: Ref -> Repo -> IO Bool
 exists ref = runBool
 	[Param "show-ref", Param "--verify", Param "-q", Param $ show ref]
 
+{- The file used to record a ref. (Git also stores some refs in a
+ - packed-refs file.) -}
+file :: Ref -> Repo -> FilePath
+file ref repo = localGitDir repo </> show ref
+
 {- Checks if HEAD exists. It generally will, except for in a repository
  - that was just created. -}
 headExists :: Repo -> IO Bool
diff --git a/Init.hs b/Init.hs
index 80e101d37..991f7d31c 100644
--- a/Init.hs
+++ b/Init.hs
@@ -35,6 +35,7 @@ import Utility.UserInfo
 import Utility.FileMode
 #endif
 import Annex.Hook
+import Upgrade
 
 genDescription :: Maybe String -> Annex String
 genDescription (Just d) = return d
@@ -74,9 +75,12 @@ uninitialize = do
 {- Will automatically initialize if there is already a git-annex
  - branch from somewhere. Otherwise, require a manual init
  - to avoid git-annex accidentially being run in git
- - repos that did not intend to use it. -}
+ - repos that did not intend to use it.
+ -
+ - Checks repository version and handles upgrades too.
+ -}
 ensureInitialized :: Annex ()
-ensureInitialized = getVersion >>= maybe needsinit checkVersion
+ensureInitialized = getVersion >>= maybe needsinit checkUpgrade
   where
 	needsinit = ifM Annex.Branch.hasSibling
 			( initialize Nothing
diff --git a/Upgrade.hs b/Upgrade.hs
index f0166bf8e..59cca3fe4 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -16,9 +16,21 @@ import qualified Upgrade.V0
 import qualified Upgrade.V1
 #endif
 import qualified Upgrade.V2
+import qualified Upgrade.V4
 
-upgrade :: Annex Bool
-upgrade = go =<< getVersion
+checkUpgrade :: Version -> Annex ()
+checkUpgrade v
+	| v `elem` supportedVersions = noop
+	| v `elem` autoUpgradeableVersions = unlessM (upgrade True) $
+		err "Automatic upgrade failed!"
+	| 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
+
+upgrade :: Bool -> Annex Bool
+upgrade automatic = go =<< getVersion
   where
 #ifndef mingw32_HOST_OS
 	go (Just "0") = Upgrade.V0.upgrade
@@ -28,4 +40,5 @@ upgrade = go =<< getVersion
 	go (Just "1") = error "upgrade from v1 on Windows not supported"
 #endif
 	go (Just "2") = Upgrade.V2.upgrade
+	go (Just "4") = Upgrade.V4.upgrade automatic
 	go _ = return True
diff --git a/Upgrade/V4.hs b/Upgrade/V4.hs
new file mode 100644
index 000000000..147ace559
--- /dev/null
+++ b/Upgrade/V4.hs
@@ -0,0 +1,23 @@
+{- git-annex v4 -> v5 uppgrade support
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Upgrade.V4 where
+
+import Common.Annex
+import Config
+import Annex.Direct
+
+{- Direct mode only upgrade. -}
+upgrade :: Bool -> Annex Bool
+upgrade automatic = ifM isDirect
+	( do
+		unless automatic $
+			showAction "v4 to v5"
+		setDirect True
+		return True
+	, return False
+	)
diff --git a/debian/changelog b/debian/changelog
index 3237e2bbf..63ecf4e6c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,11 @@
-git-annex (4.20131102) UNRELEASED; urgency=low
+git-annex (5.20131102) UNRELEASED; urgency=low
 
   * Direct mode repositories now have core.bare=true set, to prevent
     accidentally running git commands that try to operate on the work tree,
-    and so do the wrong thing.
+    and so do the wrong thing in direct mode.
+  * annex.version is now set to 5 for direct mode repositories.
+    This upgrade is handled fully automatically, no need to run
+    git annex upgrade
   * The -c option now not only modifies the git configuration seen by
     git-annex, but it is passed along to every git command git-annex runs.
   * Improve local pairing behavior when two computers both try to start
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index d88957f9c..fd22fc672 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -698,12 +698,21 @@ subdirectories).
 
 * `pre-commit [path ...]`
 
+  This is meant to be called from git's pre-commit hook. `git annex init`
+  automatically creates a pre-commit hook using this.
+
   Fixes up symlinks that are staged as part of a commit, to ensure they
   point to annexed content. Also handles injecting changes to unlocked
   files into the annex.
 
-  This is meant to be called from git's pre-commit hook. `git annex init`
-  automatically creates a pre-commit hook using this.
+* `update-hook refname olvrev newrev`
+
+  This is meant to be called from git's update hook. `git annex init`
+  automatically creates an update hook using this.
+
+  This denies updates being pushed for the currently checked out branch.
+  While receive.denyCurrentBranch normally prevents that, it does
+  not for fake bare repositories, as used by direct mode.
 
 * `fromkey key file`
 
diff --git a/doc/todo/direct_mode_guard.mdwn b/doc/todo/direct_mode_guard.mdwn
index 6aab353fa..9fbb21cd3 100644
--- a/doc/todo/direct_mode_guard.mdwn
+++ b/doc/todo/direct_mode_guard.mdwn
@@ -77,6 +77,26 @@ This seems really promising. But of course, git-annex has its own set of
 behaviors in a bare repo, so will need to recognise that this repo is not
 really bare, and avoid them.
 
+> [[done]]!!  --[[Joey]]
+
 (Git may also have some bare repo behaviors that are unwanted. One example
 is that git allows pushes to the current branch in a bare repo, 
 even when `receive.denyCurrentBranch` is set.)
+
+> This is indeed a problem. Indeed, `git annex sync` successfully
+> pushes changes to the master branch of a fake bare direct mode repo.
+> 
+> And then, syncing in the repo that was pushed to causes the changes
+> that were pushed to the master branch to get reverted! This happens
+> because sync commits; commit sees that files are staged in index
+> differing from the (pushed) master, and commits the "changes"
+> which revert it.
+> 
+> Could fix this using an update hook, to reject the updated of the master
+> branch. However, won't work on crippled filesystems! (No +x bit)
+> 
+> Could make git annex sync detect this. It could reset the master
+> branch to the last one committed, before committing. Will work,
+> does have the minor oddity that eg `git log` will show commits
+> pushed to master before `git annex sync` has been run and so before
+> those commits are reflected in the tree.
diff --git a/doc/upgrades.mdwn b/doc/upgrades.mdwn
index 6cf54477c..5cf4093dc 100644
--- a/doc/upgrades.mdwn
+++ b/doc/upgrades.mdwn
@@ -18,10 +18,18 @@ conflicts first before upgrading git-annex.
 
 ## Upgrade events, so far
 
+### v4 -> v5 (git-annex version 5.x)
+
+v5 is only used for [[direct_mode]]. The upgrade from v4 to v5 is handled
+automatically.
+
+This upgrade involves changing direct mode repositories to operate with
+core.bare=true.
+
 ### v3 -> v4 (git-annex version 4.x)
 
-v4 is only used for [[direct_mode]], and no upgrade needs to be done from
-existing v3 repositories, they will continue to work.
+v4 was only used for [[direct_mode]], to ensure that a version of git-annex
+that understands direct mode was used with a direct mode repository. 
 
 ### v2 -> v3 (git-annex version 3.x)