hook special remote: Added combined hook program support.

Remote/Hook.hs

@@ -23,6 +23,9 @@ import Remote.Helper.Encryptable
 import Crypto
 import Utility.Metered
 
+type Action = String
+type HookName = String
+
 remote :: RemoteType
 remote = RemoteType {
 	typename = "hook",
@@ -67,14 +70,15 @@ hookSetup u c = do
 	gitConfigSpecialRemote u c' "hooktype" hooktype
 	return c'
 
-hookEnv :: Key -> Maybe FilePath -> IO (Maybe [(String, String)])
-hookEnv k f = Just <$> mergeenv (fileenv f ++ keyenv)
+hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
+hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
   where
 	mergeenv l = M.toList . M.union (M.fromList l) 
 		<$> M.fromList <$> getEnvironment
 	env s v = ("ANNEX_" ++ s, v)
 	keyenv = catMaybes
 		[ Just $ env "KEY" (key2file k)
+		, Just $ env "ACTION" action
 		, env "HASH_1" <$> headMaybe hashbits
 		, env "HASH_2" <$> headMaybe (drop 1 hashbits)
 		]
@@ -82,64 +86,70 @@ hookEnv k f = Just <$> mergeenv (fileenv f ++ keyenv)
 	fileenv (Just file) =  [env "FILE" file]
 	hashbits = map takeDirectory $ splitPath $ hashDirMixed k
 
-lookupHook :: String -> String -> Annex (Maybe String)
-lookupHook hooktype hook =do
-	command <- getConfig (annexConfig hookname) ""
+lookupHook :: HookName -> Action -> Annex (Maybe String)
+lookupHook hookname action = do
+	command <- getConfig (annexConfig hook) ""
 	if null command
 		then do
-			warning $ "missing configuration for " ++ hookname
-			return Nothing
+			fallback <- getConfig (annexConfig $ hookfallback) ""
+			if null fallback
+				then do
+					warning $ "missing configuration for " ++ hook ++ " or " ++ hookfallback
+					return Nothing
+				else return $ Just fallback
 		else return $ Just command
   where
-	hookname = hooktype ++ "-" ++ hook ++ "-hook"
+	hook = hookname ++ "-" ++ action ++ "-hook"
+	hookfallback = hookname ++ "-hook"
 
-runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
-runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype hook
+runHook :: HookName -> Action -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
+runHook hook action k f a = maybe (return False) run =<< lookupHook hook action
   where
 	run command = do
 		showOutput -- make way for hook output
-		ifM (liftIO $ boolSystemEnv "sh" [Param "-c", Param command] =<< hookEnv k f)
+		ifM (liftIO $ boolSystemEnv "sh" [Param "-c", Param command] =<< hookEnv action k f)
 			( a
 			, do
 				warning $ hook ++ " hook exited nonzero!"
 				return False
 			)
 
-store :: String -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+store :: HookName -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store h k _f _p = sendAnnex k (void $ remove h k) $ \src ->
 	runHook h "store" k (Just src) $ return True
 
-storeEncrypted :: String -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted :: HookName -> GpgOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted h gpgOpts (cipher, enck) k _p = withTmp enck $ \tmp ->
 	sendAnnex k (void $ remove h enck) $ \src -> do
 		liftIO $ encrypt gpgOpts cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		runHook h "store" enck (Just tmp) $ return True
 
-retrieve :: String -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
+retrieve :: HookName -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
 retrieve h k _f d _p = runHook h "retrieve" k (Just d) $ return True
 
-retrieveCheap :: String -> Key -> FilePath -> Annex Bool
+retrieveCheap :: HookName -> Key -> FilePath -> Annex Bool
 retrieveCheap _ _ _ = return False
 
-retrieveEncrypted :: String -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieveEncrypted :: HookName -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
 retrieveEncrypted h (cipher, enck) _ f _p = withTmp enck $ \tmp ->
 	runHook h "retrieve" enck (Just tmp) $ liftIO $ catchBoolIO $ do
 		decrypt cipher (feedFile tmp) $
 			readBytes $ L.writeFile f
 		return True
 
-remove :: String -> Key -> Annex Bool
+remove :: HookName -> Key -> Annex Bool
 remove h k = runHook h "remove" k Nothing $ return True
 
-checkPresent :: Git.Repo -> String -> Key -> Annex (Either String Bool)
+checkPresent :: Git.Repo -> HookName -> Key -> Annex (Either String Bool)
 checkPresent r h k = do
 	showAction $ "checking " ++ Git.repoDescribe r
-	v <- lookupHook h "checkpresent"
+	v <- lookupHook h action
 	liftIO $ catchMsgIO $ check v
   where
+  	action = "checkpresent"
 	findkey s = key2file k `elem` lines s
-	check Nothing = error "checkpresent hook misconfigured"
+	check Nothing = error $ action ++ " hook misconfigured"
 	check (Just hook) = do
-		env <- hookEnv k Nothing
+		env <- hookEnv action k Nothing
 		findkey <$> readProcessEnv "sh" ["-c", hook] env

debian/changelog

@@ -4,6 +4,7 @@ git-annex (4.20130522) UNRELEASED; urgency=low
   * XMPP: Avoid redundant and unncessary pushes. Note that this breaks
     compatibility with previous versions of git-annex, which will refuse
     to accept any XMPP pushes from this version.
+  * hook special remote: Added combined hook program support.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 21 May 2013 18:22:46 -0400
 

doc/special_remotes/hook.mdwn

@@ -50,7 +50,7 @@ These environment variables are used to communicate with the hook commands:
   into 1024 buckets.
 * `ANNEX_HASH_2` - another hash value, can be used for a second level of hashing
 
-The setting to use in git config for the hook commands are as follows:
+The settings to use in git config for the hook commands are as follows:
 
 * `annex.$hooktype-store-hook` - Command run to store a key in the special remote.
   `ANNEX_FILE` contains the content to be stored.
@@ -68,3 +68,38 @@ The setting to use in git config for the hook commands are as follows:
   if and only if the key has been actively verified to be present in the
   special remote (caching presence information is a very bad idea);
   all other output to stdout will be ignored.
+
+## combined hook program
+
+Rather than setting all of the above hooks, you can write a single
+program that handles everything, and set a single hook to make it be used.
+
+	# git config annex.demo-hook /usr/local/bin/annexdemo
+	# git annex initremote mydemorepo type=hook hooktype=demo encryption=none
+
+The program just needs to look at the `ANNEX_ACTION` environment variable
+to see what it's being asked to do  For example:
+
+[[!format sh """
+#!/bin/sh
+set -e
+case "$ANNEX_ACTION" in
+	store)
+		demo-upload "$ANNEX_HASH_1/$ANNEX_HASH_2/$ANNEX_KEY" < "$ANNEX_FILE"
+	;;
+	retrieve)
+		demo-download "$ANNEX_HASH_1/$ANNEX_HASH_2/$ANNEX_KEY" > "$ANNEX_FILE"
+	;;
+	remove)
+		demo-nuke "$ANNEX_HASH_1/$ANNEX_HASH_2/$ANNEX_KEY"
+	;;
+	checkpresent)
+		if demo-exists "$ANNEX_HASH_1/$ANNEX_HASH_2/$ANNEX_KEY"; then
+			echo "$ANNEX_KEY"
+		fi
+	*)
+		echo "unkown ANNEX_ACTION: $ANNEX_ACTION" >&2
+		exit 1
+	;;
+esac
+"""]]