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.

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

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

Assistant/WebApp/Configurators/Local.hs

@@ -30,6 +30,7 @@ import Utility.DataUnits
 import Utility.Network
 import Remote (prettyUUID)
 import Annex.UUID
+import Annex.Direct
 import Types.StandardGroups
 import Logs.PreferredContent
 import Logs.UUID

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
+	r <- upgrade False
-	setVersion defaultVersion
+	ifM isDirect
+		( setVersion directModeVersion
+		, setVersion defaultVersion
+		)
 	next $ next $ return r

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
 

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

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

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
+checkUpgrade :: Version -> Annex ()
-upgrade = go =<< getVersion
+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

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
+	)

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

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`
+* `update-hook refname olvrev newrev`
-  automatically creates a pre-commit hook using this.
+
+  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`
 

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.

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
+v4 was only used for [[direct_mode]], to ensure that a version of git-annex
-existing v3 repositories, they will continue to work.
+that understands direct mode was used with a direct mode repository. 
 
 ### v2 -> v3 (git-annex version 3.x)