make .noannex file prevent repo fixups

Avoid performing repository fixups for submodules and git-worktrees
when there's a .noannex file that will prevent git-annex from being
used in the repository.

This change is ok as long as the .noannex file is really going to prevent
git-annex from being used. But, init --force could override the file.
Which would result in the repo being initialized without the fixups
having run.

To avoid that situation decided to change init, to not let --force be used
to override a .noannex file. Instead the user can just delete the file.

Annex/Fixup.hs

@@ -1,6 +1,6 @@
 {- git-annex repository fixups
  -
- - Copyright 2013-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@ module Annex.Fixup where
 import Git.Types
 import Git.Config
 import Types.GitConfig
+import Config.Files
 import qualified Git.BuildVersion
 import Utility.Path
 import Utility.SafeCommand
@@ -22,6 +23,7 @@ import System.IO
 import System.FilePath
 import System.PosixCompat.Files
 import Data.List
+import Data.Maybe
 import Control.Monad
 import Control.Monad.IfElse
 import qualified Data.Map as M
@@ -80,18 +82,25 @@ fixupDirect r = r
  - When the filesystem doesn't support symlinks, we cannot make .git
  - into a symlink. But we don't need too, since the repo will use direct
  - mode.
+ -
+ - Before making any changes, check if there's a .noannex file
+ - in the repo. If that file will prevent git-annex from being used,
+ - there's no need to fix up the repository.
  -}
 fixupUnusualRepos :: Repo -> GitConfig -> IO Repo
 fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d }) }) c
-	| needsSubmoduleFixup r = do
-		when (coreSymlinks c) $
-			(replacedotgit >> unsetcoreworktree)
-				`catchNonAsync` \_e -> hPutStrLn stderr
-					"warning: unable to convert submodule to form that will work with git-annex"
-		return $ r'
-			{ config = M.delete "core.worktree" (config r)
-			}
-	| otherwise = ifM (needsGitLinkFixup r)
+	| needsSubmoduleFixup r = ifM notnoannex
+		( do
+			when (coreSymlinks c) $
+				(replacedotgit >> unsetcoreworktree)
+					`catchNonAsync` \_e -> hPutStrLn stderr
+						"warning: unable to convert submodule to form that will work with git-annex"
+			return $ r'
+				{ config = M.delete "core.worktree" (config r)
+				}
+		, return r
+		)
+	| otherwise = ifM (needsGitLinkFixup r <&&> notnoannex)
 		( do
 			when (coreSymlinks c) $
 				(replacedotgit >> worktreefixup)
@@ -131,6 +140,8 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d
 	r'
 		| coreSymlinks c = r { location = l { gitdir = dotgit } }
 		| otherwise = r
+
+	notnoannex = isNothing <$> noAnnexFileContent r
 fixupUnusualRepos r _ = return r
 
 needsSubmoduleFixup :: Repo -> Bool

Annex/Init.hs

@@ -8,7 +8,6 @@
 {-# LANGUAGE CPP #-}
 
 module Annex.Init (
-	AutoInit(..),
 	ensureInitialized,
 	isInitialized,
 	initialize,
@@ -36,6 +35,7 @@ import Annex.UUID
 import Annex.Link
 import Annex.WorkTree
 import Config
+import Config.Files
 import Config.Smudge
 import Annex.Direct
 import qualified Annex.AdjustedBranch as AdjustedBranch
@@ -52,22 +52,14 @@ import System.Posix.User
 import qualified Utility.LockFile.Posix as Posix
 #endif
 
-newtype AutoInit = AutoInit Bool
-
-checkCanInitialize :: AutoInit -> Annex a -> Annex a
-checkCanInitialize (AutoInit True) a = a
-checkCanInitialize (AutoInit False) a = fromRepo Git.repoWorkTree >>= \case
+checkCanInitialize :: Annex a -> Annex a
+checkCanInitialize a = inRepo noAnnexFileContent >>= \case
 	Nothing -> a
-	Just wt -> liftIO (catchMaybeIO (readFile (wt </> ".noannex"))) >>= \case
-		Nothing -> a
-		Just noannexmsg -> ifM (Annex.getState Annex.force)
-			( a
-			, do
-				warning "Initialization prevented by .noannex file (use --force to override)"
-				unless (null noannexmsg) $
-					warning noannexmsg
-				giveup "Not initialized."
-			)
+	Just noannexmsg -> do
+		warning "Initialization prevented by .noannex file (remove the file to override)"
+		unless (null noannexmsg) $
+			warning noannexmsg
+		giveup "Not initialized."
 
 genDescription :: Maybe String -> Annex UUIDDesc
 genDescription (Just d) = return $ UUIDDesc $ encodeBS d
@@ -80,8 +72,8 @@ genDescription Nothing = do
 		Right username -> [username, at, hostname, ":", reldir]
 		Left _ -> [hostname, ":", reldir]
 
-initialize :: AutoInit -> Maybe String -> Maybe RepoVersion -> Annex ()
-initialize ai mdescription mversion = checkCanInitialize ai $ do
+initialize :: Maybe String -> Maybe RepoVersion -> Annex ()
+initialize mdescription mversion = checkCanInitialize $ do
 	{- Has to come before any commits are made as the shared
 	 - clone heuristic expects no local objects. -}
 	sharedclone <- checkSharedClone
@@ -91,7 +83,7 @@ initialize ai mdescription mversion = checkCanInitialize ai $ do
 	ensureCommit $ Annex.Branch.create
 
 	prepUUID
-	initialize' (AutoInit True) mversion
+	initialize' mversion
 	
 	initSharedClone sharedclone
 
@@ -100,8 +92,8 @@ initialize ai mdescription mversion = checkCanInitialize ai $ do
 
 -- Everything except for uuid setup, shared clone setup, and initial
 -- description.
-initialize' :: AutoInit -> Maybe RepoVersion -> Annex ()
-initialize' ai mversion = checkCanInitialize ai $ do
+initialize' :: Maybe RepoVersion -> Annex ()
+initialize' mversion = checkCanInitialize  $ do
 	checkLockSupport
 	checkFifoSupport
 	checkCrippledFileSystem
@@ -153,7 +145,7 @@ ensureInitialized :: Annex ()
 ensureInitialized = getVersion >>= maybe needsinit checkUpgrade
   where
 	needsinit = ifM Annex.Branch.hasSibling
-			( initialize (AutoInit True) Nothing Nothing
+			( initialize Nothing Nothing
 			, giveup "First run: git-annex init"
 			)
 

Annex/MakeRepo.hs

@@ -77,7 +77,7 @@ initRepo False _ dir desc mgroup = inDir dir $ do
 
 initRepo' :: Maybe String -> Maybe StandardGroup -> Annex ()
 initRepo' desc mgroup = unlessM isInitialized $ do
-	initialize (AutoInit False) desc Nothing
+	initialize desc Nothing
 	u <- getUUID
 	maybe noop (defaultStandardGroup u) mgroup
 	{- Ensure branch gets committed right away so it is

CHANGELOG

@@ -16,6 +16,11 @@ git-annex (7.20190130) UNRELEASED; urgency=medium
   * fromkey --batch output changed to support using it with --json.
     The old output was not parseable for any useful information, so
     this is not expected to break anything.
+  * Avoid performing repository fixups for submodules and git-worktrees
+    when there's a .noannex file that will prevent git-annex from being
+    used in the repository.
+  * init: Don't let --force be used to override a .noannex file,
+    instead the user can just delete the file.
 
  -- Joey Hess <id@joeyh.name>  Wed, 30 Jan 2019 12:30:22 -0400
 

Command/ConfigList.hs

@@ -45,7 +45,7 @@ findOrGenUUID = do
 		else ifM (Annex.Branch.hasSibling <||> (isJust <$> Fields.getField Fields.autoInit))
 			( do
 				liftIO checkNotReadOnly
-				initialize (AutoInit True) Nothing Nothing
+				initialize Nothing Nothing
 				getUUID
 			, return NoUUID
 			)

Command/Init.hs

@@ -52,7 +52,7 @@ start os = do
 
 perform :: InitOptions -> CommandPerform
 perform os = do
-	initialize (AutoInit False)
+	initialize
 		(if null (initDesc os) then Nothing else Just (initDesc os))
 		(initVersion os)
 	Annex.SpecialRemote.autoEnable

Command/Reinit.hs

@@ -36,6 +36,6 @@ perform s = do
 		then return $ toUUID s
 		else Remote.nameToUUID s
 	storeUUID u
-	initialize' (AutoInit False) Nothing
+	initialize' Nothing
 	Annex.SpecialRemote.autoEnable
 	next $ return True

Command/Upgrade.hs

@@ -25,6 +25,6 @@ start :: CommandStart
 start = do
 	showStart' "upgrade" Nothing
 	whenM (isNothing <$> getVersion) $ do
-		initialize (AutoInit False) Nothing Nothing
+		initialize Nothing Nothing
 	r <- upgrade False latestVersion
 	next $ next $ return r

Config/Files.hs

@@ -1,6 +1,6 @@
 {- git-annex extra config files
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,6 +13,8 @@ import Common
 import Utility.Tmp
 import Utility.FreeDesktop
 
+import Git
+
 {- ~/.config/git-annex/file -}
 userConfigFile :: FilePath -> IO FilePath
 userConfigFile file = do
@@ -81,3 +83,10 @@ cannotFindProgram :: IO a
 cannotFindProgram = do
 	f <- programFile
 	giveup $ "cannot find git-annex program in PATH or in the location listed in " ++ f
+
+{- A .noannex file in a git repository prevents git-annex from
+ - initializing that repository.. The content of the file is returned. -}
+noAnnexFileContent :: Repo -> IO (Maybe String)
+noAnnexFileContent r = case Git.repoWorkTree r of
+	Nothing -> return Nothing
+	Just wt -> catchMaybeIO (readFile (wt </> ".noannex"))

Test/Framework.hs

@@ -124,7 +124,7 @@ intmpclonerepoInDirect a = intmpclonerepo $
 		)
   where
 	isdirect = annexeval $ do
-		Annex.Init.initialize (Annex.Init.AutoInit False) Nothing Nothing
+		Annex.Init.initialize Nothing Nothing
 		Config.isDirect
 
 checkRepo :: Types.Annex a -> FilePath -> IO a

doc/todo/Avoid_repo_fixup_if___34__.noannex__34___is_present.mdwn

@@ -39,3 +39,5 @@ Here's a demo of the issue:
     operating system: linux x86_64
     supported repository versions: 5 7
     upgrade supported from repository versions: 0 1 2 3 4 5 6
+
+> [[fixed|done]] --[[Joey]]