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.
This commit is contained in:
Joey Hess 2019-10-10 12:32:05 -04:00
parent 17afefd63f
commit 97b499a4dc
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 32 additions and 10 deletions

View file

@ -1,6 +1,6 @@
{- git-annex special remote configuration {- 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. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -19,6 +19,8 @@ import Git.Types (RemoteName)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Ord import Data.Ord
newtype Sameas t = Sameas t
{- See if there's an existing special remote with this name. {- See if there's an existing special remote with this name.
- -
- Prefer remotes that are not dead when a name appears multiple times. -} - Prefer remotes that are not dead when a name appears multiple times. -}
@ -30,13 +32,17 @@ findExisting name = do
. findByName name . findByName name
<$> Logs.Remote.readRemoteLog <$> Logs.Remote.readRemoteLog
newConfig :: RemoteName -> RemoteConfig newConfig :: RemoteName -> Maybe (Sameas UUID) -> RemoteConfig
newConfig = M.singleton nameKey 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 :: RemoteName -> M.Map UUID RemoteConfig -> [(UUID, RemoteConfig)]
findByName n = filter (matching . snd) . M.toList findByName n = filter (matching . snd) . M.toList
where where
matching c = case M.lookup nameKey c of matching c = case lookupName c of
Nothing -> False Nothing -> False
Just n' Just n'
| n' == n -> True | n' == n -> True
@ -47,11 +53,14 @@ specialRemoteMap = do
m <- Logs.Remote.readRemoteLog m <- Logs.Remote.readRemoteLog
return $ M.fromList $ mapMaybe go (M.toList m) return $ M.fromList $ mapMaybe go (M.toList m)
where where
go (u, c) = case M.lookup nameKey c of go (u, c) = case lookupName c of
Nothing -> Nothing Nothing -> Nothing
Just n -> Just (u, n) 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 :: RemoteConfig -> Either String RemoteType
findType config = maybe unspecified specified $ M.lookup typeKey config findType config = maybe unspecified specified $ M.lookup typeKey config
where where
@ -65,6 +74,15 @@ findType config = maybe unspecified specified $ M.lookup typeKey config
nameKey :: RemoteConfigKey nameKey :: RemoteConfigKey
nameKey = "name" 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. -} {- The type of a remote is stored in its config using this key. -}
typeKey :: RemoteConfigKey typeKey :: RemoteConfigKey
typeKey = "type" typeKey = "type"
@ -77,7 +95,7 @@ autoEnable = do
remotemap <- M.filter configured <$> readRemoteLog remotemap <- M.filter configured <$> readRemoteLog
enabled <- remoteMap id enabled <- remoteMap id
forM_ (M.toList remotemap) $ \(u, c) -> unless (u `M.member` enabled) $ do 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 (Just name, Right t) -> whenM (canenable u) $ do
showSideAction $ "Auto enabling special remote " ++ name showSideAction $ "Auto enabling special remote " ++ name
dummycfg <- liftIO dummyRemoteGitConfig dummycfg <- liftIO dummyRemoteGitConfig

View file

@ -51,7 +51,7 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
go =<< Annex.SpecialRemote.findExisting name go =<< Annex.SpecialRemote.findExisting name
where where
go Nothing = setupSpecialRemote name Rsync.remote config Nothing 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 go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing
(Just u, R.Enable c, c) (Just u, R.Enable c, c)
config = M.fromList 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 let fullname = if n == 0 then name else name ++ show n
Annex.SpecialRemote.findExisting fullname >>= \case Annex.SpecialRemote.findExisting fullname >>= \case
Nothing -> setupSpecialRemote fullname remotetype config mcreds 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) Just _ -> go (n + 1)
{- Enables an existing special remote. -} {- Enables an existing special remote. -}

View file

@ -53,7 +53,11 @@ start o (name:ws) = ifM (isJust <$> findExisting name)
ifM (isJust <$> Remote.byNameOnly name) ifM (isJust <$> Remote.byNameOnly name)
( giveup $ "There is already a remote named \"" ++ name ++ "\"" ( giveup $ "There is already a remote named \"" ++ name ++ "\""
, do , 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) t <- either giveup return (findType config)
starting "initremote" (ActionItemOther (Just name)) $ starting "initremote" (ActionItemOther (Just name)) $
perform t name $ M.union config c perform t name $ M.union config c