get rid of hardcoded "name" lookups

Support "sameas-name" being set instead.

In RenameRemote, rename which ever of the two is set.
This commit is contained in:
Joey Hess 2019-10-10 13:08:17 -04:00
parent 92ff30df70
commit d1130ea04a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
15 changed files with 45 additions and 14 deletions

View file

@ -24,6 +24,7 @@ import Types.StandardGroups
import Creds
import Assistant.Gpg
import Git.Types (RemoteName)
import Annex.SpecialRemote.Config
import qualified Data.Text as T
import qualified Data.Map as M
@ -195,7 +196,7 @@ enableAWSRemote remotetype uuid = do
case result of
FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog
let name = fromJust $ M.lookup "name" $
let name = fromJust $ lookupName $
fromJust $ M.lookup uuid m
makeAWSRemote enableSpecialRemote remotetype SmallArchiveGroup creds name M.empty
_ -> do

View file

@ -24,6 +24,7 @@ import Assistant.Gpg
import Types.Remote (RemoteConfig)
import qualified Annex.Url as Url
import Creds
import Annex.SpecialRemote.Config
import qualified Data.Text as T
import qualified Data.Map as M
@ -169,7 +170,7 @@ enableIARemote uuid = do
case result of
FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog
let name = fromJust $ M.lookup "name" $
let name = fromJust $ lookupName $
fromJust $ M.lookup uuid m
AWS.makeAWSRemote enableSpecialRemote S3.remote PublicGroup creds name M.empty
_ -> do

View file

@ -27,6 +27,7 @@ import qualified Git.Command
import qualified Annex.Branch
import Annex.UUID
import Logs.UUID
import Annex.SpecialRemote.Config
import Assistant.RemoteControl
import Types.Creds
import Assistant.CredPairCache
@ -208,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
case (unmangle <$> getsshdata m, M.lookup "name" m) of
case (unmangle <$> getsshdata m, lookupName m) of
(Just sshdata, Just reponame) -> sshConfigurator $ do
((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
@ -546,7 +547,9 @@ makeSshRepo rs sshdata
let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m)
let c' = M.insert "location" (genSshUrl sshdata) $
M.insert "type" "git" $
M.insert "name" (fromMaybe (Remote.name r) (M.lookup "name" c)) c
case M.lookup nameKey c of
Just _ -> c
Nothing -> M.insert nameKey (Remote.name r) c
configSet (Remote.uuid r) c'
makeSshRepoConnection :: RepoStatus -> Annex RemoteName -> (Remote -> Annex ()) -> Handler Html

View file

@ -21,6 +21,7 @@ import Logs.Remote
import Git.Types (RemoteName)
import Assistant.Gpg
import Types.GitConfig
import Annex.SpecialRemote.Config
import qualified Data.Map as M
#endif
@ -56,7 +57,7 @@ postEnableWebDAVR :: UUID -> Handler Html
postEnableWebDAVR uuid = do
m <- liftAnnex readRemoteLog
let c = fromJust $ M.lookup uuid m
let name = fromJust $ M.lookup "name" c
let name = fromJust $ lookupName c
let url = fromJust $ M.lookup "url" c
mcreds <- liftAnnex $ do
dummycfg <- liftIO dummyRemoteGitConfig

View file

@ -21,6 +21,7 @@ import qualified Git.GCrypt
import qualified Remote.GCrypt as GCrypt
import Git.Types (RemoteName)
import Assistant.WebApp.MakeRemote
import Annex.SpecialRemote.Config
import Logs.Remote
import qualified Data.Map as M
@ -79,7 +80,7 @@ getGCryptRemoteName u repoloc = do
mname <- ifM (inRepo $ Git.Command.runBool [Param "fetch", Param tmpremote])
( do
void Annex.Branch.forceUpdate
(M.lookup "name" <=< M.lookup u) <$> readRemoteLog
(lookupName <=< M.lookup u) <$> readRemoteLog
, return Nothing
)
void $ inRepo $ Git.Remote.Remove.remove tmpremote

View file

@ -9,6 +9,7 @@ module Command.RenameRemote where
import Command
import qualified Annex.SpecialRemote
import Annex.SpecialRemote.Config (nameKey, sameasNameKey)
import qualified Logs.Remote
import qualified Types.Remote as R
import qualified Remote
@ -46,5 +47,9 @@ start _ = giveup "Specify an old name (or uuid or description) and a new name."
perform :: UUID -> R.RemoteConfig -> String -> CommandPerform
perform u cfg newname = do
Logs.Remote.configSet u (M.insert "name" newname cfg)
let namekey = case M.lookup sameasNameKey cfg of
Just _ -> sameasNameKey
Nothing -> nameKey
Logs.Remote.configSet u (M.insert namekey newname cfg)
next $ return True

View file

@ -155,7 +155,7 @@ externalSetup _ mu _ c gc = do
c'' <- case M.lookup "readonly" c of
Just v | isTrue v == Just True -> do
setConfig (remoteConfig (fromJust (M.lookup "name" c)) "readonly") (boolConfig True)
setConfig (remoteConfig (fromJust (lookupName c)) "readonly") (boolConfig True)
return c'
_ -> do
external <- newExternal externaltype u c' gc

View file

@ -183,7 +183,7 @@ unsupportedUrl = giveup "using non-ssh remote repo url with gcrypt is not suppor
gCryptSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c
where
remotename = fromJust (M.lookup "name" c)
remotename = fromJust (lookupName c)
go Nothing = giveup "Specify gitrepo="
go (Just gitrepo) = do
(c', _encsetup) <- encryptionSetup c gc

View file

@ -32,6 +32,7 @@ import qualified Annex.Content
import qualified Annex.BranchState
import qualified Annex.Branch
import qualified Annex.Url as Url
import qualified Annex.SpecialRemote.Config as SpecialRemote
import Utility.Tmp
import Config
import Config.Cost
@ -120,7 +121,7 @@ gitSetup (Enable _) (Just u) _ c _ = do
inRepo $ Git.Command.run
[ Param "remote"
, Param "add"
, Param $ fromMaybe (giveup "no name") (M.lookup "name" c)
, Param $ fromMaybe (giveup "no name") (SpecialRemote.lookupName c)
, Param $ fromMaybe (giveup "no location") (M.lookup "location" c)
]
return (c, u)

View file

@ -157,7 +157,7 @@ mySetup _ mu _ c gc = do
return (c'', u)
where
url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)
remotename = fromJust (M.lookup "name" c)
remotename = fromJust (lookupName c)
data LFSHandle = LFSHandle
{ downloadEndpoint :: Maybe LFS.Endpoint

View file

@ -104,7 +104,7 @@ glacierSetup' ss u mcreds c gc = do
gitConfigSpecialRemote u fullconfig [("glacier", "true")]
return (fullconfig, u)
where
remotename = fromJust (M.lookup "name" c)
remotename = fromJust (lookupName c)
defvault = remotename ++ "-" ++ fromUUID u
defaults = M.fromList
[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.Glacier)

View file

@ -30,6 +30,7 @@ module Remote.Helper.Special (
specialRemoteCfg,
specialRemote,
specialRemote',
lookupName,
module X
) where

View file

@ -150,7 +150,7 @@ s3Setup' ss u mcreds c gc
| configIA c = archiveorg
| otherwise = defaulthost
where
remotename = fromJust (M.lookup "name" c)
remotename = fromJust (lookupName c)
defbucket = remotename ++ "-" ++ fromUUID u
defaults = M.fromList
[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.S3)

View file

@ -10,7 +10,7 @@ git annex renameremote `name|uuid|desc newname`
Changes the name that is used to enable a special remote.
Normally the current name is used to identify the special remote,
Normally the current name is used to identify the special remote to rename,
but its uuid or description can also be used.
This is especially useful when an old special remote used a name, and now you

View file

@ -29,3 +29,20 @@ of the code will work as-is.
That would add overhead of an additional git-annex branch read on every
program start. That could be avoided by instead putting the equivilance in
the remote.log. Eg, "B sameas=A foo=bar ..."
----
Implementation notes:
annex-config-uuid is set for sameas remotes.
Next, need to make generating a Remote look at that.
And need to make RemoteConfig inherit encryption
settings from the sameas uuid.
Need to get enableremote working for sameas.
Deal with the per-remote state issue.
Any other things mentioned in the comments..