mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Added GETGITREMOTENAME to extenal special remote protocol

Browse source
This commit is contained in:
Joey Hess 2021-01-26 12:42:47 -04:00
parent 5db7c3c8b6
commit b372d962ae
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 41 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Remote/External.hs
View file

@ -81,7 +81,8 @@ gen r u rc gc rs
exportUnsupported
| otherwise = do
c <- parsedRemoteConfig remote rc
external <- newExternal externaltype (Just u) c (Just gc) (Just rs)
external <- newExternal externaltype (Just u) c (Just gc)
(Git.remoteName r) (Just rs)
Annex.addCleanupAction (RemoteCleanup u) $ stopExternal external
cst <- getCost external r gc
avail <- getAvailability external r gc
@ -184,7 +185,7 @@ externalSetup _ mu _ c gc = do
return c'
else do
pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser
external <- newExternal externaltype (Just u) pc' (Just gc) Nothing
external <- newExternal externaltype (Just u) pc' (Just gc) Nothing Nothing
-- Now that we have an external, ask it to LISTCONFIGS,
-- and re-parse the RemoteConfig strictly, so we can
-- error out if the user provided an unexpected config.
@ -212,7 +213,7 @@ checkExportSupported c gc = do
if externaltype == "readonly"
then return False
else checkExportSupported'
=<< newExternal externaltype Nothing c (Just gc) Nothing
=<< newExternal externaltype Nothing c (Just gc) Nothing Nothing
checkExportSupported' :: External -> Annex Bool
checkExportSupported' external = go `catchNonAsync` (const (return False))
@ -458,6 +459,10 @@ handleRequest' st external req mp responsehandler
Nothing -> senderror "cannot send GETUUID here"
handleRemoteRequest GETGITDIR =
send . VALUE . fromRawFilePath =<< fromRepo Git.localGitDir
handleRemoteRequest GETGITREMOTENAME =
case externalRemoteName external of
Just n -> send $ VALUE n
Nothing -> senderror "git remote name not known"
handleRemoteRequest (SETWANTED expr) = case externalUUID external of
Just u -> preferredContentSet u expr
Nothing -> senderror "cannot send SETWANTED here"
@ -896,7 +901,7 @@ remoteConfigParser c
(Nothing, _) -> return lenientRemoteConfigParser
(_, Just True) -> return lenientRemoteConfigParser
(Just externaltype, _) -> do
external <- newExternal externaltype Nothing pc Nothing Nothing
external <- newExternal externaltype Nothing pc Nothing Nothing Nothing
strictRemoteConfigParser external
where
isproposed (Accepted _) = False

15
Remote/External/Types.hs vendored
View file

@ -52,6 +52,7 @@ import Types.RemoteConfig
import Types.Export
import Types.Availability (Availability(..))
import Types.Key
import Git.Types
import Utility.Url (URLString)
import qualified Utility.SimpleProtocol as Proto
@ -69,18 +70,20 @@ data External = External
, externalLastPid :: TVar PID
, externalDefaultConfig :: ParsedRemoteConfig
, externalGitConfig :: Maybe RemoteGitConfig
, externalRemoteName :: Maybe RemoteName
, externalRemoteStateHandle :: Maybe RemoteStateHandle
, externalAsync :: TMVar ExternalAsync
}
newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteStateHandle -> Annex External
newExternal externaltype u c gc rs = liftIO $ External
newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External
newExternal externaltype u c gc rn rs = liftIO $ External
<$> pure externaltype
<*> pure u
<*> atomically (newTVar [])
<*> atomically (newTVar 0)
<*> pure c
<*> pure gc
<*> pure rn
<*> pure rs
<*> atomically (newTMVar UncheckedExternalAsync)
@ -102,7 +105,11 @@ newtype ExtensionList = ExtensionList { fromExtensionList :: [String] }
deriving (Show, Monoid, Semigroup)
supportedExtensionList :: ExtensionList
supportedExtensionList = ExtensionList ["INFO", asyncExtension]
supportedExtensionList = ExtensionList
[ "INFO"
, "GETGITREMOTENAME"
, asyncExtension
]
asyncExtension :: String
asyncExtension = "ASYNC"
@ -304,6 +311,7 @@ data RemoteRequest
| GETCREDS Setting
| GETUUID
| GETGITDIR
| GETGITREMOTENAME
| SETWANTED PreferredContentExpression
| GETWANTED
| SETSTATE Key String
@ -328,6 +336,7 @@ instance Proto.Receivable RemoteRequest where
parseCommand "GETCREDS" = Proto.parse1 GETCREDS
parseCommand "GETUUID" = Proto.parse0 GETUUID
parseCommand "GETGITDIR" = Proto.parse0 GETGITDIR
parseCommand "GETGITREMOTENAME" = Proto.parse0 GETGITREMOTENAME
parseCommand "SETWANTED" = Proto.parse1 SETWANTED
parseCommand "GETWANTED" = Proto.parse0 GETWANTED
parseCommand "SETSTATE" = Proto.parse2 SETSTATE