mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

got enableremote working for sameas

Browse source 
Also the assistant can enable sameas remotes, should work, but not
tested.
This commit is contained in:
Joey Hess 2019-10-11 14:59:41 -04:00
parent 35d7ffe128
commit ec778888d2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 58 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
Annex/SpecialRemote.hs
View file

@ -21,18 +21,34 @@ import qualified Data.Map as M
import Data.Ord
newtype Sameas t = Sameas t
deriving (Show)
newtype ConfigFrom t = ConfigFrom t
deriving (Show)
{- See if there's an existing special remote with this name.
-
- Prefer remotes that are not dead when a name appears multiple times. -}
findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig))
findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig, Maybe (ConfigFrom UUID)))
findExisting name = do
t <- trustMap
headMaybe
. sortBy (comparing $ \(u, _c) -> Down $ M.lookup u t)
. sortBy (comparing $ \(u, _, _) -> Down $ M.lookup u t)
. findByName name
<$> Logs.Remote.readRemoteLog
findByName :: RemoteName -> M.Map UUID RemoteConfig -> [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))]
findByName n = map sameasuuid . filter (matching . snd) . M.toList
where
matching c = case lookupName c of
Nothing -> False
Just n'
| n' == n -> True
| otherwise -> False
sameasuuid (u, c) = case M.lookup sameasUUIDField c of
Nothing -> (u, c, Nothing)
Just u' -> (toUUID u', c, Just (ConfigFrom u))
newConfig
:: RemoteName
-> Maybe (Sameas UUID)
@ -49,15 +65,6 @@ newConfig name sameas fromuser m = case sameas of
, (sameasUUIDField, fromUUID u)
] `M.union` fromuser
findByName :: RemoteName -> M.Map UUID RemoteConfig -> [(UUID, RemoteConfig)]
findByName n = filter (matching . snd) . M.toList
where
matching c = case lookupName c of
Nothing -> False
Just n'
| n' == n -> True
| otherwise -> False
specialRemoteMap :: Annex (M.Map UUID RemoteName)
specialRemoteMap = do
m <- Logs.Remote.readRemoteLog

24
Assistant/MakeRemote.hs
View file

@ -27,6 +27,7 @@ import Creds
import Assistant.Gpg
import Utility.Gpg (KeyId)
import Types.GitConfig
import Config
import qualified Data.Map as M
@ -52,9 +53,9 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
go =<< Annex.SpecialRemote.findExisting name
where
go Nothing = setupSpecialRemote name Rsync.remote config Nothing
(Nothing, R.Init, Annex.SpecialRemote.newConfig name Nothing mempty mempty)
go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing
(Just u, R.Enable c, c)
(Nothing, R.Init, Annex.SpecialRemote.newConfig name Nothing mempty mempty) Nothing
go (Just (u, c, mcu)) = setupSpecialRemote name Rsync.remote config Nothing
(Just u, R.Enable c, c) mcu
config = M.fromList
[ (encryptionField, "shared")
, ("rsyncurl", location)
@ -83,7 +84,7 @@ initSpecialRemote name remotetype mcreds config = go 0
let fullname = if n == 0 then name else name ++ show n
Annex.SpecialRemote.findExisting fullname >>= \case
Nothing -> setupSpecialRemote fullname remotetype config mcreds
(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname Nothing mempty mempty)
(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname Nothing mempty mempty) Nothing
Just _ -> go (n + 1)
{- Enables an existing special remote. -}
@ -91,13 +92,13 @@ enableSpecialRemote :: SpecialRemoteMaker
enableSpecialRemote name remotetype mcreds config =
Annex.SpecialRemote.findExisting name >>= \case
Nothing -> error $ "Cannot find a special remote named " ++ name
Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c)
Just (u, c, mcu) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c) mcu
setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName
setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> Annex RemoteName
setupSpecialRemote = setupSpecialRemote' True
setupSpecialRemote' :: Bool -> RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName
setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) = do
setupSpecialRemote' :: Bool -> RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> Annex RemoteName
setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) mcu = do
{- Currently, only 'weak' ciphers can be generated from the
- assistant, because otherwise GnuPG may block once the entropy
- pool is drained, and as of now there's no way to tell the user
@ -105,7 +106,12 @@ setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) = do
let weakc = M.insert "highRandomQuality" "false" $ M.union config c
dummycfg <- liftIO dummyRemoteGitConfig
(c', u) <- R.setup remotetype ss mu mcreds weakc dummycfg
configSet u c'
case mcu of
Nothing ->
configSet u c'
Just (Annex.SpecialRemote.ConfigFrom cu) -> do
setConfig (remoteConfig c' "config-uuid") (fromUUID cu)
configSet cu c'
when setdesc $
whenM (isNothing . M.lookup u <$> uuidDescMap) $
describeUUID u (toUUIDDesc name)

35
Command/EnableRemote.hs
View file

@ -13,7 +13,7 @@ import qualified Logs.Remote
import qualified Types.Remote as R
import qualified Git
import qualified Git.Types as Git
import qualified Annex.SpecialRemote
import qualified Annex.SpecialRemote as SpecialRemote
import qualified Remote
import qualified Types.Remote as Remote
import qualified Remote.Git
@ -40,7 +40,7 @@ start (name:rest) = go =<< filter matchingname <$> Annex.getGitRemotes
where
matchingname r = Git.remoteName r == Just name
go [] = startSpecialRemote name (Logs.Remote.keyValToConfig rest)
=<< Annex.SpecialRemote.findExisting name
=<< SpecialRemote.findExisting name
go (r:_) = do
-- This could be either a normal git remote or a special
-- remote that has an url (eg gcrypt).
@ -62,32 +62,37 @@ startNormalRemote name restparams r
| otherwise = giveup $
"That is a normal git remote; passing these parameters does not make sense: " ++ unwords restparams
startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig) -> CommandStart
startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID)) -> CommandStart
startSpecialRemote name config Nothing = do
m <- Annex.SpecialRemote.specialRemoteMap
m <- SpecialRemote.specialRemoteMap
confm <- Logs.Remote.readRemoteLog
Remote.nameToUUID' name >>= \case
Right u | u `M.member` m ->
startSpecialRemote name config $
Just (u, fromMaybe M.empty (M.lookup u confm))
Just (u, fromMaybe M.empty (M.lookup u confm), Nothing)
_ -> unknownNameError "Unknown remote name."
startSpecialRemote name config (Just (u, c)) =
startSpecialRemote name config (Just (u, c, mcu)) =
starting "enableremote" (ActionItemOther (Just name)) $ do
let fullconfig = config `M.union` c
t <- either giveup return (Annex.SpecialRemote.findType fullconfig)
t <- either giveup return (SpecialRemote.findType fullconfig)
gc <- maybe (liftIO dummyRemoteGitConfig)
(return . Remote.gitconfig)
=<< Remote.byUUID u
performSpecialRemote t u c fullconfig gc
performSpecialRemote t u c fullconfig gc mcu
performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform
performSpecialRemote t u oldc c gc = do
performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandPerform
performSpecialRemote t u oldc c gc mcu = do
(c', u') <- R.setup t (R.Enable oldc) (Just u) Nothing c gc
next $ cleanupSpecialRemote u' c'
next $ cleanupSpecialRemote u' c' mcu
cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup
cleanupSpecialRemote u c = do
Logs.Remote.configSet u c
cleanupSpecialRemote :: UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandCleanup
cleanupSpecialRemote u c mcu = do
case mcu of
Nothing ->
Logs.Remote.configSet u c
Just (SpecialRemote.ConfigFrom cu) -> do
setConfig (remoteConfig c "config-uuid") (fromUUID cu)
Logs.Remote.configSet cu c
Remote.byUUID u >>= \case
Nothing -> noop
Just r -> do
@ -97,7 +102,7 @@ cleanupSpecialRemote u c = do
unknownNameError :: String -> Annex a
unknownNameError prefix = do
m <- Annex.SpecialRemote.specialRemoteMap
m <- SpecialRemote.specialRemoteMap
descm <- M.unionWith Remote.addName
<$> uuidDescMap
<*> pure (M.map toUUIDDesc m)

2
Command/RenameRemote.hs
View file

@ -27,7 +27,7 @@ seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \case
Just (u, cfg) -> Annex.SpecialRemote.findExisting newname >>= \case
Just (u, cfg, mcu) -> Annex.SpecialRemote.findExisting newname >>= \case
Just _ -> giveup $ "The name " ++ newname ++ " is already used by a special remote."
Nothing -> go u cfg
-- Support lookup by uuid or description as well as remote name,

6
doc/todo/support_multiple_special_remotes_with_same_uuid.mdwn
View file

@ -34,8 +34,10 @@ the remote.log. Eg, "B sameas=A foo=bar ..."
Implementation notes:
Need to get enableremote working for sameas.
Deal with the per-remote state issue.
renameremote will probably not work
Annex.InitRemote.autoEnable does not work right for sameas.
Any other things mentioned in the comments..