From 97b499a4dcb8e2e32956601d4e2c1341d0d414e4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 10 Oct 2019 12:32:05 -0400
Subject: [PATCH] use sameas-name and sameas-uuid for sameas remotes

initremote --sameas=remotename sets sameas-name and sameas-uuid

Using sameas-name rather than name prevents old git-annex initremote
from enabling a sameas remote by name, since it would not handle it
correctly.
---
 Annex/SpecialRemote.hs  | 32 +++++++++++++++++++++++++-------
 Assistant/MakeRemote.hs |  4 ++--
 Command/InitRemote.hs   |  6 +++++-
 3 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs
index ca8078c90f..73e343f279 100644
--- a/Annex/SpecialRemote.hs
+++ b/Annex/SpecialRemote.hs
@@ -1,6 +1,6 @@
 {- git-annex special remote configuration
  -
- - Copyright 2011-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -19,6 +19,8 @@ import Git.Types (RemoteName)
 import qualified Data.Map as M
 import Data.Ord
 
+newtype Sameas t = Sameas t
+
 {- See if there's an existing special remote with this name.
  -
  - Prefer remotes that are not dead when a name appears multiple times. -}
@@ -30,13 +32,17 @@ findExisting name = do
 		. findByName name
 		<$> Logs.Remote.readRemoteLog
 
-newConfig :: RemoteName -> RemoteConfig
-newConfig = M.singleton nameKey
+newConfig :: RemoteName -> Maybe (Sameas UUID) -> RemoteConfig
+newConfig name Nothing = M.singleton nameKey name
+newConfig name (Just (Sameas u)) = M.fromList
+	[ (sameasNameKey, name)
+	, (sameasUUIDKey, fromUUID u)
+	]
 
 findByName :: RemoteName ->  M.Map UUID RemoteConfig -> [(UUID, RemoteConfig)]
 findByName n = filter (matching . snd) . M.toList
   where
-	matching c = case M.lookup nameKey c of
+	matching c = case lookupName c of
 		Nothing -> False
 		Just n'
 			| n' == n -> True
@@ -47,11 +53,14 @@ specialRemoteMap = do
 	m <- Logs.Remote.readRemoteLog
 	return $ M.fromList $ mapMaybe go (M.toList m)
   where
-	go (u, c) = case M.lookup nameKey c of
+	go (u, c) = case lookupName c of
 		Nothing -> Nothing
 		Just n -> Just (u, n)
 
-{- find the specified remote type -}
+lookupName :: RemoteConfig -> Maybe RemoteName
+lookupName c = M.lookup nameKey c <|> M.lookup sameasNameKey c
+
+{- find the remote type -}
 findType :: RemoteConfig -> Either String RemoteType
 findType config = maybe unspecified specified $ M.lookup typeKey config
   where
@@ -65,6 +74,15 @@ findType config = maybe unspecified specified $ M.lookup typeKey config
 nameKey :: RemoteConfigKey
 nameKey = "name"
 
+{- The name of a sameas remote is stored using this key instead. 
+ - This prevents old versions of git-annex getting confused. -}
+sameasNameKey :: RemoteConfigKey
+sameasNameKey = "sameas-name"
+
+{- The uuid that a sameas remote is the same as is stored in this key. -}
+sameasUUIDKey :: RemoteConfigKey
+sameasUUIDKey = "sameas-uuid"
+
 {- The type of a remote is stored in its config using this key. -}
 typeKey :: RemoteConfigKey
 typeKey = "type"
@@ -77,7 +95,7 @@ autoEnable = do
 	remotemap <- M.filter configured <$> readRemoteLog
 	enabled <- remoteMap id
 	forM_ (M.toList remotemap) $ \(u, c) -> unless (u `M.member` enabled) $ do
-		case (M.lookup nameKey c, findType c) of
+		case (lookupName c, findType c) of
 			(Just name, Right t) -> whenM (canenable u) $ do
 				showSideAction $ "Auto enabling special remote " ++ name
 				dummycfg <- liftIO dummyRemoteGitConfig
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 83eb40c321..d1f30aeef1 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -51,7 +51,7 @@ 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, R.Init, Annex.SpecialRemote.newConfig name Nothing)
 	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing
 		(Just u, R.Enable c, c)
 	config = M.fromList
@@ -82,7 +82,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, R.Init, Annex.SpecialRemote.newConfig fullname Nothing)
 			Just _ -> go (n + 1)
 
 {- Enables an existing special remote. -}
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index f543236982..04873b5f39 100644
--- a/Command/InitRemote.hs
+++ b/Command/InitRemote.hs
@@ -53,7 +53,11 @@ start o (name:ws) = ifM (isJust <$> findExisting name)
 		ifM (isJust <$> Remote.byNameOnly name)
 			( giveup $ "There is already a remote named \"" ++ name ++ "\""
 			, do
-				let c = newConfig name
+				sameasuuid <- maybe
+					(pure Nothing)
+					(Just . Sameas <$$> getParsed)
+					(sameas o) 
+				let c = newConfig name sameasuuid
 				t <- either giveup return (findType config)
 				starting "initremote" (ActionItemOther (Just name)) $
 					perform t name $ M.union config c