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

4 files changed, 28 insertions, 3 deletions

diff --git a/Command/Commit.hs b/Command/Commit.hs
index 2bb016ea0..19b0bc250 100644
--- a/Command/Commit.hs
+++ b/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
diff --git a/Git.hs b/Git.hs
index 284bf331c..043cda5ea 100644
--- a/Git.hs
+++ b/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. -}
diff --git a/debian/changelog b/debian/changelog
index 63797f2ad..b6b62708e 100644
--- a/debian/changelog
+++ b/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
 
diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn
index 0fd77a811..89a05b1d6 100644
--- a/doc/git-annex-shell.mdwn
+++ b/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