Merge branch 'master' into git-remote-annex
This commit is contained in:
Joey Hess
commit
ff5193c6ad
137 changed files with 2031 additions and 325 deletions
|
|
@ -348,7 +348,7 @@ listImportableContentsM serial adir c = adbfind >>= \case
|
|||
mk _ = Nothing
|
||||
|
||||
-- This does not guard against every possible race. As long as the adb
|
||||
-- connection is resonably fast, it's probably as good as
|
||||
-- connection is reasonably fast, it's probably as good as
|
||||
-- git's handling of similar situations with files being modified while
|
||||
-- it's updating the working tree for a merge.
|
||||
retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
||||
|
|
|
|||
|
|
@ -413,7 +413,7 @@ mkContentIdentifier (IgnoreInodes ii) f st =
|
|||
|
||||
-- Since ignoreinodes can be changed by enableremote, and since previous
|
||||
-- versions of git-annex ignored inodes by default, treat two content
|
||||
-- idenfiers as the same if they differ only by one having the inode
|
||||
-- identifiers as the same if they differ only by one having the inode
|
||||
-- ignored.
|
||||
guardSameContentIdentifiers :: a -> [ContentIdentifier] -> Maybe ContentIdentifier -> a
|
||||
guardSameContentIdentifiers _ _ Nothing = giveup "file not found"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- External special remote interface.
|
||||
-
|
||||
- Copyright 2013-2022 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
|
@ -9,7 +9,7 @@
|
|||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Remote.External (remote) where
|
||||
module Remote.External where
|
||||
|
||||
import Remote.External.Types
|
||||
import Remote.External.AsyncExtension
|
||||
|
|
@ -48,10 +48,10 @@ remote :: RemoteType
|
|||
remote = specialRemoteType $ RemoteType
|
||||
{ typename = "external"
|
||||
, enumerate = const (findSpecialRemotes "externaltype")
|
||||
, generate = gen
|
||||
, configParser = remoteConfigParser
|
||||
, setup = externalSetup
|
||||
, exportSupported = checkExportSupported
|
||||
, generate = gen remote Nothing
|
||||
, configParser = remoteConfigParser Nothing
|
||||
, setup = externalSetup Nothing Nothing
|
||||
, exportSupported = checkExportSupported Nothing
|
||||
, importSupported = importUnsupported
|
||||
, thirdPartyPopulated = False
|
||||
}
|
||||
|
|
@ -62,15 +62,15 @@ externaltypeField = Accepted "externaltype"
|
|||
readonlyField :: RemoteConfigField
|
||||
readonlyField = Accepted "readonly"
|
||||
|
||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
|
||||
gen r u rc gc rs
|
||||
gen :: RemoteType -> Maybe ExternalProgram -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
|
||||
gen rt externalprogram r u rc gc rs
|
||||
-- readonly mode only downloads urls; does not use external program
|
||||
| externaltype == "readonly" = do
|
||||
| externalprogram' == ExternalType "readonly" = do
|
||||
c <- parsedRemoteConfig remote rc
|
||||
cst <- remoteCost gc c expensiveRemoteCost
|
||||
let rmt = mk c cst (pure GloballyAvailable)
|
||||
Nothing
|
||||
(externalInfo externaltype)
|
||||
(externalInfo externalprogram')
|
||||
Nothing
|
||||
Nothing
|
||||
exportUnsupported
|
||||
|
|
@ -83,7 +83,7 @@ gen r u rc gc rs
|
|||
rmt
|
||||
| otherwise = do
|
||||
c <- parsedRemoteConfig remote rc
|
||||
external <- newExternal externaltype (Just u) c (Just gc)
|
||||
external <- newExternal externalprogram' (Just u) c (Just gc)
|
||||
(Git.remoteName r) (Just rs)
|
||||
Annex.addCleanupAction (RemoteCleanup u) $ stopExternal external
|
||||
cst <- getCost external r gc c
|
||||
|
|
@ -150,21 +150,29 @@ gen r u rc gc rs
|
|||
, appendonly = False
|
||||
, untrustworthy = False
|
||||
, availability = avail
|
||||
, remotetype = remote
|
||||
, remotetype = rt
|
||||
{ exportSupported = cheapexportsupported }
|
||||
, mkUnavailable = gen r u rc
|
||||
(gc { remoteAnnexExternalType = Just "!dne!" }) rs
|
||||
, mkUnavailable =
|
||||
let dneprogram = case externalprogram of
|
||||
Just (ExternalCommand _ _) -> Just (ExternalType "!dne!")
|
||||
_ -> Nothing
|
||||
dnegc = gc { remoteAnnexExternalType = Just "!dne!" }
|
||||
in gen rt dneprogram r u rc dnegc rs
|
||||
, getInfo = togetinfo
|
||||
, claimUrl = toclaimurl
|
||||
, checkUrl = tocheckurl
|
||||
, remoteStateHandle = rs
|
||||
}
|
||||
externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc)
|
||||
externalprogram' = case externalprogram of
|
||||
Just p -> p
|
||||
Nothing -> ExternalType $
|
||||
fromMaybe (giveup "missing externaltype")
|
||||
(remoteAnnexExternalType gc)
|
||||
|
||||
externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
|
||||
externalSetup _ mu _ c gc = do
|
||||
externalSetup :: Maybe ExternalProgram -> Maybe (String, String) -> SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
|
||||
externalSetup externalprogram setgitconfig _ mu _ c gc = do
|
||||
u <- maybe (liftIO genUUID) return mu
|
||||
pc <- either giveup return $ parseRemoteConfig c lenientRemoteConfigParser
|
||||
pc <- either giveup return $ parseRemoteConfig c (lenientRemoteConfigParser externalprogram)
|
||||
let readonlyconfig = getRemoteConfigValue readonlyField pc == Just True
|
||||
let externaltype = if readonlyconfig
|
||||
then "readonly"
|
||||
|
|
@ -181,8 +189,9 @@ externalSetup _ mu _ c gc = do
|
|||
setConfig (remoteAnnexConfig (fromJust (lookupName c)) "readonly") (boolConfig True)
|
||||
return c'
|
||||
else do
|
||||
pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser
|
||||
external <- newExternal externaltype (Just u) pc' (Just gc) Nothing Nothing
|
||||
pc' <- either giveup return $ parseRemoteConfig c' (lenientRemoteConfigParser externalprogram)
|
||||
let p = fromMaybe (ExternalType externaltype) externalprogram
|
||||
external <- newExternal p (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.
|
||||
|
|
@ -200,17 +209,20 @@ externalSetup _ mu _ c gc = do
|
|||
liftIO . atomically . readTMVar . externalConfigChanges
|
||||
return (changes c')
|
||||
|
||||
gitConfigSpecialRemote u c'' [("externaltype", externaltype)]
|
||||
gitConfigSpecialRemote u c''
|
||||
[ fromMaybe ("externaltype", externaltype) setgitconfig ]
|
||||
return (M.delete readonlyField c'', u)
|
||||
|
||||
checkExportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool
|
||||
checkExportSupported c gc = do
|
||||
checkExportSupported :: Maybe ExternalProgram -> ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool
|
||||
checkExportSupported Nothing c gc = do
|
||||
let externaltype = fromMaybe (giveup "Specify externaltype=") $
|
||||
remoteAnnexExternalType gc <|> getRemoteConfigValue externaltypeField c
|
||||
if externaltype == "readonly"
|
||||
then return False
|
||||
else checkExportSupported'
|
||||
=<< newExternal externaltype Nothing c (Just gc) Nothing Nothing
|
||||
else checkExportSupported (Just (ExternalType externaltype)) c gc
|
||||
checkExportSupported (Just externalprogram) c gc =
|
||||
checkExportSupported'
|
||||
=<< newExternal externalprogram Nothing c (Just gc) Nothing Nothing
|
||||
|
||||
checkExportSupported' :: External -> Annex Bool
|
||||
checkExportSupported' external = go `catchNonAsync` (const (return False))
|
||||
|
|
@ -658,7 +670,7 @@ startExternal' external = do
|
|||
n <- succ <$> readTVar (externalLastPid external)
|
||||
writeTVar (externalLastPid external) n
|
||||
return n
|
||||
AddonProcess.startExternalAddonProcess basecmd pid >>= \case
|
||||
AddonProcess.startExternalAddonProcess externalcmd externalparams pid >>= \case
|
||||
Left (AddonProcess.ProgramFailure err) -> do
|
||||
unusable err
|
||||
Left (AddonProcess.ProgramNotInstalled err) ->
|
||||
|
|
@ -666,8 +678,8 @@ startExternal' external = do
|
|||
(Just rname, Just True) -> unusable $ unlines
|
||||
[ err
|
||||
, "This remote has annex-readonly=true, and previous versions of"
|
||||
, "git-annex would tried to download from it without"
|
||||
, "installing " ++ basecmd ++ ". If you want that, you need to set:"
|
||||
, "git-annex would try to download from it without"
|
||||
, "installing " ++ externalcmd ++ ". If you want that, you need to set:"
|
||||
, "git config remote." ++ rname ++ ".annex-externaltype readonly"
|
||||
]
|
||||
_ -> unusable err
|
||||
|
|
@ -686,7 +698,9 @@ startExternal' external = do
|
|||
extensions <- startproto st
|
||||
return (st, extensions)
|
||||
where
|
||||
basecmd = "git-annex-remote-" ++ externalType external
|
||||
(externalcmd, externalparams) = case externalProgram external of
|
||||
ExternalType t -> ("git-annex-remote-" ++ t, [])
|
||||
ExternalCommand c ps -> (c, ps)
|
||||
startproto st = do
|
||||
receiveMessage st external
|
||||
(const Nothing)
|
||||
|
|
@ -707,13 +721,13 @@ startExternal' external = do
|
|||
case filter (`notElem` fromExtensionList supportedExtensionList) (fromExtensionList exwanted) of
|
||||
[] -> return exwanted
|
||||
exrest -> unusable $ unwords $
|
||||
[ basecmd
|
||||
[ externalcmd
|
||||
, "requested extensions that this version of git-annex does not support:"
|
||||
] ++ exrest
|
||||
|
||||
unusable msg = do
|
||||
warning (UnquotedString msg)
|
||||
giveup ("unable to use external special remote " ++ basecmd)
|
||||
giveup ("unable to use external special remote " ++ externalcmd)
|
||||
|
||||
stopExternal :: External -> Annex ()
|
||||
stopExternal external = liftIO $ do
|
||||
|
|
@ -825,12 +839,13 @@ getWebUrls key = filter supported <$> getUrls key
|
|||
where
|
||||
supported u = snd (getDownloader u) == WebDownloader
|
||||
|
||||
externalInfo :: ExternalType -> Annex [(String, String)]
|
||||
externalInfo et = return [("externaltype", et)]
|
||||
externalInfo :: ExternalProgram -> Annex [(String, String)]
|
||||
externalInfo (ExternalType et) = return [("externaltype", et)]
|
||||
externalInfo (ExternalCommand _ _) = return []
|
||||
|
||||
getInfoM :: External -> Annex [(String, String)]
|
||||
getInfoM external = (++)
|
||||
<$> externalInfo (externalType external)
|
||||
<$> externalInfo (externalProgram external)
|
||||
<*> handleRequest external GETINFO Nothing (collect [])
|
||||
where
|
||||
collect l req = case req of
|
||||
|
|
@ -847,34 +862,41 @@ getInfoM external = (++)
|
|||
|
||||
{- All unknown configs are passed through in case the external program
|
||||
- uses them. -}
|
||||
lenientRemoteConfigParser :: RemoteConfigParser
|
||||
lenientRemoteConfigParser =
|
||||
addRemoteConfigParser specialRemoteConfigParsers baseRemoteConfigParser
|
||||
lenientRemoteConfigParser :: Maybe ExternalProgram -> RemoteConfigParser
|
||||
lenientRemoteConfigParser externalprogram =
|
||||
addRemoteConfigParser specialRemoteConfigParsers (baseRemoteConfigParser externalprogram)
|
||||
|
||||
baseRemoteConfigParser :: RemoteConfigParser
|
||||
baseRemoteConfigParser = RemoteConfigParser
|
||||
{ remoteConfigFieldParsers =
|
||||
[ optionalStringParser externaltypeField
|
||||
(FieldDesc "type of external special remote to use")
|
||||
, trueFalseParser readonlyField (Just False)
|
||||
(FieldDesc "enable readonly mode")
|
||||
]
|
||||
baseRemoteConfigParser :: Maybe ExternalProgram -> RemoteConfigParser
|
||||
baseRemoteConfigParser externalprogram = RemoteConfigParser
|
||||
{ remoteConfigFieldParsers = if isJust extcommand
|
||||
then []
|
||||
else
|
||||
[ optionalStringParser externaltypeField
|
||||
(FieldDesc "type of external special remote to use")
|
||||
, trueFalseParser readonlyField (Just False)
|
||||
(FieldDesc "enable readonly mode")
|
||||
]
|
||||
, remoteConfigRestPassthrough = Just
|
||||
( const True
|
||||
, [("*", FieldDesc "all other parameters are passed to external special remote program")]
|
||||
, [("*", FieldDesc $ "all other parameters are passed to " ++ fromMaybe "external special remote program" extcommand)]
|
||||
)
|
||||
}
|
||||
where
|
||||
extcommand = case externalprogram of
|
||||
Just (ExternalCommand c _) -> Just c
|
||||
_ -> Nothing
|
||||
|
||||
{- When the remote supports LISTCONFIGS, only accept the ones it listed.
|
||||
- When it does not, accept all configs. -}
|
||||
strictRemoteConfigParser :: External -> Annex RemoteConfigParser
|
||||
strictRemoteConfigParser external = listConfigs external >>= \case
|
||||
Nothing -> return lenientRemoteConfigParser
|
||||
Nothing -> return lcp
|
||||
Just l -> do
|
||||
let s = S.fromList (map fst l)
|
||||
let listed f = S.member (fromProposedAccepted f) s
|
||||
return $ lenientRemoteConfigParser
|
||||
{ remoteConfigRestPassthrough = Just (listed, l) }
|
||||
return $ lcp { remoteConfigRestPassthrough = Just (listed, l) }
|
||||
where
|
||||
lcp = lenientRemoteConfigParser (Just (externalProgram external))
|
||||
|
||||
listConfigs :: External -> Annex (Maybe [(Setting, FieldDesc)])
|
||||
listConfigs external = handleRequest external LISTCONFIGS Nothing (collect [])
|
||||
|
|
@ -886,20 +908,21 @@ listConfigs external = handleRequest external LISTCONFIGS Nothing (collect [])
|
|||
UNSUPPORTED_REQUEST -> result Nothing
|
||||
_ -> Nothing
|
||||
|
||||
remoteConfigParser :: RemoteConfig -> Annex RemoteConfigParser
|
||||
remoteConfigParser c
|
||||
remoteConfigParser :: Maybe ExternalProgram -> RemoteConfig -> Annex RemoteConfigParser
|
||||
remoteConfigParser externalprogram c
|
||||
-- No need to start the external when there is no config to parse,
|
||||
-- or when everything in the config was already accepted; in those
|
||||
-- cases the lenient parser will do the same thing as the strict
|
||||
-- parser.
|
||||
| M.null (M.filter isproposed c) = return lenientRemoteConfigParser
|
||||
| otherwise = case parseRemoteConfig c baseRemoteConfigParser of
|
||||
Left _ -> return lenientRemoteConfigParser
|
||||
| M.null (M.filter isproposed c) = return (lenientRemoteConfigParser externalprogram)
|
||||
| otherwise = case parseRemoteConfig c (baseRemoteConfigParser externalprogram) of
|
||||
Left _ -> return (lenientRemoteConfigParser externalprogram)
|
||||
Right pc -> case (getRemoteConfigValue externaltypeField pc, getRemoteConfigValue readonlyField pc) of
|
||||
(Nothing, _) -> return lenientRemoteConfigParser
|
||||
(_, Just True) -> return lenientRemoteConfigParser
|
||||
(Nothing, _) -> return (lenientRemoteConfigParser externalprogram)
|
||||
(_, Just True) -> return (lenientRemoteConfigParser externalprogram)
|
||||
(Just externaltype, _) -> do
|
||||
external <- newExternal externaltype Nothing pc Nothing Nothing Nothing
|
||||
let p = fromMaybe (ExternalType externaltype) externalprogram
|
||||
external <- newExternal p Nothing pc Nothing Nothing Nothing
|
||||
strictRemoteConfigParser external
|
||||
where
|
||||
isproposed (Accepted _) = False
|
||||
|
|
|
|||
19
Remote/External/Types.hs
vendored
19
Remote/External/Types.hs
vendored
|
|
@ -1,6 +1,6 @@
|
|||
{- External special remote data types.
|
||||
-
|
||||
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
|
@ -12,7 +12,7 @@
|
|||
module Remote.External.Types (
|
||||
External(..),
|
||||
newExternal,
|
||||
ExternalType,
|
||||
ExternalProgram(..),
|
||||
ExternalState(..),
|
||||
PrepareStatus(..),
|
||||
ExtensionList(..),
|
||||
|
|
@ -64,7 +64,7 @@ import Text.Read
|
|||
import qualified Data.ByteString.Short as S (fromShort)
|
||||
|
||||
data External = External
|
||||
{ externalType :: ExternalType
|
||||
{ externalProgram :: ExternalProgram
|
||||
, externalUUID :: Maybe UUID
|
||||
, externalState :: TVar [ExternalState]
|
||||
-- ^ Contains states for external special remote processes
|
||||
|
|
@ -77,9 +77,9 @@ data External = External
|
|||
, externalAsync :: TMVar ExternalAsync
|
||||
}
|
||||
|
||||
newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External
|
||||
newExternal externaltype u c gc rn rs = liftIO $ External
|
||||
<$> pure externaltype
|
||||
newExternal :: ExternalProgram -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External
|
||||
newExternal p u c gc rn rs = liftIO $ External
|
||||
<$> pure p
|
||||
<*> pure u
|
||||
<*> atomically (newTVar [])
|
||||
<*> atomically (newTVar 0)
|
||||
|
|
@ -89,7 +89,12 @@ newExternal externaltype u c gc rn rs = liftIO $ External
|
|||
<*> pure rs
|
||||
<*> atomically (newTMVar UncheckedExternalAsync)
|
||||
|
||||
type ExternalType = String
|
||||
data ExternalProgram
|
||||
= ExternalType String
|
||||
-- ^ "git-annex-remote-" is prepended to this to get the program
|
||||
| ExternalCommand String [CommandParam]
|
||||
-- ^ to use a program with a different name, and parameters
|
||||
deriving (Show, Eq)
|
||||
|
||||
data ExternalState = ExternalState
|
||||
{ externalSend :: forall t. (Proto.Sendable t, ToAsyncWrapped t) => t -> IO ()
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ import qualified Remote.Ddar
|
|||
import qualified Remote.GitLFS
|
||||
import qualified Remote.HttpAlso
|
||||
import qualified Remote.Borg
|
||||
import qualified Remote.Rclone
|
||||
import qualified Remote.Hook
|
||||
import qualified Remote.External
|
||||
|
||||
|
|
@ -59,6 +60,7 @@ remoteTypes = map adjustExportImportRemoteType
|
|||
, Remote.GitLFS.remote
|
||||
, Remote.HttpAlso.remote
|
||||
, Remote.Borg.remote
|
||||
, Remote.Rclone.remote
|
||||
, Remote.Hook.remote
|
||||
, Remote.External.remote
|
||||
]
|
||||
|
|
|
|||
31
Remote/Rclone.hs
Normal file
31
Remote/Rclone.hs
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
{- Rclone special remote, using "rclone gitannex"
|
||||
-
|
||||
- Copyright 2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Remote.Rclone (remote) where
|
||||
|
||||
import Types
|
||||
import Types.Remote
|
||||
import Remote.Helper.Special
|
||||
import Remote.Helper.ExportImport
|
||||
import Utility.SafeCommand
|
||||
import qualified Remote.External as External
|
||||
import Remote.External.Types
|
||||
|
||||
remote :: RemoteType
|
||||
remote = specialRemoteType $ RemoteType
|
||||
{ typename = "rclone"
|
||||
, enumerate = const (findSpecialRemotes "rclone")
|
||||
, generate = External.gen remote p
|
||||
, configParser = External.remoteConfigParser p
|
||||
, setup = External.externalSetup p setgitconfig
|
||||
, exportSupported = External.checkExportSupported p
|
||||
, importSupported = importUnsupported
|
||||
, thirdPartyPopulated = False
|
||||
}
|
||||
where
|
||||
p = Just $ ExternalCommand "rclone" [Param "gitannex"]
|
||||
setgitconfig = Just ("rclone", "true")
|
||||
Loading…
Add table
Add a link
Reference in a new issue