hook special remote: Added combined hook program support.
This commit is contained in:
parent
08c03b2af3
commit
2dce874c77
3 changed files with 68 additions and 22 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue