diff options
| -rw-r--r-- | Locations.hs | 5 | ||||
| -rw-r--r-- | Remote/Helper/Hooks.hs | 93 | ||||
| -rw-r--r-- | Remote/List.hs | 3 | ||||
| -rw-r--r-- | debian/changelog | 3 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 15 |
5 files changed, 118 insertions, 1 deletions
diff --git a/Locations.hs b/Locations.hs index 244388e0e..18df06004 100644 --- a/Locations.hs +++ b/Locations.hs @@ -24,6 +24,7 @@ module Locations ( gitAnnexIndexLock, gitAnnexIndexDirty, gitAnnexSshDir, + gitAnnexRemotesDir, isLinkToAnnex, annexHashes, hashDirMixed, @@ -152,6 +153,10 @@ gitAnnexIndexDirty r = gitAnnexDir r </> "index.dirty" gitAnnexSshDir :: Git.Repo -> FilePath gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r </> "ssh" +{- .git/annex/remotes/ is used for remote-specific state. -} +gitAnnexRemotesDir :: Git.Repo -> FilePath +gitAnnexRemotesDir r = addTrailingPathSeparator $ gitAnnexDir r </> "remotes" + {- Checks a symlink target to see if it appears to point to annexed content. -} isLinkToAnnex :: FilePath -> Bool isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs new file mode 100644 index 000000000..5929b1793 --- /dev/null +++ b/Remote/Helper/Hooks.hs @@ -0,0 +1,93 @@ +{- Adds hooks to remotes. + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Remote.Helper.Hooks (addHooks) where + +import qualified Data.Map as M + +import Common.Annex +import Types.Remote +import qualified Annex +import Annex.LockPool +import Config + +{- Modifies a remote's access functions to first run the + - annex-start-command hook, and trigger annex-stop-command on shutdown. + - This way, the hooks are only run when a remote is actively being used. + -} +addHooks :: Remote -> Annex Remote +addHooks r = addHooks' r <$> lookupHook r "start" <*> lookupHook r "stop" +addHooks' :: Remote -> Maybe String -> Maybe String -> Remote +addHooks' r Nothing Nothing = r +addHooks' r starthook stophook = r' + where + r' = r + { storeKey = \k -> wrapper $ storeKey r k + , retrieveKeyFile = \k f -> wrapper $ retrieveKeyFile r k f + , retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f + , removeKey = \k -> wrapper $ removeKey r k + , hasKey = \k -> wrapper $ hasKey r k + } + where + wrapper = runHooks r' starthook stophook + +runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a +runHooks r starthook stophook a = do + dir <- fromRepo gitAnnexRemotesDir + let lck = dir </> remoteid ++ ".lck" + whenM (not . any (== lck) . M.keys <$> getPool) $ do + liftIO $ createDirectoryIfMissing True dir + firstrun lck + a + where + remoteid = show (uuid r) + run Nothing = return () + run (Just command) = liftIO $ do + _ <- boolSystem "sh" [Param "-c", Param command] + return () + firstrun lck = do + -- Take a shared lock; This indicates that git-annex + -- is using the remote, and prevents other instances + -- of it from running the stophook. If another + -- instance is shutting down right now, this + -- will block waiting for its exclusive lock to clear. + lockFile lck + + -- The starthook is run even if some other git-annex + -- is already running, and ran it before. + -- It would be difficult to use locking to ensure + -- it's only run once, and it's also possible for + -- git-annex to be interrupted before it can run the + -- stophook, in which case the starthook + -- would be run again by the next git-annex. + -- So, requiring idempotency is the right approach. + run starthook + + Annex.addCleanup (remoteid ++ "-stop-command") $ + runstop lck + runstop lck = do + -- Drop any shared lock we have, and take an + -- exclusive lock, without blocking. If the lock + -- succeeds, we're the only process using this remote, + -- so can stop it. + unlockFile lck + fd <- liftIO $ openFd lck ReadWrite (Just stdFileMode) defaultFileFlags + v <- liftIO $ tryIO $ + setLock fd (WriteLock, AbsoluteSeek, 0, 0) + case v of + Left _ -> return () + Right _ -> run stophook + liftIO $ closeFd fd + +lookupHook :: Remote -> String -> Annex (Maybe String) +lookupHook r n = do + command <- getConfig (repo r) hookname "" + if null command + then return Nothing + else return $ Just command + where + hookname = n ++ "-command" diff --git a/Remote/List.hs b/Remote/List.hs index e589b4401..57dfa43eb 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -15,6 +15,7 @@ import Logs.Remote import Types.Remote import Annex.UUID import Config +import Remote.Helper.Hooks import qualified Remote.Git import qualified Remote.S3 @@ -51,7 +52,7 @@ remoteList = do process m t = enumerate t >>= mapM (gen m t) gen m t r = do u <- getRepoUUID r - generate t r u (M.lookup u m) + addHooks =<< generate t r u (M.lookup u m) {- All remotes that are not ignored. -} enabledRemoteList :: Annex [Remote] diff --git a/debian/changelog b/debian/changelog index 7b9db5418..8ac34487b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,9 @@ git-annex (3.20120230) UNRELEASED; urgency=low * Directory special remotes now support chunking files written to them, avoiding writing files larger than a specified size. * Add progress bar display to the directory special remote. + * Add configurable hooks that are run when git-annex starts and stops + using a remote: remote.name.annex-start-command and + remote.name.annex-stop-command -- Joey Hess <joeyh@debian.org> Thu, 01 Mar 2012 22:34:27 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 85d972259..a941d4420 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -627,6 +627,21 @@ Here are all the supported configuration settings. This allows varying the cost based on eg, the current network. The cost-command can be any shell command line. +* `remote.<name>.annex-start-command` + + A command to run when git-annex begins to use the remote. This can + be used to, for example, mount the directory containing the remote. + + The command may be run repeatedly in multiple git-annex processes + are running concurrently. + +* `remote.<name>.annex-stop-command` + + A command to run when git-annex is done using the remote. + + The command will only be run once *all* running git-annex processes + are finished using the remote. + * `remote.<name>.annex-ignore` If set to `true`, prevents git-annex |