add support for readonly remotes

Currently only the web special remote is readonly, but it'd be possible to
also have readonly drives, or other remotes. These are handled in the
assistant by only downloading from them, and never trying to upload to
them.

1 files changed, 5 insertions, 5 deletions

diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs
index 67939fffb..ad29459a9 100644
--- a/Assistant/WebApp/Configurators.hs
+++ b/Assistant/WebApp/Configurators.hs
@@ -12,12 +12,12 @@ module Assistant.WebApp.Configurators where
 import Assistant.Common
 import Assistant.WebApp
 import Assistant.WebApp.SideBar
+import Assistant.DaemonStatus
 import Assistant.Threads.MountWatcher (handleMount)
 import Utility.Yesod
 import qualified Remote
+import qualified Types.Remote as Remote
 import Remote.List
-import Logs.Web (webUUID)
-import Logs.Trust
 import Annex.UUID (getUUID)
 import Init
 import qualified Git
@@ -60,11 +60,11 @@ getRepositoriesR = bootstrap (Just Config) $ do
 {- A numbered list of known repositories, including the current one. -}
 repoList :: Handler [(String, String)]
 repoList = do
+	rs <- filter (not . Remote.readonly) . knownRemotes <$>
+		(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
 	l <- runAnnex [] $ do
 		u <- getUUID
-		rs <- map Remote.uuid <$> Remote.remoteList
-		rs' <- snd <$> trustPartition DeadTrusted rs
-		Remote.prettyListUUIDs $ filter (/= webUUID) $ nub $ u:rs'
+		Remote.prettyListUUIDs $ nub $ u:(map Remote.uuid rs)
 	return $ zip counter l
 	where
 		counter = map show ([1..] :: [Int])