git-annex-shell: Runs hooks/annex-content after content is received or dropped.

Command/Commit.hs

@@ -7,8 +7,10 @@
 
 module Command.Commit where
 
+import Common.Annex
 import Command
 import qualified Annex.Branch
+import qualified Git
 
 def :: [Command]
 def = [command "commit" paramNothing seek
@@ -20,4 +22,7 @@ seek = [withNothing start]
 start :: CommandStart
 start = next $ next $ do
 	Annex.Branch.commit "update"
-	return True
+	runhook =<< (inRepo $ Git.hookPath "annex-content")
+	where
+		runhook (Just hook) = liftIO $ boolSystem hook []
+		runhook Nothing = return True

Git.hs

@@ -24,12 +24,14 @@ module Git (
 	gitDir,
 	configTrue,
 	attributes,
+	hookPath,
 	assertLocal,
 ) where
 
 import qualified Data.Map as M
 import Data.Char
 import Network.URI (uriPath, uriScheme, unEscapeString)
+import System.Directory
 
 import Common
 import Git.Types
@@ -93,17 +95,25 @@ configBare repo = maybe unknown (fromMaybe False . configTrue) $
 			" is a bare repository; config not read"
 
 {- Path to a repository's gitattributes file. -}
-attributes :: Repo -> String
+attributes :: Repo -> FilePath
 attributes repo
 	| configBare repo = workTree repo ++ "/info/.gitattributes"
 	| otherwise = workTree repo ++ "/.gitattributes"
 
 {- Path to a repository's .git directory. -}
-gitDir :: Repo -> String
+gitDir :: Repo -> FilePath
 gitDir repo
 	| configBare repo = workTree repo
 	| otherwise = workTree repo </> ".git"
 
+{- Path to a given hook script in a repository, only if the hook exists
+ - and is executable. -}
+hookPath :: String -> Repo -> IO (Maybe FilePath)
+hookPath script repo = do
+	let hook = gitDir repo </> "hooks" </> script
+	ok <- doesFileExist hook
+	return $ if ok then Just hook else Nothing
+
 {- Path to a repository's --work-tree, that is, its top.
  -
  - Note that for URL repositories, this is the path on the remote host. -}

debian/changelog

@@ -9,6 +9,8 @@ git-annex (3.20120310) UNRELEASED; urgency=low
   * status: Fixed to run in constant space.
   * status: More accurate display of sizes of tmp and bad keys.
   * Work around a bug in rsync (IMHO) introduced by openSUSE's SIP patch.
+  * git-annex-shell: Runs hooks/annex-content after content is received
+    or dropped.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 10 Mar 2012 14:03:22 -0400
 

doc/git-annex-shell.mdwn

@@ -49,6 +49,7 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
 * commit
 
   This commits any staged changes to the git-annex branch.
+  It also runs the annex-content hook.
 
 # OPTIONS
 
@@ -60,6 +61,13 @@ to git-annex-shell are:
   git-annex uses this to specify the UUID of the repository it was expecting
   git-annex-shell to access, as a sanity check.
 
+# HOOK
+
+After content is received or dropped from the repository by git-annex-shell,
+it runs a hook, `.git/hooks/annex-content` (or `hooks/annex-content` on a bare
+repository). The hook is not currently passed any information about what
+changed.
+
 # ENVIRONMENT
 
 * GIT_ANNEX_SHELL_READONLY