ssh connection caching

Ssh connection caching is now enabled automatically by git-annex. Only one
ssh connection is made to each host per git-annex run, which can speed some
things up a lot, as well as avoiding repeated password prompts. Concurrent
git-annex processes also share ssh connections. Cached ssh connections are
shut down when git-annex exits.

Note: The rsync special remote does not yet participate in the ssh
connection caching.

1 files changed, 43 insertions, 0 deletions

diff --git a/Annex/LockPool.hs b/Annex/LockPool.hs
new file mode 100644
index 000000000..3fede5739
--- /dev/null
+++ b/Annex/LockPool.hs
@@ -0,0 +1,43 @@
+{- git-annex lock pool
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.LockPool where
+
+import qualified Data.Map as M
+import System.Posix.Types (Fd)
+
+import Common.Annex
+import Annex
+
+{- Create a specified lock file, and takes a shared lock. -}
+lockFile :: FilePath -> Annex ()
+lockFile file = go =<< fromPool file
+	where
+		go (Just _) = return () -- already locked
+		go Nothing = do
+			fd <- liftIO $ openFd file ReadOnly (Just stdFileMode) defaultFileFlags
+			liftIO $ waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0)
+			changePool $ M.insert file fd
+
+unlockFile :: FilePath -> Annex ()
+unlockFile file = go =<< fromPool file
+	where
+		go Nothing = return ()
+		go (Just fd) = do
+			liftIO $ closeFd fd
+			changePool $ M.delete file
+
+getPool :: Annex (M.Map FilePath Fd)
+getPool = getState lockpool
+
+fromPool :: FilePath -> Annex (Maybe Fd)
+fromPool file = M.lookup file <$> getPool
+
+changePool :: (M.Map FilePath Fd -> M.Map FilePath Fd) -> Annex ()
+changePool a = do
+	m <- getPool
+	changeState $ \s -> s { lockpool = a m }