diff --git a/Annex.hs b/Annex.hs index 13695c9986..ed9433fea0 100644 --- a/Annex.hs +++ b/Annex.hs @@ -69,6 +69,7 @@ import Types.AdjustedBranch import Types.WorkerPool import Types.IndexFiles import Types.CatFileHandles +import Types.RemoteConfig import qualified Database.Keys.Handle as Keys import Utility.InodeCache import Utility.Url @@ -129,6 +130,7 @@ data AnnexState = AnnexState , uuiddescmap :: Maybe UUIDDescMap , preferredcontentmap :: Maybe (FileMatcherMap Annex) , requiredcontentmap :: Maybe (FileMatcherMap Annex) + , remoteconfigmap :: Maybe (M.Map UUID RemoteConfig) , forcetrust :: TrustMap , trustmap :: Maybe TrustMap , groupmap :: Maybe GroupMap @@ -188,6 +190,7 @@ newState c r = do , uuiddescmap = Nothing , preferredcontentmap = Nothing , requiredcontentmap = Nothing + , remoteconfigmap = Nothing , forcetrust = M.empty , trustmap = Nothing , groupmap = Nothing diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs index 316bd3041a..676fff7047 100644 --- a/Annex/SpecialRemote.hs +++ b/Annex/SpecialRemote.hs @@ -36,7 +36,7 @@ findExisting name = do headMaybe . sortBy (comparing $ \(u, _, _) -> Down $ M.lookup u t) . findByRemoteConfig (\c -> lookupName c == Just name) - <$> Logs.Remote.readRemoteLog + <$> Logs.Remote.remoteConfigMap newConfig :: RemoteName @@ -56,7 +56,7 @@ newConfig name sameas fromuser m = case sameas of specialRemoteMap :: Annex (M.Map UUID RemoteName) specialRemoteMap = do - m <- Logs.Remote.readRemoteLog + m <- Logs.Remote.remoteConfigMap return $ M.fromList $ mapMaybe go (M.toList m) where go (u, c) = case lookupName c of @@ -79,7 +79,7 @@ findType config = maybe unspecified (specified . fromProposedAccepted) $ autoEnable :: Annex () autoEnable = do - remotemap <- M.filter configured <$> readRemoteLog + remotemap <- M.filter configured <$> remoteConfigMap enabled <- getenabledremotes forM_ (M.toList remotemap) $ \(cu, c) -> unless (cu `M.member` enabled) $ do let u = case findSameasUUID c of diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index 01eaa0046f..31fd0db84c 100644 --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/Assistant/WebApp/Configurators/AWS.hs @@ -154,7 +154,7 @@ postAddGlacierR = glacierConfigurator $ do getEnableS3R :: UUID -> Handler Html getEnableS3R uuid = do - m <- liftAnnex readRemoteLog + m <- liftAnnex remoteConfigMap isia <- case M.lookup uuid m of Just c -> liftAnnex $ do pc <- parsedRemoteConfig S3.remote c @@ -180,7 +180,7 @@ enableAWSRemote remotetype uuid = do runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ awsCredsAForm defcreds case result of FormSuccess creds -> liftH $ do - m <- liftAnnex readRemoteLog + m <- liftAnnex remoteConfigMap let name = fromJust $ lookupName $ fromJust $ M.lookup uuid m makeAWSRemote enableSpecialRemote remotetype SmallArchiveGroup creds name M.empty diff --git a/Assistant/WebApp/Configurators/Delete.hs b/Assistant/WebApp/Configurators/Delete.hs index 82aa3bc35f..25b066e640 100644 --- a/Assistant/WebApp/Configurators/Delete.hs +++ b/Assistant/WebApp/Configurators/Delete.hs @@ -59,7 +59,7 @@ getFinishDeleteRepositoryR uuid = deletionPage $ do reponame <- liftAnnex $ Remote.prettyUUID uuid {- If it's not listed in the remote log, it must be a git repo. -} - gitrepo <- liftAnnex $ M.notMember uuid <$> readRemoteLog + gitrepo <- liftAnnex $ M.notMember uuid <$> remoteConfigMap $(widgetFile "configurators/delete/finished") getDeleteCurrentRepositoryR :: Handler Html diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index 211314ebb8..9708e70524 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -71,7 +71,7 @@ getRepoConfig uuid mremote = do void uuidDescMapLoad groups <- lookupGroups uuid - remoteconfig <- M.lookup uuid <$> readRemoteLog + remoteconfig <- M.lookup uuid <$> remoteConfigMap let (repogroup, associateddirectory) = case getStandardGroup groups of Nothing -> (RepoGroupCustom $ unwords $ map fromGroup $ S.toList groups, Nothing) Just g -> (RepoGroupStandard g, associatedDirectory remoteconfig g) @@ -122,7 +122,7 @@ setRepoConfig uuid mremote oldc newc = do | T.null t -> noop | otherwise -> liftAnnex $ do let dir = takeBaseName $ T.unpack t - m <- readRemoteLog + m <- remoteConfigMap case M.lookup uuid m of Nothing -> noop Just remoteconfig -> configSet uuid $ @@ -220,7 +220,7 @@ editForm new (RepoUUID uuid) let istransfer = repoGroup curr == RepoGroupStandard TransferGroup config <- liftAnnex $ fromMaybe mempty . M.lookup uuid - <$> readRemoteLog + <$> remoteConfigMap let repoInfo = getRepoInfo mremote config let repoEncryption = getRepoEncryption mremote (Just config) $(widgetFile "configurators/edit/repository") @@ -230,7 +230,7 @@ editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do Just rmt -> do config <- liftAnnex $ fromMaybe mempty . M.lookup (Remote.uuid rmt) - <$> readRemoteLog + <$> remoteConfigMap getRepoInfo mr config Nothing -> getRepoInfo Nothing mempty g <- liftAnnex gitRepo @@ -242,7 +242,7 @@ editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex () checkAssociatedDirectory _ Nothing = noop checkAssociatedDirectory cfg (Just r) = do - repoconfig <- M.lookup (Remote.uuid r) <$> readRemoteLog + repoconfig <- M.lookup (Remote.uuid r) <$> remoteConfigMap case repoGroup cfg of RepoGroupStandard gr -> case associatedDirectory repoconfig gr of Just d -> do diff --git a/Assistant/WebApp/Configurators/IA.hs b/Assistant/WebApp/Configurators/IA.hs index 6396a6b2f8..d6d2bd16fa 100644 --- a/Assistant/WebApp/Configurators/IA.hs +++ b/Assistant/WebApp/Configurators/IA.hs @@ -158,7 +158,7 @@ enableIARemote uuid = do runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaCredsAForm defcreds case result of FormSuccess creds -> liftH $ do - m <- liftAnnex readRemoteLog + m <- liftAnnex remoteConfigMap let name = fromJust $ lookupName $ fromJust $ M.lookup uuid m AWS.makeAWSRemote enableSpecialRemote S3.remote PublicGroup creds name M.empty diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 002f9c2552..61c9847cc1 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -209,7 +209,7 @@ postEnableSshGitRemoteR = enableSshRemote getsshinput enableRsyncNet enablesshgi -} enableSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html enableSshRemote getsshdata rsyncnetsetup genericsetup u = do - m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog + m <- fromMaybe M.empty . M.lookup u <$> liftAnnex remoteConfigMap case (unmangle <$> getsshdata m, lookupName m) of (Just sshdata, Just reponame) -> sshConfigurator $ do ((result, form), enctype) <- liftH $ @@ -424,7 +424,7 @@ getConfirmSshR sshdata u -- Not a UUID we know, so prompt about combining. $(widgetFile "configurators/ssh/combine") handleexisting (Just _) = prepSsh False sshdata $ \sshdata' -> do - m <- liftAnnex readRemoteLog + m <- liftAnnex remoteConfigMap case fromProposedAccepted <$> (M.lookup typeField =<< M.lookup u m) of Just "gcrypt" -> combineExistingGCrypt sshdata' u _ -> makeSshRepo ExistingRepo sshdata' @@ -545,7 +545,7 @@ makeSshRepo rs sshdata -- Record the location of the ssh remote in the remote log, so it -- can easily be enabled elsewhere using the webapp. setup r = do - m <- readRemoteLog + m <- remoteConfigMap let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m) let c' = M.insert (Proposed "location") (Proposed (genSshUrl sshdata)) $ M.insert typeField (Proposed "git") $ diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs index d075d34b34..1be1d91758 100644 --- a/Assistant/WebApp/Configurators/WebDAV.hs +++ b/Assistant/WebApp/Configurators/WebDAV.hs @@ -53,7 +53,7 @@ getEnableWebDAVR :: UUID -> Handler Html getEnableWebDAVR = postEnableWebDAVR postEnableWebDAVR :: UUID -> Handler Html postEnableWebDAVR uuid = do - m <- liftAnnex readRemoteLog + m <- liftAnnex remoteConfigMap let c = fromJust $ M.lookup uuid m let name = fromJust $ lookupName c let url = fromProposedAccepted $ fromJust $ M.lookup (Accepted "url") c diff --git a/Assistant/WebApp/Gpg.hs b/Assistant/WebApp/Gpg.hs index d8be86b2b0..9fe0006f9f 100644 --- a/Assistant/WebApp/Gpg.hs +++ b/Assistant/WebApp/Gpg.hs @@ -80,7 +80,7 @@ getGCryptRemoteName u repoloc = do mname <- ifM (inRepo $ Git.Command.runBool [Param "fetch", Param tmpremote]) ( do void Annex.Branch.forceUpdate - (lookupName <=< M.lookup u) <$> readRemoteLog + (lookupName <=< M.lookup u) <$> remoteConfigMap , return Nothing ) void $ inRepo $ Git.Remote.Remove.remove tmpremote diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs index 6ab65b4a4d..e89a782b63 100644 --- a/Assistant/WebApp/RepoList.hs +++ b/Assistant/WebApp/RepoList.hs @@ -162,7 +162,7 @@ repoList reposelector return $ here : l else return l unconfigured = liftAnnex $ do - m <- readRemoteLog + m <- remoteConfigMap g <- gitRepo map snd . catMaybes . filter selectedremote . map (findinfo m g) diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index 04b4288a4c..2e7f7074d6 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -72,7 +72,7 @@ startNormalRemote name restparams r startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID)) -> CommandStart startSpecialRemote name config Nothing = do m <- SpecialRemote.specialRemoteMap - confm <- Logs.Remote.readRemoteLog + confm <- Logs.Remote.remoteConfigMap Remote.nameToUUID' name >>= \case Right u | u `M.member` m -> startSpecialRemote name config $ diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 3a90676ceb..51972cc318 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -71,7 +71,7 @@ start o (name:ws) = ifM (isJust <$> findExisting name) (sameas o) c <- newConfig name sameasuuid (Logs.Remote.keyValToConfig Proposed ws) - <$> readRemoteLog + <$> remoteConfigMap t <- either giveup return (findType c) if whatElse o then startingCustomOutput (ActionItemOther Nothing) $ diff --git a/Command/RenameRemote.hs b/Command/RenameRemote.hs index a61b531250..fd4683f1f1 100644 --- a/Command/RenameRemote.hs +++ b/Command/RenameRemote.hs @@ -37,7 +37,7 @@ start ps@(oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \ca Nothing -> Remote.nameToUUID' oldname >>= \case Left e -> giveup e Right u -> do - m <- Logs.Remote.readRemoteLog + m <- Logs.Remote.remoteConfigMap case M.lookup u m of Nothing -> giveup "That is not a special remote." Just cfg -> go u cfg Nothing diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 1235713e38..7b8366f855 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -86,7 +86,7 @@ preferredRequiredMapsLoad mktokens = do preferredRequiredMapsLoad' :: (PreferredContentData -> [ParseToken (MatchFiles Annex)]) -> Annex (M.Map UUID (Either String (FileMatcher Annex)), M.Map UUID (Either String (FileMatcher Annex))) preferredRequiredMapsLoad' mktokens = do groupmap <- groupMap - configmap <- readRemoteLog + configmap <- remoteConfigMap let genmap l gm = let mk u = makeMatcher groupmap configmap gm u mktokens in simpleMap diff --git a/Logs/Remote.hs b/Logs/Remote.hs index f747b51469..55e00bbcc5 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -1,12 +1,13 @@ {- git-annex remote log - - - Copyright 2011-2019 Joey Hess + - Copyright 2011-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} module Logs.Remote ( remoteLog, + remoteConfigMap, readRemoteLog, configSet, keyValToConfig, @@ -18,6 +19,7 @@ module Logs.Remote ( ) where import Annex.Common +import qualified Annex import qualified Annex.Branch import Types.Remote import Logs @@ -35,8 +37,20 @@ configSet u cfg = do buildRemoteConfigLog . changeLog c u (removeSameasInherited cfg) . parseRemoteConfigLog + Annex.changeState $ \s -> s { Annex.remoteconfigmap = Nothing } + +{- Map of remotes by uuid containing key/value config maps. + - Cached for speed. -} +remoteConfigMap :: Annex (M.Map UUID RemoteConfig) +remoteConfigMap = maybe remoteConfigMapLoad return + =<< Annex.getState Annex.remoteconfigmap + +remoteConfigMapLoad :: Annex (M.Map UUID RemoteConfig) +remoteConfigMapLoad = do + m <- readRemoteLog + Annex.changeState $ \s -> s { Annex.remoteconfigmap = Just m } + return m -{- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID RemoteConfig) readRemoteLog = calcRemoteConfigMap <$> Annex.Branch.get remoteLog diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 997a3ec8e0..890675c5b8 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -109,7 +109,7 @@ gen baser u rc gc rs = do -- correctly. resetup gcryptid r = do let u' = genUUIDInNameSpace gCryptNameSpace gcryptid - v <- M.lookup u' <$> readRemoteLog + v <- M.lookup u' <$> remoteConfigMap case (Git.remoteName baser, v) of (Just remotename, Just rc') -> do pc <- parsedRemoteConfig remote rc' diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index f485a9b259..95b56fe0f5 100644 --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -187,9 +187,9 @@ mySetup ss mu _ c gc = do configKnownUrl :: Git.Repo -> Annex (Maybe Git.Repo) configKnownUrl r | Git.repoIsUrl r = do - l <- readRemoteLog + m <- remoteConfigMap g <- Annex.gitRepo - case Annex.SpecialRemote.Config.findByRemoteConfig (match g) l of + case Annex.SpecialRemote.Config.findByRemoteConfig (match g) m of ((u, _, mcu):[]) -> Just <$> go u mcu _ -> return Nothing | otherwise = return Nothing diff --git a/Remote/List.hs b/Remote/List.hs index c383ce00c7..7695eec902 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -72,7 +72,7 @@ remoteList = do remoteList' :: Bool -> Annex [Remote] remoteList' autoinit = do - m <- readRemoteLog + m <- remoteConfigMap rs <- concat <$> mapM (process m) remoteTypes Annex.changeState $ \s -> s { Annex.remotes = rs } return rs @@ -96,7 +96,7 @@ remoteGen m t g = do {- Updates a local git Remote, re-reading its git config. -} updateRemote :: Remote -> Annex (Maybe Remote) updateRemote remote = do - m <- readRemoteLog + m <- remoteConfigMap remote' <- updaterepo =<< getRepo remote remoteGen m (remotetype remote) remote' where diff --git a/doc/todo/make___34____Try_making_some_of_these_repositories_available__34___more_informative/comment_4_aefdd17cbfc249ac9b3c6880cabca6d1._comment b/doc/todo/make___34____Try_making_some_of_these_repositories_available__34___more_informative/comment_4_aefdd17cbfc249ac9b3c6880cabca6d1._comment new file mode 100644 index 0000000000..b28de85723 --- /dev/null +++ b/doc/todo/make___34____Try_making_some_of_these_repositories_available__34___more_informative/comment_4_aefdd17cbfc249ac9b3c6880cabca6d1._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 4""" + date="2020-09-22T16:45:19Z" + content=""" +This risks changing the --json output. Eg currently it has: + + {"command":"get","wanted":[{"here":false,"uuid":"7f03b57d-5923-489a-be26-1ab254d0620d","description":"archive-13 [house]"}],"note":"from house...\nrsync failed -- run git annex again to resume file transfer\nUnable to access these remotes: house\nTry making some of these repositories available:\n\t7f03b57d-5923-489a-be26-1ab254d0620d -- archive-13 [house]\n","skipped":[] + +The "wanted" list comes from the display of the list of +uuids, but now there would be up to 3 lists displayed. + +I doubt anything uses that, but I don't want to change the json, +so I suppose it would need to keep the current behavior when json is +enabled, ugh. +"""]]