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:
parent
92ff30df70
commit
d1130ea04a
15 changed files with 45 additions and 14 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -30,6 +30,7 @@ module Remote.Helper.Special (
|
|||
specialRemoteCfg,
|
||||
specialRemote,
|
||||
specialRemote',
|
||||
lookupName,
|
||||
module X
|
||||
) where
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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..
|
||||
|
|
Loading…
Reference in a new issue