added hooks corresponding to annex.*-command

* Added freezecontent-annex and thawcontent-annex hooks that
  correspond to the git configs annex.freezecontent and
  annex.thawcontent.
* Added secure-erase-annex hook that corresponds to the git config
  annex.secure-erase-command.
* Added commitmessage-annex hook that corresponds to the git config
  annex.commitmessage-command.
* Added http-headers-annex hook that corresponds to the git config
  annex.http-headers-command.
  that correspond to the post-update-annex and pre-commit-annex hooks.

The use case for these is eg, setting up a git repository that is run in a
container, where the easiest way to provide a script is by putting it in
.git/hooks/, rather than copying it into the container in a way that puts
it in PATH.

This is all the ones that make sense to add for annex.*-config git configs.
annex.youtube-dl-command is not a hook, it's telling git-annex what command
to run. So is annex.shared-sop-command. So omitted those.

May later also want to add hooks corresponding to
`remote.<name>.annex-cost-command` etc.

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

Annex/Branch.hs

@@ -521,12 +521,10 @@ createMessage :: Annex String
 createMessage = fromMaybe "branch created" <$> getCommitMessage
 
 getCommitMessage :: Annex (Maybe String)
-getCommitMessage = do
-	config <- Annex.getGitConfig
-	case annexCommitMessageCommand config of
-		Nothing -> return (annexCommitMessage config)
-		Just cmd -> catchDefaultIO (annexCommitMessage config) $
-			Just <$> liftIO (readProcess "sh" ["-c", cmd])
+getCommitMessage = 
+	outputOfAnnexHook commitMessageAnnexHook annexCommitMessageCommand
+		<|>
+	(annexCommitMessage <$> Annex.getGitConfig)
 
 {- Stages the journal, and commits staged changes to the branch. -}
 commit :: String -> Annex ()

Annex/Content/LowLevel.hs

@@ -10,6 +10,7 @@
 module Annex.Content.LowLevel where
 
 import Annex.Common
+import Annex.Hook
 import Logs.Transfer
 import qualified Annex
 import Utility.DiskFree
@@ -25,11 +26,8 @@ import System.PosixCompat.Files (linkCount)
  - File may or may not be deleted at the end; caller is responsible for
  - making sure it's deleted. -}
 secureErase :: RawFilePath -> Annex ()
-secureErase file = maybe noop go =<< annexSecureEraseCommand <$> Annex.getGitConfig
-  where
-	go basecmd = void $ liftIO $
-		boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
-	gencmd = massReplace [ ("%file", shellEscape (fromRawFilePath file)) ]
+secureErase = void . runAnnexPathHook "%file"
+	secureEraseAnnexHook annexSecureEraseCommand
 
 data LinkedOrCopied = Linked | Copied
 

Annex/Hook.hs

@@ -4,7 +4,7 @@
  - git-annex not change, otherwise removing old hooks using an old
  - version of the script would fail.
  -
- - Copyright 2013-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -48,6 +48,21 @@ preCommitAnnexHook = Git.Hook "pre-commit-annex" "" []
 postUpdateAnnexHook :: Git.Hook
 postUpdateAnnexHook = Git.Hook "post-update-annex" "" []
 
+freezeContentAnnexHook :: Git.Hook
+freezeContentAnnexHook = Git.Hook "freezecontent-annex" "" []
+
+thawContentAnnexHook :: Git.Hook
+thawContentAnnexHook = Git.Hook "thawcontent-annex" "" []
+
+secureEraseAnnexHook :: Git.Hook
+secureEraseAnnexHook = Git.Hook "secure-erase-annex" "" []
+
+commitMessageAnnexHook :: Git.Hook
+commitMessageAnnexHook = Git.Hook "commitmessage-annex" "" []
+
+httpHeadersAnnexHook :: Git.Hook
+httpHeadersAnnexHook = Git.Hook "http-headers-annex" "" []
+
 mkHookScript :: String -> String
 mkHookScript s = unlines
 	[ shebang
@@ -69,23 +84,26 @@ hookWarning h msg = do
 	warning $ UnquotedString $
 		Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg
 
-{- Runs a hook. To avoid checking if the hook exists every time,
- - the existing hooks are cached. -}
-runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex ()
-runAnnexHook hook commandcfg = do
+{- To avoid checking if the hook exists every time, the existing hooks
+ - are cached. -}
+doesAnnexHookExist :: Git.Hook -> Annex Bool
+doesAnnexHookExist hook = do
 	m <- Annex.getState Annex.existinghooks
 	case M.lookup hook m of
-		Just True -> runhook
-		Just False -> runcommandcfg
+		Just exists -> return exists
 		Nothing -> do
 			exists <- inRepo $ Git.hookExists hook
 			Annex.changeState $ \s -> s
 				{ Annex.existinghooks = M.insert hook exists m }
-			if exists
-				then runhook
-				else runcommandcfg
+			return exists
+
+runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex ()
+runAnnexHook hook commandcfg = ifM (doesAnnexHookExist hook)
+	( runhook
+	, runcommandcfg
+	)
   where
-	runhook = unlessM (inRepo $ Git.runHook hook) $ do
+	runhook = unlessM (inRepo $ Git.runHook boolSystem hook []) $ do
 		h <- fromRepo $ Git.hookFile hook
 		commandfailed h
 	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
@@ -94,3 +112,29 @@ runAnnexHook hook commandcfg = do
 				commandfailed command
 		Nothing -> noop
 	commandfailed c = warning $ UnquotedString $ c ++ " failed"
+
+runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> RawFilePath -> Annex Bool
+runAnnexPathHook pathtoken hook commandcfg p = ifM (doesAnnexHookExist hook)
+	( runhook
+	, runcommandcfg
+	)
+  where
+	runhook = inRepo $ Git.runHook boolSystem hook [ File (fromRawFilePath p) ]
+	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
+		Just basecmd -> liftIO $
+			boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
+		Nothing -> return True
+	gencmd = massReplace [ (pathtoken, shellEscape (fromRawFilePath p)) ]
+
+outputOfAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String)
+outputOfAnnexHook hook commandcfg = ifM (doesAnnexHookExist hook)
+	( runhook
+	, runcommandcfg
+	)
+  where
+	runhook = inRepo (Git.runHook runhook' hook [])
+	runhook' c ps = Just <$> readProcess c (toCommand ps)
+	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
+		Just command -> liftIO $ 
+			Just <$> readProcess "sh" ["-c", command]
+		Nothing -> return Nothing

Annex/Perms.hs

@@ -33,6 +33,7 @@ module Annex.Perms (
 ) where
 
 import Annex.Common
+import Annex.Hook
 import Utility.FileMode
 import Git
 import Git.ConfigTypes
@@ -340,24 +341,24 @@ modifyContentDirWhenExists f a = do
 	either throwM return v
 
 hasFreezeHook :: Annex Bool
-hasFreezeHook = isJust . annexFreezeContentCommand <$> Annex.getGitConfig
+hasFreezeHook = 
+	(isJust . annexFreezeContentCommand <$> Annex.getGitConfig)
+		<||>
+	(doesAnnexHookExist freezeContentAnnexHook)
 
 hasThawHook :: Annex Bool
-hasThawHook = isJust . annexThawContentCommand <$> Annex.getGitConfig
+hasThawHook =
+	(isJust . annexThawContentCommand <$> Annex.getGitConfig)
+		<||>
+	(doesAnnexHookExist thawContentAnnexHook)
 
 freezeHook :: RawFilePath -> Annex ()
-freezeHook p = maybe noop go =<< annexFreezeContentCommand <$> Annex.getGitConfig
-  where
-	go basecmd = void $ liftIO $
-		boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
-	gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]
+freezeHook = void . runAnnexPathHook "%path"
+	freezeContentAnnexHook annexFreezeContentCommand
 
 thawHook :: RawFilePath -> Annex ()
-thawHook p = maybe noop go =<< annexThawContentCommand <$> Annex.getGitConfig
-  where
-	go basecmd = void $ liftIO $
-		boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
-	gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]
+thawHook = void . runAnnexPathHook "%path"
+	thawContentAnnexHook annexThawContentCommand
 
 {- Calculate mode to use for a directory from the mode to use for a file.
  -

Annex/Url.hs

@@ -35,6 +35,7 @@ import Annex.Common
 import qualified Annex
 import qualified Utility.Url as U
 import qualified Utility.Url.Parse as U
+import Annex.Hook
 import Utility.Hash (IncrementalVerifier)
 import Utility.IPAddress
 import Network.HTTP.Client.Restricted
@@ -75,9 +76,11 @@ getUrlOptions = Annex.getState Annex.urloptions >>= \case
 			<*> pure (Just (\u -> "Configuration of annex.security.allowed-url-schemes does not allow accessing " ++ show u))
 			<*> pure U.noBasicAuth
 	
-	headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case
-		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
-		Nothing -> annexHttpHeaders <$> Annex.getGitConfig
+	headers =
+		outputOfAnnexHook httpHeadersAnnexHook annexHttpHeadersCommand
+			>>= \case
+				Just output -> pure (lines output)
+				Nothing -> annexHttpHeaders <$> Annex.getGitConfig
 	
 	checkallowedaddr = words . annexAllowedIPAddresses <$> Annex.getGitConfig >>= \case
 		["all"] -> do