diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-11-10 16:52:30 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-11-10 16:52:30 -0400 |
commit | c64d99fcbfef09a4d6088c245bba80001eb6bf2d (patch) | |
tree | 33d4bb8b4998cc9494cbddd7c6a6c36b935fa89d /Assistant | |
parent | 42863c94b1b1dd8d831555febbbbbba3e6a6de02 (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.hs | 23 |
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 ) |