diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs index 559789f390..828eb6e775 100644 --- a/Annex/SpecialRemote.hs +++ b/Annex/SpecialRemote.hs @@ -5,27 +5,27 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module Annex.SpecialRemote where +module Annex.SpecialRemote ( + module Annex.SpecialRemote, + module Annex.SpecialRemote.Config +) where import Annex.Common import Annex.SpecialRemote.Config -import Remote (remoteTypes, remoteMap) +import Remote (remoteTypes) import Types.Remote (RemoteConfig, SetupStage(..), typename, setup) import Types.GitConfig +import Config +import Remote.List import Logs.Remote import Logs.Trust import qualified Git.Config +import qualified Types.Remote as Remote import Git.Types (RemoteName) 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. -} @@ -87,17 +87,28 @@ findType config = maybe unspecified specified $ M.lookup typeField config autoEnable :: Annex () autoEnable = do remotemap <- M.filter configured <$> readRemoteLog - enabled <- remoteMap id - forM_ (M.toList remotemap) $ \(u, c) -> unless (u `M.member` enabled) $ do + enabled <- getenabledremotes + forM_ (M.toList remotemap) $ \(cu, c) -> unless (cu `M.member` enabled) $ do + let u = case findSameasUUID c of + Just (Sameas u') -> u' + Nothing -> cu case (lookupName c, findType c) of (Just name, Right t) -> whenM (canenable u) $ do showSideAction $ "Auto enabling special remote " ++ name dummycfg <- liftIO dummyRemoteGitConfig tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case Left e -> warning (show e) - Right _ -> return () + Right (_c, _u) -> + when (cu /= u) $ + setConfig (remoteConfig c "config-uuid") (fromUUID cu) _ -> return () where configured rc = fromMaybe False $ Git.Config.isTrue =<< M.lookup autoEnableField rc canenable u = (/= DeadTrusted) <$> lookupTrust u + getenabledremotes = M.fromList + . map (\r -> (getcu r, r)) + <$> remoteList + getcu r = fromMaybe + (Remote.uuid r) + (remoteAnnexConfigUUID (Remote.gitconfig r)) diff --git a/Annex/SpecialRemote/Config.hs b/Annex/SpecialRemote/Config.hs index 022f9ebf92..73688569c6 100644 --- a/Annex/SpecialRemote/Config.hs +++ b/Annex/SpecialRemote/Config.hs @@ -14,6 +14,12 @@ import Types.UUID import qualified Data.Map as M import qualified Data.Set as S +newtype Sameas t = Sameas t + deriving (Show) + +newtype ConfigFrom t = ConfigFrom t + deriving (Show) + {- The name of a configured remote is stored in its config using this key. -} nameField :: RemoteConfigField nameField = "name" @@ -76,15 +82,18 @@ sameasInherits = S.fromList - from it. Such fields can only be set by inheritance; the RemoteConfig - cannot provide values from them. -} addSameasInherited :: M.Map UUID RemoteConfig -> RemoteConfig -> RemoteConfig -addSameasInherited m c = case toUUID <$> M.lookup sameasUUIDField c of +addSameasInherited m c = case findSameasUUID c of Nothing -> c - Just sameasuuid -> case M.lookup sameasuuid m of + Just (Sameas sameasuuid) -> case M.lookup sameasuuid m of Nothing -> c Just parentc -> M.withoutKeys c sameasInherits `M.union` M.restrictKeys parentc sameasInherits +findSameasUUID :: RemoteConfig -> Maybe (Sameas UUID) +findSameasUUID c = Sameas . toUUID <$> M.lookup sameasUUIDField c + {- Remove any fields inherited from a sameas-uuid. When storing a - RemoteConfig, those fields don't get stored, since they were already - inherited. -} diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index b1decb5bcd..8cf86ea5ed 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013-2016 Joey Hess + - Copyright 2013-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 8845d7d653..00ba46dc90 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -11,7 +11,6 @@ import qualified Data.Map as M import Command import Annex.SpecialRemote -import Annex.SpecialRemote.Config import qualified Remote import qualified Logs.Remote import qualified Types.Remote as R diff --git a/Command/RenameRemote.hs b/Command/RenameRemote.hs index fddc3fdfbf..51e0127b0d 100644 --- a/Command/RenameRemote.hs +++ b/Command/RenameRemote.hs @@ -29,7 +29,7 @@ start :: [String] -> CommandStart start (oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \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 + Nothing -> go u cfg mcu -- Support lookup by uuid or description as well as remote name, -- as a fallback when there is nothing with the name in the -- special remote log. @@ -39,17 +39,17 @@ start (oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \case m <- Logs.Remote.readRemoteLog case M.lookup u m of Nothing -> giveup "That is not a special remote." - Just cfg -> go u cfg + Just cfg -> go u cfg Nothing where - go u cfg = starting "rename" (ActionItemOther Nothing) $ - perform u cfg newname + go u cfg mcu = starting "rename" (ActionItemOther Nothing) $ + perform u cfg mcu newname 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 - let namefield = case M.lookup sameasNameField cfg of - Just _ -> sameasNameField - Nothing -> nameField - Logs.Remote.configSet u (M.insert namefield newname cfg) +perform :: UUID -> R.RemoteConfig -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> String -> CommandPerform +perform u cfg mcu newname = do + let (namefield, cu) = case mcu of + Nothing -> (nameField, u) + Just (Annex.SpecialRemote.ConfigFrom u') -> (sameasNameField, u') + Logs.Remote.configSet cu (M.insert namefield newname cfg) next $ return True diff --git a/doc/todo/support_multiple_special_remotes_with_same_uuid.mdwn b/doc/todo/support_multiple_special_remotes_with_same_uuid.mdwn index f8c42338f4..31da2addec 100644 --- a/doc/todo/support_multiple_special_remotes_with_same_uuid.mdwn +++ b/doc/todo/support_multiple_special_remotes_with_same_uuid.mdwn @@ -36,8 +36,4 @@ Implementation notes: 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..