refactored hook setup

Annex/Hook.hs

@@ -0,0 +1,42 @@
+{- git-annex git hooks
+ -
+ - Note that it's important that the scripts not change, otherwise
+ - removing old hooks using an old version of the script would fail.
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.Hook where
+
+import Common.Annex
+import qualified Git.Hook as Git
+import Utility.Shell
+import Config
+
+preCommitHook :: Git.Hook
+preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .")
+
+mkHookScript :: String -> String
+mkHookScript s = unlines
+	[ shebang_local
+	, "# automatically configured by git-annex"
+	, s
+	]
+
+hookWrite :: Git.Hook -> Annex ()
+hookWrite h = 
+	-- cannot have git hooks in a crippled filesystem (no execute bit)
+	unlessM crippledFileSystem $
+		unlessM (inRepo $ Git.hookWrite h) $
+			hookWarning h "already exists, not configuring"
+
+hookUnWrite :: Git.Hook -> Annex ()
+hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $
+	hookWarning h "contents modified; not deleting. Edit it to remove call to git annex."
+
+hookWarning :: Git.Hook -> String -> Annex ()
+hookWarning h msg = do
+	r <- gitRepo
+	warning $ Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg

Git/Hook.hs

@@ -0,0 +1,54 @@
+{- git hooks
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Hook where
+
+import Common
+import Git
+import Utility.Tmp
+
+data Hook = Hook
+	{ hookName :: FilePath
+	, hookScript :: String
+	}
+
+hookFile :: Hook -> Repo -> FilePath
+hookFile h r = localGitDir r </> "hooks" </> hookName h
+
+{- Writes a hook. Returns False if the hook already exists with a different
+ - content. -}
+hookWrite :: Hook -> Repo -> IO Bool
+hookWrite h r = do
+	let f = hookFile h r
+	ifM (doesFileExist f)
+		( expectedContent h r
+		, do
+			viaTmp writeFile f (hookScript h)
+			p <- getPermissions f
+			setPermissions f $ p {executable = True}
+			return True
+		)
+
+{- Removes a hook. Returns False if the hook contained something else, and
+ - could not be removed. -}
+hookUnWrite :: Hook -> Repo -> IO Bool
+hookUnWrite h r = do
+	let f = hookFile h r
+	ifM (doesFileExist f)
+		( ifM (expectedContent h r)
+			( do
+				removeFile f
+				return True
+			, return False
+			)
+		, return True
+		)
+
+expectedContent :: Hook -> Repo -> IO Bool
+expectedContent h r = do
+	content <- readFile $ hookFile h r
+	return $ content == hookScript h

Init.hs

@@ -12,11 +12,10 @@ module Init (
 	isInitialized,
 	initialize,
 	uninitialize,
-	probeCrippledFileSystem
+	probeCrippledFileSystem,
 ) where
 
 import Common.Annex
-import Utility.Tmp
 import Utility.Network
 import qualified Annex
 import qualified Git
@@ -26,7 +25,6 @@ import qualified Annex.Branch
 import Logs.UUID
 import Annex.Version
 import Annex.UUID
-import Utility.Shell
 import Config
 import Annex.Direct
 import Annex.Content.Direct
@@ -36,6 +34,7 @@ import Backend
 import Utility.UserInfo
 import Utility.FileMode
 #endif
+import Annex.Hook
 
 genDescription :: Maybe String -> Annex String
 genDescription (Just d) = return d
@@ -56,7 +55,8 @@ initialize mdescription = do
 	setVersion defaultVersion
 	checkCrippledFileSystem
 	checkFifoSupport
-	gitPreCommitHookWrite
+	unlessBare $
+		hookWrite preCommitHook
 	createInodeSentinalFile
 	u <- getUUID
 	{- This will make the first commit to git, so ensure git is set up
@@ -67,7 +67,7 @@ initialize mdescription = do
 
 uninitialize :: Annex ()
 uninitialize = do
-	gitPreCommitHookUnWrite
+	hookUnWrite preCommitHook
 	removeRepoUUID
 	removeVersion
 
@@ -87,46 +87,9 @@ ensureInitialized = getVersion >>= maybe needsinit checkVersion
 isInitialized :: Annex Bool
 isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion
 
-{- set up a git pre-commit hook, if one is not already present -}
-gitPreCommitHookWrite :: Annex ()
-gitPreCommitHookWrite = unlessBare $ do
-	hook <- preCommitHook
-	ifM (liftIO $ doesFileExist hook)
-		( do
-			content <- liftIO $ readFile hook
-			when (content /= preCommitScript) $
-				warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
-		, unlessM crippledFileSystem $
-			liftIO $ do
-				viaTmp writeFile hook preCommitScript
-				p <- getPermissions hook
-				setPermissions hook $ p {executable = True}
-		)
-
-gitPreCommitHookUnWrite :: Annex ()
-gitPreCommitHookUnWrite = unlessBare $ do
-	hook <- preCommitHook
-	whenM (liftIO $ doesFileExist hook) $
-		ifM (liftIO $ (==) preCommitScript <$> readFile hook)
-			( liftIO $ removeFile hook
-			, warning $ "pre-commit hook (" ++ hook ++ 
-				") contents modified; not deleting." ++
-				" Edit it to remove call to git annex."
-			)
-
 unlessBare :: Annex () -> Annex ()
 unlessBare = unlessM $ fromRepo Git.repoIsLocalBare
 
-preCommitHook :: Annex FilePath
-preCommitHook = (</>) <$> fromRepo Git.localGitDir <*> pure "hooks/pre-commit"
-
-preCommitScript :: String
-preCommitScript = unlines
-	[ shebang_local
-	, "# automatically configured by git-annex"
-	, "git annex pre-commit ."
-	]
-
 {- A crippled filesystem is one that does not allow making symlinks,
  - or removing write access from files. -}
 probeCrippledFileSystem :: Annex Bool