aboutsummaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-11-10 16:52:30 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-11-10 16:52:30 -0400
commitc64d99fcbfef09a4d6088c245bba80001eb6bf2d (patch)
tree33d4bb8b4998cc9494cbddd7c6a6c36b935fa89d /Assistant
parent42863c94b1b1dd8d831555febbbbbba3e6a6de02 (diff)
assistant: Pass ssh-options through 3 more git pull/push calls that were missed before.
It was used for regular pull, but not for regular push, tagged push, or the fallback fetching.
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Sync.hs23
1 files changed, 17 insertions, 6 deletions
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index d914d2246..7a9ea6a86 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -28,6 +28,7 @@ import qualified Remote.List as Remote
import qualified Annex.Branch
import Annex.UUID
import Annex.TaggedPush
+import Annex.Ssh
import qualified Config
import Git.Config
import Assistant.NamedThread
@@ -148,7 +149,7 @@ pushToRemotes' now notifypushes remotes = do
go _ _ _ _ [] = return [] -- no remotes, so nothing to do
go shouldretry (Just branch) g u rs = do
debug ["pushing to", show rs]
- (succeeded, failed) <- liftIO $ inParallel (push g branch) rs
+ (succeeded, failed) <- parallelPush g rs (push branch)
updatemap succeeded []
if null failed
then do
@@ -172,15 +173,24 @@ pushToRemotes' now notifypushes remotes = do
fallback branch g u rs = do
debug ["fallback pushing to", show rs]
- (succeeded, failed) <- liftIO $
- inParallel (\r -> taggedPush u Nothing branch r g) rs
+ (succeeded, failed) <- parallelPush g rs (taggedPush u Nothing branch)
updatemap succeeded failed
when (notifypushes && (not $ null succeeded)) $
sendNetMessage $ NotifyPush $
map Remote.uuid succeeded
return failed
- push g branch remote = Command.Sync.pushBranch remote branch g
+ push branch remote = Command.Sync.pushBranch remote branch
+
+parallelPush :: Git.Repo -> [Remote] -> (Remote -> Git.Repo -> IO Bool)-> Assistant ([Remote], [Remote])
+parallelPush g rs a = do
+ rgs <- liftAnnex $ mapM topush rs
+ (succeededrgs, failedrgs) <- liftIO $ inParallel (uncurry a) rgs
+ return (map fst succeededrgs, map fst failedrgs)
+ where
+ topush r = (,)
+ <$> pure r
+ <*> sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g
{- Displays an alert while running an action that syncs with some remotes,
- and returns any remotes that it failed to sync with.
@@ -221,8 +231,9 @@ manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Remote], Bool)
manualPull currentbranch remotes = do
g <- liftAnnex gitRepo
let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes
- failed <- liftIO $ forM normalremotes $ \r ->
- ifM (Git.Command.runBool [Param "fetch", Param $ Remote.name r] g)
+ failed <- forM normalremotes $ \r -> do
+ g' <- liftAnnex $ sshOptionsTo (Remote.repo r) (Remote.gitconfig r) g
+ ifM (liftIO $ Git.Command.runBool [Param "fetch", Param $ Remote.name r] g')
( return Nothing
, return $ Just r
)