cache remote.log

Unlikely to speed up any of the existing uses much, but I want to use it
in a message that might be displayed many times.
This commit is contained in:
Joey Hess 2020-09-22 13:52:26 -04:00
parent ebdce707da
commit 5cfcf1f05f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
19 changed files with 62 additions and 29 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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") $

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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 $

View file

@ -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) $

View file

@ -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

View file

@ -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

View file

@ -1,12 +1,13 @@
{- git-annex remote log
-
- Copyright 2011-2019 Joey Hess <id@joeyh.name>
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
-
- 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

View file

@ -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'

View file

@ -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

View file

@ -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

View file

@ -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.
"""]]