diff options
Diffstat (limited to 'RemoteDaemon')
| -rw-r--r-- | RemoteDaemon/Common.hs | 9 | ||||
| -rw-r--r-- | RemoteDaemon/Transport/Ssh.hs | 4 | ||||
| -rw-r--r-- | RemoteDaemon/Transport/Tor.hs | 4 |
3 files changed, 12 insertions, 5 deletions
diff --git a/RemoteDaemon/Common.hs b/RemoteDaemon/Common.hs index 711771f97..366f6aaca 100644 --- a/RemoteDaemon/Common.hs +++ b/RemoteDaemon/Common.hs @@ -8,7 +8,7 @@ module RemoteDaemon.Common ( liftAnnex , inLocalRepo - , checkNewShas + , checkShouldFetch , ConnectionStatus(..) , robustConnection ) where @@ -35,6 +35,13 @@ liftAnnex (TransportHandle _ annexstate) a = do inLocalRepo :: TransportHandle -> (Git.Repo -> IO a) -> IO a inLocalRepo (TransportHandle (LocalRepo g) _) a = a g +-- Check if some shas should be fetched from the remote, +-- and presumably later merged. +checkShouldFetch :: RemoteGitConfig -> TransportHandle -> [Git.Sha] -> IO Bool +checkShouldFetch gc transporthandle shas + | remoteAnnexPull gc = checkNewShas transporthandle shas + | otherwise = return False + -- Check if any of the shas are actally new in the local git repo, -- to avoid unnecessary fetching. checkNewShas :: TransportHandle -> [Git.Sha] -> IO Bool diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs index fdb75e871..772ae9771 100644 --- a/RemoteDaemon/Transport/Ssh.hs +++ b/RemoteDaemon/Transport/Ssh.hs @@ -36,7 +36,7 @@ transportUsingCmd cmd params rr@(RemoteRepo r gc) url h@(TransportHandle (LocalR transportUsingCmd' cmd params rr url transporthandle ichan ochan transportUsingCmd' :: FilePath -> [CommandParam] -> Transport -transportUsingCmd' cmd params (RemoteRepo r _) url transporthandle ichan ochan = +transportUsingCmd' cmd params (RemoteRepo r gc) url transporthandle ichan ochan = robustConnection 1 $ do (Just toh, Just fromh, Just errh, pid) <- createProcess (proc cmd (toCommand params)) @@ -74,7 +74,7 @@ transportUsingCmd' cmd params (RemoteRepo r _) url transporthandle ichan ochan = send (CONNECTED url) handlestdout fromh Just (SshRemote.CHANGED (ChangedRefs shas)) -> do - whenM (checkNewShas transporthandle shas) $ + whenM (checkShouldFetch gc transporthandle shas) $ fetch handlestdout fromh -- avoid reconnect on protocol error diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index afa249b33..b0fa3c189 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/RemoteDaemon/Transport/Tor.hs @@ -129,7 +129,7 @@ serveClient th u r q = bracket setup cleanup start -- Connect to peer's tor hidden service. transport :: Transport -transport (RemoteRepo r _) url@(RemoteURI uri) th ichan ochan = +transport (RemoteRepo r gc) url@(RemoteURI uri) th ichan ochan = case unformatP2PAddress (show uri) of Nothing -> return () Just addr -> robustConnection 1 $ do @@ -168,7 +168,7 @@ transport (RemoteRepo r _) url@(RemoteURI uri) th ichan ochan = v <- runNetProto conn P2P.notifyChange case v of Right (Just (ChangedRefs shas)) -> do - whenM (checkNewShas th shas) $ + whenM (checkShouldFetch gc th shas) $ fetch handlepeer conn _ -> return ConnectionClosed |