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

web special remote is no longer a singleton

Browse source 
Allow initremote of additional special remotes with type=web, in addition
to the default web special remote.

When --sameas=web is used, these provide additional names for the web
special remote, and may also have their own additional configuration
(once there is any for the web special remote) and cost.

Sponsored-by: Dartmouth College's DANDI project
This commit is contained in:
Joey Hess 2023-01-09 15:49:20 -04:00
parent 60f7cfc96e
commit 8d06930c88
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
7 changed files with 102 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

32
Remote/Web.hs
View file

@ -1,6 +1,6 @@
{- Web remote.
-
- Copyright 2011-2021 Joey Hess <id@joeyh.name>
- Copyright 2011-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -9,6 +9,7 @@ module Remote.Web (remote, getWebUrls) where
import Annex.Common
import Types.Remote
import Remote.Helper.Special
import Remote.Helper.ExportImport
import qualified Git
import qualified Git.Construct
@ -22,6 +23,7 @@ import Utility.Metered
import qualified Annex.Url as Url
import Annex.YoutubeDl
import Annex.SpecialRemote.Config
import Types.Creds
remote :: RemoteType
remote = RemoteType
@ -29,26 +31,33 @@ remote = RemoteType
, enumerate = list
, generate = gen
, configParser = mkRemoteConfigParser []
, setup = error "not supported"
, setup = setupInstance
, exportSupported = exportUnsupported
, importSupported = importUnsupported
, thirdPartyPopulated = False
}
-- There is only one web remote, and it always exists.
-- The web remote always exists.
-- (If the web should cease to exist, remove this module and redistribute
-- a new release to the survivors by carrier pigeon.)
--
-- There may also be other instances of the web remote, which can be
-- limited to accessing particular urls, and have different costs.
list :: Bool -> Annex [Git.Repo]
list _autoinit = do
r <- liftIO $ Git.Construct.remoteNamed "web" (pure Git.Construct.fromUnknown)
return [r]
others <- findSpecialRemotes "web"
-- List the main one last, this makes its name be used instead
-- of the other names when git-annex is referring to content on the
-- web.
return (others++[r])
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
gen r _ rc gc rs = do
gen r u rc gc rs = do
c <- parsedRemoteConfig remote rc
cst <- remoteCost gc expensiveRemoteCost
return $ Just Remote
{ uuid = webUUID
{ uuid = if u == NoUUID then webUUID else u
, cost = cst
, name = Git.repoDescribe r
, storeKey = uploadKey
@ -77,11 +86,20 @@ gen r _ rc gc rs = do
, remotetype = remote
, mkUnavailable = return Nothing
, getInfo = return []
, claimUrl = Nothing -- implicitly claims all urls
-- claimingUrl makes the web special remote claim
-- urls that are not claimed by other remotes,
-- so no need to claim anything here.
, claimUrl = Nothing
, checkUrl = Nothing
, remoteStateHandle = rs
}
setupInstance :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
setupInstance ss mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
gitConfigSpecialRemote u c [("web", "true")]
return (c, u)
downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
downloadKey key _af dest p vc = go =<< getWebUrls key
where