got enableremote working for sameas
Also the assistant can enable sameas remotes, should work, but not tested.
This commit is contained in:
parent
35d7ffe128
commit
ec778888d2
5 changed files with 58 additions and 38 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
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)
|
||||
|
|
|
@ -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
|
||||
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)
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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..
|
||||
|
|
Loading…
Reference in a new issue