1 files changed, 56 insertions, 20 deletions

diff --git a/Assistant/Threads/RemoteControl.hs b/Assistant/Threads/RemoteControl.hs
index b67b0e07f..d33a4858d 100644
--- a/Assistant/Threads/RemoteControl.hs
+++ b/Assistant/Threads/RemoteControl.hs
@@ -15,11 +15,16 @@ import Utility.SimpleProtocol
 import Assistant.Alert
 import Assistant.Alert.Utility
 import Assistant.DaemonStatus
+import qualified Git
+import qualified Git.Types as Git
+import qualified Remote
+import qualified Types.Remote as Remote
 
 import Control.Concurrent
 import Control.Concurrent.Async
 import System.Process (std_in, std_out)
 import qualified Data.Map as M
+import Network.URI
 
 remoteControlThread :: NamedThread
 remoteControlThread = namedThread "RemoteControl" $ do
@@ -32,8 +37,10 @@ remoteControlThread = namedThread "RemoteControl" $ do
 		, std_out = CreatePipe
 		}
 	
+	urimap <- liftIO . newMVar =<< liftAnnex getURIMap
+
 	controller <- asIO $ remoteControllerThread toh
-	responder <- asIO $ remoteResponderThread fromh
+	responder <- asIO $ remoteResponderThread fromh urimap
 
 	-- run controller and responder until the remotedaemon dies
 	liftIO $ do
@@ -50,31 +57,60 @@ remoteControllerThread toh = do
 		hFlush toh
 
 -- read status messages emitted by the remotedaemon and handle them
-remoteResponderThread :: Handle -> Assistant ()
-remoteResponderThread fromh = go M.empty
+remoteResponderThread :: Handle -> MVar (M.Map URI Remote) -> Assistant ()
+remoteResponderThread fromh urimap = go M.empty
   where
 	go syncalerts = do
+		let cont = go syncalerts
+		let withr uri = withRemote uri urimap cont
 		l <- liftIO $ hGetLine fromh
 		case parseMessage l of
-			Just (CONNECTED _rn) -> do
-				go syncalerts
-			Just (DISCONNECTED _rn) -> do
-				go syncalerts
-			Just (SYNCING rn)
-				| M.member rn syncalerts -> go syncalerts
-				| otherwise -> do
-					i <- addAlert $ syncAlert' [rn]
-					go (M.insert rn i syncalerts)
-			Just (DONESYNCING status rn) ->
-				case M.lookup rn syncalerts of
-					Nothing -> go syncalerts
+			Just (CONNECTED _uri) -> do
+				cont
+			Just (DISCONNECTED _uri) -> do
+				cont
+			Just (SYNCING uri) -> withr uri $ \r ->
+				if M.member (Remote.uuid r) syncalerts
+					then go syncalerts
+					else do
+						i <- addAlert $ syncAlert [r]
+						go (M.insert (Remote.uuid r) i syncalerts)
+			Just (DONESYNCING uri status) -> withr uri $ \r ->
+				case M.lookup (Remote.uuid r) syncalerts of
+					Nothing -> cont
 					Just i -> do
 						let (succeeded, failed) = if status
-							then ([rn], [])
-							else ([], [rn])
+							then ([r], [])
+							else ([], [r])
 						updateAlertMap $ mergeAlert i $
-							syncResultAlert' succeeded failed
-						go (M.delete rn syncalerts)
+							syncResultAlert succeeded failed
+						go (M.delete (Remote.uuid r) syncalerts)
+			Just (WARNING (RemoteURI uri) msg) -> do
+				void $ addAlert $
+					warningAlert ("RemoteControl "++ show uri) msg
+				cont
 			Nothing -> do
 				debug ["protocol error from remotedaemon: ", l]
-				go syncalerts
+				cont
+
+getURIMap :: Annex (M.Map URI Remote)
+getURIMap = Remote.remoteMap' id (mkk . Git.location . Remote.repo)
+  where
+	mkk (Git.Url u) = Just u
+	mkk _ = Nothing
+
+withRemote
+	:: RemoteURI
+	-> MVar (M.Map URI Remote)
+	-> Assistant a
+	-> (Remote -> Assistant a)
+	-> Assistant a
+withRemote (RemoteURI uri) remotemap noremote a = do
+	m <- liftIO $ readMVar remotemap
+	case M.lookup uri m of
+		Just r -> a r
+		Nothing -> do
+			{- Reload map, in case a new remote has been added. -}
+			m' <- liftAnnex getURIMap
+			void $ liftIO $ swapMVar remotemap $ m'
+			maybe noremote a (M.lookup uri m')