From 6e47a1412175cbc00f44ea8dc663ad83331cfb6d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 8 Apr 2014 13:41:36 -0400 Subject: cleaned up AnnexState handling in transports --- RemoteDaemon/Transport/Ssh.hs | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) (limited to 'RemoteDaemon/Transport') diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs index 8f4d007e8..557a3dce9 100644 --- a/RemoteDaemon/Transport/Ssh.hs +++ b/RemoteDaemon/Transport/Ssh.hs @@ -8,13 +8,11 @@ module RemoteDaemon.Transport.Ssh (transport) where import Common.Annex -import qualified Annex import RemoteDaemon.Types -import qualified RemoteDaemon.Transport.Ssh.Types as SshRemote +import RemoteDaemon.Common import Remote.Helper.Ssh +import qualified RemoteDaemon.Transport.Ssh.Types as SshRemote import Utility.SimpleProtocol -import qualified Git -import Annex.CatFile import Git.Command import Control.Concurrent.Chan @@ -22,13 +20,12 @@ import Control.Concurrent.Async import System.Process (std_in, std_out) transport :: Transport -transport r remotename annexstate ichan ochan = Annex.eval annexstate $ do - v <- git_annex_shell r "notifychanges" [] [] +transport r remotename transporthandle ichan ochan = do + v <- liftAnnex transporthandle $ git_annex_shell r "notifychanges" [] [] case v of Nothing -> noop - Just (cmd, params) -> liftIO $ go cmd (toCommand params) + Just (cmd, params) -> go cmd (toCommand params) where - send msg = writeChan ochan (msg remotename) go cmd params = do (Just toh, Just fromh, _, pid) <- createProcess (proc cmd params) { std_in = CreatePipe @@ -45,9 +42,9 @@ transport r remotename annexstate ichan ochan = Annex.eval annexstate $ do l <- hGetLine fromh case parseMessage l of Just SshRemote.READY -> send CONNECTED - Just (SshRemote.CHANGED refs) -> - Annex.eval annexstate $ - fetchNew remotename refs + Just (SshRemote.CHANGED shas) -> + whenM (checkNewShas transporthandle shas) $ + fetch Nothing -> shutdown -- The only control message that matters is STOP. @@ -66,10 +63,10 @@ transport r remotename annexstate ichan ochan = Annex.eval annexstate $ do void $ tryIO $ concurrently fromshell handlecontrol shutdown --- Check if any of the shas are actally new, to avoid unnecessary fetching. -fetchNew :: RemoteName -> [Git.Sha] -> Annex () -fetchNew remotename = check - where - check [] = void $ inRepo $ runBool [Param "fetch", Param remotename] - check (r:rs) = maybe (check rs) (const noop) - =<< catObjectDetails r + send msg = writeChan ochan (msg remotename) + + fetch = do + send SYNCING + ok <- inLocalRepo transporthandle $ + runBool [Param "fetch", Param remotename] + send (DONESYNCING ok) -- cgit v1.2.3