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

View file

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

View file

@ -27,6 +27,7 @@ import qualified Git.Command
import qualified Annex.Branch import qualified Annex.Branch
import Annex.UUID import Annex.UUID
import Logs.UUID import Logs.UUID
import Annex.SpecialRemote.Config
import Assistant.RemoteControl import Assistant.RemoteControl
import Types.Creds import Types.Creds
import Assistant.CredPairCache 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 :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html
enableSshRemote getsshdata rsyncnetsetup genericsetup u = do enableSshRemote getsshdata rsyncnetsetup genericsetup u = do
m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog 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 (Just sshdata, Just reponame) -> sshConfigurator $ do
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
@ -546,7 +547,9 @@ makeSshRepo rs sshdata
let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m) let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m)
let c' = M.insert "location" (genSshUrl sshdata) $ let c' = M.insert "location" (genSshUrl sshdata) $
M.insert "type" "git" $ 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' configSet (Remote.uuid r) c'
makeSshRepoConnection :: RepoStatus -> Annex RemoteName -> (Remote -> Annex ()) -> Handler Html makeSshRepoConnection :: RepoStatus -> Annex RemoteName -> (Remote -> Annex ()) -> Handler Html

View file

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

View file

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

View file

@ -9,6 +9,7 @@ module Command.RenameRemote where
import Command import Command
import qualified Annex.SpecialRemote import qualified Annex.SpecialRemote
import Annex.SpecialRemote.Config (nameKey, sameasNameKey)
import qualified Logs.Remote import qualified Logs.Remote
import qualified Types.Remote as R import qualified Types.Remote as R
import qualified Remote 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 :: UUID -> R.RemoteConfig -> String -> CommandPerform
perform u cfg newname = do 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 next $ return True

View file

@ -155,7 +155,7 @@ externalSetup _ mu _ c gc = do
c'' <- case M.lookup "readonly" c of c'' <- case M.lookup "readonly" c of
Just v | isTrue v == Just True -> do 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' return c'
_ -> do _ -> do
external <- newExternal externaltype u c' gc 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 :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c
where where
remotename = fromJust (M.lookup "name" c) remotename = fromJust (lookupName c)
go Nothing = giveup "Specify gitrepo=" go Nothing = giveup "Specify gitrepo="
go (Just gitrepo) = do go (Just gitrepo) = do
(c', _encsetup) <- encryptionSetup c gc (c', _encsetup) <- encryptionSetup c gc

View file

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

View file

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

View file

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

View file

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

View file

@ -150,7 +150,7 @@ s3Setup' ss u mcreds c gc
| configIA c = archiveorg | configIA c = archiveorg
| otherwise = defaulthost | otherwise = defaulthost
where where
remotename = fromJust (M.lookup "name" c) remotename = fromJust (lookupName c)
defbucket = remotename ++ "-" ++ fromUUID u defbucket = remotename ++ "-" ++ fromUUID u
defaults = M.fromList defaults = M.fromList
[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.S3) [ ("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. 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. but its uuid or description can also be used.
This is especially useful when an old special remote used a name, and now you 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 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 program start. That could be avoided by instead putting the equivilance in
the remote.log. Eg, "B sameas=A foo=bar ..." 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..