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:
parent
17afefd63f
commit
97b499a4dc
3 changed files with 32 additions and 10 deletions
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue