add remote start and stop hooks

Locking is used, so that, if there are multiple git-annex processes
using a remote concurrently, the stop hook is only run by the last
process that uses it.

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