git-annex/RemoteDaemon/Common.hs
Joey Hess 15917ec1a8 sync, assistant, remotedaemon: Use ssh connection caching for git pushes and pulls.
For sync, saves 1 ssh connection per remote. For remotedaemon, the same
ssh connection that is already open to run git-annex-shell notifychanges
is reused to pull from the remote.

Only potential problem is that this also enables connection caching
when the assistant syncs with a ssh remote. Including the sync it does
when a network connection has just come up. In that case, cached ssh
connections are likely to be stale, and so using them would hang.
Until I'm sure such problems have been dealt with, this commit needs to
stay on the remotecontrol branch, and not be merged to master.

This commit was sponsored by Alexandre Dupas.
2014-04-12 15:59:34 -04:00

42 lines
1.1 KiB
Haskell

{- git-remote-daemon utilities
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module RemoteDaemon.Common
( liftAnnex
, inLocalRepo
, checkNewShas
) where
import qualified Annex
import Common.Annex
import RemoteDaemon.Types
import qualified Git
import Annex.CatFile
import Control.Concurrent
-- Runs an Annex action. Long-running actions should be avoided,
-- since only one liftAnnex can be running at a time, across all
-- transports.
liftAnnex :: TransportHandle -> Annex a -> IO a
liftAnnex (TransportHandle _ annexstate) a = do
st <- takeMVar annexstate
(r, st') <- Annex.run st a
putMVar annexstate st'
return r
inLocalRepo :: TransportHandle -> (Git.Repo -> IO a) -> IO a
inLocalRepo (TransportHandle g _) a = a g
-- Check if any of the shas are actally new in the local git repo,
-- to avoid unnecessary fetching.
checkNewShas :: TransportHandle -> [Git.Sha] -> IO Bool
checkNewShas transporthandle = check
where
check [] = return True
check (r:rs) = maybe (check rs) (const $ return False)
=<< liftAnnex transporthandle (catObjectDetails r)