Automatically fix up bad bare repositories created by versions 5.20131118 through 5.20131127.

1 files changed, 64 insertions, 1 deletions

diff --git a/Init.hs b/Init.hs
index 76f8d236e..759eae763 100644
--- a/Init.hs
+++ b/Init.hs
@@ -21,6 +21,8 @@ import qualified Annex
 import qualified Git
 import qualified Git.LsFiles
 import qualified Git.Config
+import qualified Git.Construct
+import qualified Git.Types as Git
 import qualified Annex.Branch
 import Logs.UUID
 import Annex.Version
@@ -36,7 +38,12 @@ import Utility.UserInfo
 import Utility.FileMode
 #endif
 import Annex.Hook
+import Git.Hook (hookFile)
 import Upgrade
+import Annex.Content
+import Logs.Location
+
+import System.Log.Logger
 
 genDescription :: Maybe String -> Annex String
 genDescription (Just d) = return d
@@ -92,7 +99,9 @@ uninitialize = do
  - Checks repository version and handles upgrades too.
  -}
 ensureInitialized :: Annex ()
-ensureInitialized = getVersion >>= maybe needsinit checkUpgrade
+ensureInitialized = do
+	getVersion >>= maybe needsinit checkUpgrade
+	fixBadBare
   where
 	needsinit = ifM Annex.Branch.hasSibling
 			( initialize Nothing
@@ -176,3 +185,57 @@ enableDirectMode = unlessM isDirect $ do
 	forM_ l $ \f ->
 		maybe noop (`toDirect` f) =<< isAnnexLink f
 	void $ liftIO clean
+
+{- Work around for git-annex version 5.20131118 - 5.20131127, which
+ - had a bug that unset core.bare when initializing a bare repository.
+ - 
+ - This resulted in objects sent to the repository being stored in 
+ - repo/.git/annex/objects, so move them to repo/annex/objects.
+ -
+ - This check slows down every git-annex run somewhat (by one file stat),
+ - so should be removed after a suitable period of time has passed.
+ - Since the bare repository may be on an offline USB drive, best to
+ - keep it for a while. However, git-annex was only buggy for a few
+ - weeks, so not too long.
+ -}
+fixBadBare :: Annex ()
+fixBadBare = whenM checkBadBare $ do
+	ks <- getKeysPresent
+	liftIO $ debugM "Init" $ unwords
+		[ "Detected bad bare repository with"
+		, show (length ks)
+		, "objects; fixing"
+		]
+	g <- Annex.gitRepo
+	gc <- Annex.getGitConfig
+	d <- Git.repoPath <$> Annex.gitRepo
+	void $ liftIO $ boolSystem "git"
+		[ Param $ "--git-dir=" ++ d
+		, Param "config"
+		, Param Git.Config.coreBare
+		, Param $ Git.Config.boolConfig True
+		]
+	g' <- liftIO $ Git.Construct.fromPath d
+	s' <- liftIO $ Annex.new $ g' { Git.location = Git.Local { Git.gitdir = d, Git.worktree = Nothing } }
+	Annex.changeState $ \s -> s
+		{ Annex.repo = Annex.repo s'
+		, Annex.gitconfig = Annex.gitconfig s'
+		}
+	forM_ ks $ \k -> do
+		oldloc <- liftIO $ gitAnnexLocation k g gc
+		thawContentDir oldloc
+		moveAnnex k oldloc
+		logStatus k InfoPresent
+	let dotgit = d </> ".git"
+	liftIO $ removeDirectoryRecursive dotgit
+		`catchIO` (const $ renameDirectory dotgit (d </> "removeme"))
+
+{- A repostory with the problem won't know it's a bare repository, but will
+ - have no pre-commit hook (which is not set up in a bare repository),
+ - and will not have a HEAD file in its .git directory. -}
+checkBadBare :: Annex Bool
+checkBadBare = allM (not <$>)
+	[isBare, hasPreCommitHook, hasDotGitHEAD]
+  where
+	hasPreCommitHook = inRepo $ doesFileExist . hookFile preCommitHook
+	hasDotGitHEAD = inRepo $ \r -> doesFileExist $ Git.localGitDir r </> "HEAD"