autoenable sameas remotes

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
+	enabled <- getenabledremotes
-	forM_ (M.toList remotemap) $ \(u, c) -> unless (u `M.member` enabled) $ do
+	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))

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. -}

Command/EnableRemote.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2013-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}

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

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) $
+	go u cfg mcu = starting "rename" (ActionItemOther Nothing) $
-		perform u cfg newname
+		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 :: UUID -> R.RemoteConfig -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> String -> CommandPerform
-perform u cfg newname = do
+perform u cfg mcu newname = do
-	let namefield = case M.lookup sameasNameField cfg of
+	let (namefield, cu) = case mcu of
-		Just _ -> sameasNameField
+		Nothing -> (nameField, u)
-		Nothing -> nameField
+		Just (Annex.SpecialRemote.ConfigFrom u') -> (sameasNameField, u')
-	Logs.Remote.configSet u (M.insert namefield newname cfg)
+	Logs.Remote.configSet cu (M.insert namefield newname cfg)
 	
 	next $ return True

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..