prevent initialization with bad freeze/thaw hook configured

When annex.freezecontent-command or annex.thawcontent-command is configured
but fails, prevent initialization.

This allows the user to fix their configuration and avoid crippled
filesystem detection entering an adjusted unlocked branch unexpectedly,
when they had been relying on the hooks working around their filesystems's
infelicities.

In the case of git-remote-annex, a failure of these hooks is taken to mean
the filesystem may be crippled, so it deletes the bundles objects and
avoids initialization. That might mean extra work, but only in this edge
case where the hook is misconfigured. And it keeps the command working
for cloning even despite the misconfiguration.

Sponsored-by: the NIH-funded NICEMAN (ReproNim TR&D3) project

Annex/Hook.hs

@@ -106,44 +106,55 @@ doesAnnexHookExist hook = do
 
 runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex ()
 runAnnexHook hook commandcfg = runAnnexHook' hook commandcfg >>= \case
-	Nothing -> noop
+	HookSuccess -> noop
-	Just failedcommanddesc -> 
+	HookFailed failedcommanddesc -> 
 		warning $ UnquotedString $ failedcommanddesc ++ " failed"
 
--- Returns Nothing if the hook or GitConfig command succeeded, or a
+data HookResult
--- description of what failed.
+	= HookSuccess
-runAnnexHook' :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String)
+	| HookFailed String
+	-- ^ A description of the hook command that failed.
+	deriving (Eq, Show)
+
+runAnnexHook' :: Git.Hook -> (GitConfig -> Maybe String) -> Annex HookResult
 runAnnexHook' hook commandcfg = ifM (doesAnnexHookExist hook)
 	( runhook
 	, runcommandcfg
 	)
   where
 	runhook = ifM (inRepo $ Git.runHook boolSystem hook [])
-		( return Nothing
+		( return HookSuccess
 		, do
 			h <- fromRepo (Git.hookFile hook)
-			commandfailed (fromOsPath h)
+			return $ HookFailed $ fromOsPath h
 		)
 	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
-		Nothing -> return Nothing
+		Nothing -> return HookSuccess
 		Just command ->
 			ifM (liftIO $ boolSystem "sh" [Param "-c", Param command])
-				( return Nothing
+				( return HookSuccess
-				, commandfailed $ "git configured command '" ++  command ++ "'"
+				, return $ HookFailed $ "git configured command '" ++  command ++ "'"
 				)
-	commandfailed c = return $ Just c
 
-runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> OsPath -> Annex Bool
+runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> OsPath -> Annex HookResult
 runAnnexPathHook pathtoken hook commandcfg p = ifM (doesAnnexHookExist hook)
 	( runhook
 	, runcommandcfg
 	)
   where
-	runhook = inRepo $ Git.runHook boolSystem hook [ File p' ]
+	runhook = ifM (inRepo $ Git.runHook boolSystem hook [ File p' ])
+		( return HookSuccess
+		, do
+			h <- fromRepo (Git.hookFile hook)
+			return $ HookFailed $ fromOsPath h
+		)
 	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
-		Nothing -> return True
+		Nothing -> return HookSuccess
-		Just basecmd -> liftIO $
+		Just basecmd -> 
-			boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
+			ifM (liftIO $ boolSystem "sh" [Param "-c", Param (gencmd basecmd)])
+				( return HookSuccess
+				, return $ HookFailed $ "git configured command '" ++ basecmd ++ "'"
+				)
 	gencmd = massReplace [ (pathtoken, shellEscape p') ]
 	p' = fromOsPath p
 

Annex/Init.hs

@@ -19,6 +19,7 @@ module Annex.Init (
 	uninitialize,
 	probeCrippledFileSystem,
 	probeCrippledFileSystem',
+	isCrippledFileSystem,
 ) where
 
 import Annex.Common
@@ -75,10 +76,10 @@ data InitializeAllowed = InitializeAllowed
 checkInitializeAllowed :: (InitializeAllowed -> Annex a) -> Annex a
 checkInitializeAllowed a = guardSafeToUseRepo $ noAnnexFileContent' >>= \case
 	Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case
-		Nothing -> do
+		HookSuccess -> do
 			checkSqliteWorks
 			a InitializeAllowed
-		Just failedcommanddesc -> do
+		HookFailed failedcommanddesc -> do
 			initpreventedby failedcommanddesc
 			notinitialized
 	Just noannexmsg -> do
@@ -94,8 +95,8 @@ checkInitializeAllowed a = guardSafeToUseRepo $ noAnnexFileContent' >>= \case
 initializeAllowed :: Annex Bool
 initializeAllowed = noAnnexFileContent' >>= \case
 	Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case
-		Nothing -> return True
+		HookSuccess -> return True
-		Just _ -> return False
+		HookFailed _ -> return False
 	Just _ -> return False
 
 noAnnexFileContent' :: Annex (Maybe String)
@@ -288,73 +289,116 @@ isInitialized :: Annex Bool
 isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion
 
 {- A crippled filesystem is one that does not allow making symlinks,
- - or removing write access from files. -}
+ - or removing write access from files.
-probeCrippledFileSystem :: Annex Bool
+ -
-probeCrippledFileSystem = withEventuallyCleanedOtherTmp $ \tmp -> do
+ - This displays messages about problems detected with the filesystem.
-	(r, warnings) <- probeCrippledFileSystem' tmp
+ -
+ - If a freeze or thaw hook is configured, but exits nonzero,
+ - this returns Nothing after displaying a message to the user about the
+ - problem. Such a hook can in some cases make a filesystem
+ - that would otherwise be detected as crippled work ok, so this avoids
+ - a false positive.
+ -}
+probeCrippledFileSystem :: Annex (Maybe Bool)
+probeCrippledFileSystem = do
+	(r, warnings) <- isCrippledFileSystem'
+	mapM_ (warning . UnquotedString) warnings
+	return r
+
+isCrippledFileSystem :: Annex Bool
+isCrippledFileSystem = do
+	(r, _warnings) <- isCrippledFileSystem'
+	return (fromMaybe True r)
+
+isCrippledFileSystem' :: Annex (Maybe Bool, [String])
+isCrippledFileSystem' = withEventuallyCleanedOtherTmp $ \tmp ->
+	probeCrippledFileSystem' tmp
 		(Just (freezeContent' UnShared))
 		(Just (thawContent' UnShared))
 		=<< hasFreezeHook
-	mapM_ (warning . UnquotedString) warnings
-	return r
 
 probeCrippledFileSystem'
 	:: (MonadIO m, MonadCatch m)
 	=> OsPath
-	-> Maybe (OsPath -> m ())
+	-> Maybe (OsPath -> m HookResult)
-	-> Maybe (OsPath -> m ())
+	-> Maybe (OsPath -> m HookResult)
 	-> Bool
-	-> m (Bool, [String])
+	-> m (Maybe Bool, [String])
 #ifdef mingw32_HOST_OS
-probeCrippledFileSystem' _ _ _ _ = return (True, [])
+probeCrippledFileSystem' _ _ _ _ = return (Just True, [])
 #else
 probeCrippledFileSystem' tmp freezecontent thawcontent hasfreezehook = do
 	let f = tmp </> literalOsPath "gaprobe"
 	liftIO $ F.writeFile' f ""
-	r <- probe f
+	r <- freezethaw f probe
-	void $ tryNonAsync $ (fromMaybe (liftIO . allowWrite) thawcontent) f
 	liftIO $ removeFile f
 	return r
   where
-	probe f = catchDefaultIO (True, []) $ do
+	fallbackfreezecontent f = do
+		liftIO $ preventWrite f
+		return HookSuccess
+	
+	fallbackthawcontent f = do
+		liftIO $ allowWrite f
+		return HookSuccess
+	
+	freezethaw f cont =
+		(fromMaybe fallbackfreezecontent freezecontent) f >>= \case
+			HookFailed failedcommanddesc ->
+				return (Nothing, [hookfailed failedcommanddesc])
+			HookSuccess -> do
+				r <- cont f
+				tryNonAsync ((fromMaybe fallbackthawcontent thawcontent) f)
+					>>= return . \case
+						Right (HookFailed failedcommanddesc) ->
+							let (_, warnings) = r
+							in (Nothing, hookfailed failedcommanddesc : warnings)
+						_ -> r
+
+	hookfailed failedcommanddesc = "Failed to run " ++ failedcommanddesc 
+		++ ". Unable to initialize until this is fixed."
+
+	probe f = catchDefaultIO (Just True, []) $ do
 		let f2 = f <> literalOsPath "2"
 		liftIO $ removeWhenExistsWith removeFile f2
 		liftIO $ R.createSymbolicLink (fromOsPath f) (fromOsPath f2)
 		liftIO $ removeWhenExistsWith removeFile f2
-		(fromMaybe (liftIO . preventWrite) freezecontent) f
 		-- Should be unable to write to the file (unless
 		-- running as root). But some crippled
 		-- filesystems ignore write bit removals or ignore
 		-- permissions entirely.
 		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared f Nothing hasfreezehook))
-			( return (True, ["Filesystem does not allow removing write bit from files."])
+			( return (Just True, ["Filesystem does not allow removing write bit from files."])
 			, liftIO $ ifM ((== 0) <$> getRealUserID)
-				( return (False, [])
+				( return (Just False, [])
 				, do
 					r <- catchBoolIO $ do
 						F.writeFile' f "2"
 						return True
 					if r
-						then return (True, ["Filesystem allows writing to files whose write bit is not set."])
+						then return (Just True, ["Filesystem allows writing to files whose write bit is not set."])
-						else return (False, [])
+						else return (Just False, [])
 				)
 			)
 #endif
 
 checkCrippledFileSystem :: Annex ()
-checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
+checkCrippledFileSystem = probeCrippledFileSystem >>= \case
-	warning "Detected a crippled filesystem."
+	Just True -> do
-	setCrippledFileSystem True
+		warning "Detected a crippled filesystem."
+		setCrippledFileSystem True
 
-	{- Normally git disables core.symlinks itself when the:w
+		{- Normally git disables core.symlinks itself when the
-	 -
+		 -
-	 - filesystem does not support them. But, even if symlinks are
+		 - filesystem does not support them. But, even if symlinks are
-	 - supported, we don't use them by default in a crippled
+		 - supported, we don't use them by default in a crippled
-	 - filesystem. -}
+		 - filesystem. -}
-	whenM (coreSymlinks <$> Annex.getGitConfig) $ do
+		whenM (coreSymlinks <$> Annex.getGitConfig) $ do
-		warning "Disabling core.symlinks."
+			warning "Disabling core.symlinks."
-		setConfig "core.symlinks"
+			setConfig "core.symlinks"
-			(Git.Config.boolConfig False)
+				(Git.Config.boolConfig False)
+	Just False -> noop
+	Nothing -> giveup "Not initialized."
 
 probeLockSupport :: Annex Bool
 #ifdef mingw32_HOST_OS

Annex/Perms.hs

@@ -161,13 +161,12 @@ createWorkTreeDirectory dir = do
  - that happens with write permissions.
  -}
 freezeContent :: OsPath -> Annex ()
-freezeContent file =
+freezeContent file = withShared $ \sr -> void $ freezeContent' sr file
-	withShared $ \sr -> freezeContent' sr file
 
-freezeContent' :: SharedRepository -> OsPath -> Annex ()
+freezeContent' :: SharedRepository -> OsPath -> Annex HookResult
 freezeContent' sr file = freezeContent'' sr file =<< getVersion
 
-freezeContent'' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Annex ()
+freezeContent'' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Annex HookResult
 freezeContent'' sr file rv = do
 	fastDebug "Annex.Perms" ("freezing content " ++ fromOsPath file)
 	unlessM crippledFileSystem $ go sr
@@ -255,9 +254,9 @@ checkContentWritePerm' sr file rv hasfreezehook
 {- Allows writing to an annexed file that freezeContent was called on
  - before. -}
 thawContent :: OsPath -> Annex ()
-thawContent file = withShared $ \sr -> thawContent' sr file
+thawContent file = withShared $ \sr -> void $ thawContent' sr file
 
-thawContent' :: SharedRepository -> OsPath -> Annex ()
+thawContent' :: SharedRepository -> OsPath -> Annex HookResult
 thawContent' sr file = do
 	fastDebug "Annex.Perms" ("thawing content " ++ fromOsPath file)
 	thawPerms (go sr) (thawHook file)
@@ -272,10 +271,10 @@ thawContent' sr file = do
  - fail on a crippled filesystem. But, if file modes are supported on a
  - crippled filesystem, the file may be frozen, so try to thaw its
  - permissions. -}
-thawPerms :: Annex () -> Annex () -> Annex ()
+thawPerms :: Annex () -> Annex HookResult -> Annex HookResult
 thawPerms a hook = ifM crippledFileSystem
-	( hook >> void (tryNonAsync a)
+	( void (tryNonAsync a) `after` hook
-	, hook >> a
+	, a `after` hook
 	)
 
 {- Blocks writing to the directory an annexed file is in, to prevent the
@@ -287,7 +286,7 @@ freezeContentDir :: OsPath -> Annex ()
 freezeContentDir file = do
 	fastDebug "Annex.Perms" ("freezing content directory " ++ fromOsPath dir)
 	unlessM crippledFileSystem $ withShared go
-	freezeHook dir
+	void $ freezeHook dir
   where
 	dir = parentDir file
 	go UnShared = liftIO $ preventWrite dir
@@ -303,7 +302,7 @@ freezeContentDir file = do
 thawContentDir :: OsPath -> Annex ()
 thawContentDir file = do
 	fastDebug "Annex.Perms" ("thawing content directory " ++ fromOsPath dir)
-	thawPerms (withShared (liftIO . go)) (thawHook dir)
+	void $ thawPerms (withShared (liftIO . go)) (thawHook dir)
   where
 	dir = parentDir file
 	go UnShared = allowWrite dir
@@ -318,7 +317,7 @@ createContentDir dest = do
 	unlessM (liftIO $ doesDirectoryExist dir) $
 		createAnnexDirectory dir 
 	-- might have already existed with restricted perms
-	thawHook dir
+	void $ thawHook dir
 	unlessM crippledFileSystem $ liftIO $ allowWrite dir
   where
 	dir = parentDir dest
@@ -354,12 +353,12 @@ hasThawHook =
 		<||>
 	(doesAnnexHookExist thawContentAnnexHook)
 
-freezeHook :: OsPath -> Annex ()
+freezeHook :: OsPath -> Annex HookResult
-freezeHook = void . runAnnexPathHook "%path"
+freezeHook = runAnnexPathHook "%path"
 	freezeContentAnnexHook annexFreezeContentCommand
 
-thawHook :: OsPath -> Annex ()
+thawHook :: OsPath -> Annex HookResult
-thawHook = void . runAnnexPathHook "%path"
+thawHook = runAnnexPathHook "%path"
 	thawContentAnnexHook annexThawContentCommand
 
 {- Calculate mode to use for a directory from the mode to use for a file.

CHANGELOG

@@ -2,6 +2,10 @@ git-annex (10.20250521) UNRELEASED; urgency=medium
 
   * assistant: Avoid hanging at startup when a process has a *.lock file
     open in the .git directory.
+  * When annex.freezecontent-command or annex.thawcontent-command is
+    configured but fails, prevent initialization. This allows the user to
+    fix their configuration and avoid crippled filesystem detection
+    entering an adjusted branch.
 
  -- Joey Hess <id@joeyh.name>  Thu, 22 May 2025 12:43:38 -0400
 

CmdLine/GitRemoteAnnex.hs

@@ -1204,7 +1204,7 @@ cleanupInitialization sab alternatejournaldir = void $ tryNonAsync $ do
 			_ -> noop
 		void $ liftIO $ tryIO $ removeDirectory annexobjectdir
 
-	notcrippledfilesystem = not <$> probeCrippledFileSystem
+	notcrippledfilesystem = not <$> isCrippledFileSystem
 
 	nonbuggygitversion = liftIO $
 		flip notElem buggygitversions <$> Git.Version.installed

Test/Framework.hs

@@ -804,9 +804,10 @@ parallelTestRunner' numjobs opts mkts
 
 	go Nothing = summarizeresults $ withConcurrentOutput $ do
 		ensuredir tmpdir
-		crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem'
+		crippledfilesystem <- fromMaybe False . fst 
-			(toOsPath tmpdir)
+			<$> Annex.Init.probeCrippledFileSystem'
-			Nothing Nothing False
+				(toOsPath tmpdir)
+				Nothing Nothing False
 		adjustedbranchok <- Annex.AdjustedBranch.isGitVersionSupported
 		let ts = mkts numparts crippledfilesystem adjustedbranchok opts
 		let warnings = fst (tastyParser ts)

doc/bugs/git-annex_proceeds_forward_if_freeze_script_fails/comment_3_da76c4512c1a65caaf3f51f00bd3e7eb._comment

@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2025-05-27T16:16:38Z"
+ content="""
+I agreee it makes sense to detect freeze/thaw hook fail at init and error
+out rather than switching to an adjusted branch, and rather than start
+using a repisitory that is not configured as desired from the start. 
+I've implemented that now.
+
+I think that change is arguably enough to consider this done. It avoids
+the user initializing a broken repository, or otherwise starting from an
+unexpected state. Fixing problems that happen later is the
+job of `git-annex fsck`.
+"""]]

doc/projects/datalad/bugs-done/add_config_var_preventing_adjusted_branch_mode/comment_6_6337ea6ce754b65f203f3b84551c9722._comment

@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2025-05-27T14:53:52Z"
+ content="""
+Note that this bug is closed, and it would need to be moved out of
+this archive to be reopened.
+
+Anyway, I agree that if the freeze/thaw hook is configured, but fails,
+it would make sense for crippled filesystem probing to tell the user to
+fix their configuration, and abort initialization, rather than
+unnecessarily entering an adjusted branch. I have implemented that now.
+
+As far as situations where the hook is configured at first but later
+is not configured, `git-annex fsck` re-runs the hook to freeze content.
+So that is not dissimilar from other situations where permissions prevent 
+proper freezing, which fsck also fixes.
+"""]]