2014-12-08 23:14:24 +00:00
|
|
|
{- Web remote.
|
2011-07-01 19:24:07 +00:00
|
|
|
-
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
- Copyright 2011-2024 Joey Hess <id@joeyh.name>
|
2011-07-01 19:24:07 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2011-07-01 19:24:07 +00:00
|
|
|
-}
|
|
|
|
|
2015-08-17 15:35:34 +00:00
|
|
|
module Remote.Web (remote, getWebUrls) where
|
2011-07-01 19:24:07 +00:00
|
|
|
|
2016-01-20 20:36:33 +00:00
|
|
|
import Annex.Common
|
2011-07-01 19:24:07 +00:00
|
|
|
import Types.Remote
|
2023-01-09 21:16:53 +00:00
|
|
|
import Types.ProposedAccepted
|
|
|
|
import Types.Creds
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
import Types.Key
|
|
|
|
import Types.KeySource
|
2023-01-09 19:49:20 +00:00
|
|
|
import Remote.Helper.Special
|
2019-02-20 19:55:01 +00:00
|
|
|
import Remote.Helper.ExportImport
|
2011-07-01 19:24:07 +00:00
|
|
|
import qualified Git
|
2011-12-13 19:05:07 +00:00
|
|
|
import qualified Git.Construct
|
2012-01-02 18:20:20 +00:00
|
|
|
import Annex.Content
|
2021-08-18 18:49:01 +00:00
|
|
|
import Annex.Verify
|
2013-03-13 20:16:01 +00:00
|
|
|
import Config.Cost
|
2018-06-23 22:16:37 +00:00
|
|
|
import Config
|
2011-10-15 20:25:51 +00:00
|
|
|
import Logs.Web
|
2014-12-17 17:57:52 +00:00
|
|
|
import Annex.UUID
|
2013-03-28 21:03:04 +00:00
|
|
|
import Utility.Metered
|
2023-01-09 21:16:53 +00:00
|
|
|
import Utility.Glob
|
2013-09-28 18:35:21 +00:00
|
|
|
import qualified Annex.Url as Url
|
2017-11-29 19:49:05 +00:00
|
|
|
import Annex.YoutubeDl
|
fix encryption of content to gcrypt and git-lfs
Fix serious regression in gcrypt and encrypted git-lfs remotes.
Since version 7.20200202.7, git-annex incorrectly stored content
on those remotes without encrypting it.
Problem was, Remote.Git enumerates all git remotes, including git-lfs
and gcrypt. It then dispatches to those. So, Remote.List used the
RemoteConfigParser from Remote.Git, instead of from git-lfs or gcrypt,
and that parser does not know about encryption fields, so did not
include them in the ParsedRemoteConfig. (Also didn't include other
fields specific to those remotes, perhaps chunking etc also didn't
get through.)
To fix, had to move RemoteConfig parsing down into the generate methods
of each remote, rather than doing it in Remote.List.
And a consequence of that was that ParsedRemoteConfig had to change to
include the RemoteConfig that got parsed, so that testremote can
generate a new remote based on an existing remote.
(I would have rather fixed this just inside Remote.Git, but that was not
practical, at least not w/o re-doing work that Remote.List already did.
Big ugly mostly mechanical patch seemed preferable to making git-annex
slower.)
2020-02-26 21:20:56 +00:00
|
|
|
import Annex.SpecialRemote.Config
|
2023-01-10 18:58:53 +00:00
|
|
|
import Logs.Remote
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
import Logs.EquivilantKeys
|
|
|
|
import Backend
|
|
|
|
import Backend.Hash (descChecksum)
|
2023-01-10 18:58:53 +00:00
|
|
|
|
|
|
|
import qualified Data.Map as M
|
2011-07-01 19:24:07 +00:00
|
|
|
|
2011-12-31 08:11:39 +00:00
|
|
|
remote :: RemoteType
|
2017-09-07 17:45:31 +00:00
|
|
|
remote = RemoteType
|
|
|
|
{ typename = "web"
|
|
|
|
, enumerate = list
|
|
|
|
, generate = gen
|
2023-01-09 21:16:53 +00:00
|
|
|
, configParser = mkRemoteConfigParser
|
|
|
|
[ optionalStringParser urlincludeField
|
|
|
|
(FieldDesc "only use urls matching this glob")
|
|
|
|
, optionalStringParser urlexcludeField
|
|
|
|
(FieldDesc "don't use urls that match this glob")
|
|
|
|
]
|
2023-01-09 19:49:20 +00:00
|
|
|
, setup = setupInstance
|
2017-09-07 17:45:31 +00:00
|
|
|
, exportSupported = exportUnsupported
|
2019-02-20 19:55:01 +00:00
|
|
|
, importSupported = importUnsupported
|
add thirdPartyPopulated interface
This is to support, eg a borg repo as a special remote, which is
populated not by running git-annex commands, but by using borg. Then
git-annex sync lists the content of the remote, learns which files are
annex objects, and treats those as present in the remote.
So, most of the import machinery is reused, to a new purpose. While
normally importtree maintains a remote tracking branch, this does not,
because the files stored in the remote are annex object files, not
user-visible filenames. But, internally, a git tree is still generated,
of the files on the remote that are annex objects. This tree is used
by retrieveExportWithContentIdentifier, etc. As with other import/export
remotes, that the tree is recorded in the export log, and gets grafted
into the git-annex branch.
importKey changed to be able to return Nothing, to indicate when an
ImportLocation is not an annex object and so should be skipped from
being included in the tree.
It did not seem to make sense to have git-annex import do this, since
from the user's perspective, it's not like other imports. So only
git-annex sync does it.
Note that, git-annex sync does not yet download objects from such
remotes that are preferred content. importKeys is run with
content downloading disabled, to avoid getting the content of all
objects. Perhaps what's needed is for seekSyncContent to be run with these
remotes, but I don't know if it will just work (in particular, it needs
to avoid trying to transfer objects to them), so I skipped that for now.
(Untested and unused as of yet.)
This commit was sponsored by Jochen Bartl on Patreon.
2020-12-18 18:52:57 +00:00
|
|
|
, thirdPartyPopulated = False
|
2017-09-07 17:45:31 +00:00
|
|
|
}
|
2011-07-01 19:24:07 +00:00
|
|
|
|
2023-01-09 19:49:20 +00:00
|
|
|
-- The web remote always exists.
|
2011-07-01 19:24:07 +00:00
|
|
|
-- (If the web should cease to exist, remove this module and redistribute
|
|
|
|
-- a new release to the survivors by carrier pigeon.)
|
2023-01-09 19:49:20 +00:00
|
|
|
--
|
|
|
|
-- There may also be other instances of the web remote, which can be
|
|
|
|
-- limited to accessing particular urls, and have different costs.
|
2015-08-05 17:49:54 +00:00
|
|
|
list :: Bool -> Annex [Git.Repo]
|
|
|
|
list _autoinit = do
|
2015-02-12 19:33:05 +00:00
|
|
|
r <- liftIO $ Git.Construct.remoteNamed "web" (pure Git.Construct.fromUnknown)
|
2023-01-09 19:49:20 +00:00
|
|
|
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])
|
2011-07-01 19:24:07 +00:00
|
|
|
|
fix encryption of content to gcrypt and git-lfs
Fix serious regression in gcrypt and encrypted git-lfs remotes.
Since version 7.20200202.7, git-annex incorrectly stored content
on those remotes without encrypting it.
Problem was, Remote.Git enumerates all git remotes, including git-lfs
and gcrypt. It then dispatches to those. So, Remote.List used the
RemoteConfigParser from Remote.Git, instead of from git-lfs or gcrypt,
and that parser does not know about encryption fields, so did not
include them in the ParsedRemoteConfig. (Also didn't include other
fields specific to those remotes, perhaps chunking etc also didn't
get through.)
To fix, had to move RemoteConfig parsing down into the generate methods
of each remote, rather than doing it in Remote.List.
And a consequence of that was that ParsedRemoteConfig had to change to
include the RemoteConfig that got parsed, so that testremote can
generate a new remote based on an existing remote.
(I would have rather fixed this just inside Remote.Git, but that was not
practical, at least not w/o re-doing work that Remote.List already did.
Big ugly mostly mechanical patch seemed preferable to making git-annex
slower.)
2020-02-26 21:20:56 +00:00
|
|
|
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
|
2023-01-09 19:49:20 +00:00
|
|
|
gen r u rc gc rs = do
|
fix encryption of content to gcrypt and git-lfs
Fix serious regression in gcrypt and encrypted git-lfs remotes.
Since version 7.20200202.7, git-annex incorrectly stored content
on those remotes without encrypting it.
Problem was, Remote.Git enumerates all git remotes, including git-lfs
and gcrypt. It then dispatches to those. So, Remote.List used the
RemoteConfigParser from Remote.Git, instead of from git-lfs or gcrypt,
and that parser does not know about encryption fields, so did not
include them in the ParsedRemoteConfig. (Also didn't include other
fields specific to those remotes, perhaps chunking etc also didn't
get through.)
To fix, had to move RemoteConfig parsing down into the generate methods
of each remote, rather than doing it in Remote.List.
And a consequence of that was that ParsedRemoteConfig had to change to
include the RemoteConfig that got parsed, so that testremote can
generate a new remote based on an existing remote.
(I would have rather fixed this just inside Remote.Git, but that was not
practical, at least not w/o re-doing work that Remote.List already did.
Big ugly mostly mechanical patch seemed preferable to making git-annex
slower.)
2020-02-26 21:20:56 +00:00
|
|
|
c <- parsedRemoteConfig remote rc
|
2023-01-12 17:18:25 +00:00
|
|
|
cst <- remoteCost gc c expensiveRemoteCost
|
2023-01-10 18:58:53 +00:00
|
|
|
urlincludeexclude <- mkUrlIncludeExclude c
|
2014-12-16 19:26:13 +00:00
|
|
|
return $ Just Remote
|
2023-01-09 19:49:20 +00:00
|
|
|
{ uuid = if u == NoUUID then webUUID else u
|
2018-06-23 22:16:37 +00:00
|
|
|
, cost = cst
|
2014-12-16 19:26:13 +00:00
|
|
|
, name = Git.repoDescribe r
|
|
|
|
, storeKey = uploadKey
|
2023-01-09 21:16:53 +00:00
|
|
|
, retrieveKeyFile = downloadKey urlincludeexclude
|
2020-05-13 21:05:56 +00:00
|
|
|
, retrieveKeyFileCheap = Nothing
|
2018-06-21 15:35:27 +00:00
|
|
|
-- HttpManagerRestricted is used here, so this is
|
|
|
|
-- secure.
|
|
|
|
, retrievalSecurityPolicy = RetrievalAllKeysSecure
|
2023-01-09 21:16:53 +00:00
|
|
|
, removeKey = dropKey urlincludeexclude
|
2015-10-08 19:01:38 +00:00
|
|
|
, lockContent = Nothing
|
2023-01-09 21:16:53 +00:00
|
|
|
, checkPresent = checkKey urlincludeexclude
|
2014-12-16 19:26:13 +00:00
|
|
|
, checkPresentCheap = False
|
2017-09-01 17:02:07 +00:00
|
|
|
, exportActions = exportUnsupported
|
2019-02-20 19:55:01 +00:00
|
|
|
, importActions = importUnsupported
|
2015-08-17 15:35:34 +00:00
|
|
|
, whereisKey = Nothing
|
2014-12-16 19:26:13 +00:00
|
|
|
, remoteFsck = Nothing
|
|
|
|
, repairRepo = Nothing
|
|
|
|
, config = c
|
|
|
|
, gitconfig = gc
|
|
|
|
, localpath = Nothing
|
2018-06-04 18:31:55 +00:00
|
|
|
, getRepo = return r
|
2014-12-16 19:26:13 +00:00
|
|
|
, readonly = True
|
2018-08-30 15:12:18 +00:00
|
|
|
, appendonly = False
|
2020-12-28 19:08:53 +00:00
|
|
|
, untrustworthy = False
|
2023-08-16 18:31:31 +00:00
|
|
|
, availability = pure GloballyAvailable
|
2014-12-16 19:26:13 +00:00
|
|
|
, remotetype = remote
|
|
|
|
, mkUnavailable = return Nothing
|
|
|
|
, getInfo = return []
|
2023-01-09 19:49:20 +00:00
|
|
|
-- claimingUrl makes the web special remote claim
|
|
|
|
-- urls that are not claimed by other remotes,
|
|
|
|
-- so no need to claim anything here.
|
|
|
|
, claimUrl = Nothing
|
2014-12-16 19:26:13 +00:00
|
|
|
, checkUrl = Nothing
|
add RemoteStateHandle
This solves the problem of sameas remotes trampling over per-remote
state. Used for:
* per-remote state, of course
* per-remote metadata, also of course
* per-remote content identifiers, because two remote implementations
could in theory generate the same content identifier for two different
peices of content
While chunk logs are per-remote data, they don't use this, because the
number and size of chunks stored is a common property across sameas
remotes.
External special remote had a complication, where it was theoretically
possible for a remote to send SETSTATE or GETSTATE during INITREMOTE or
EXPORTSUPPORTED. Since the uuid of the remote is typically generate in
Remote.setup, it would only be possible to pass a Maybe
RemoteStateHandle into it, and it would otherwise have to construct its
own. Rather than go that route, I decided to send an ERROR in this case.
It seems unlikely that any existing external special remote will be
affected. They would have to make up a git-annex key, and set state for
some reason during INITREMOTE. I can imagine such a hack, but it doesn't
seem worth complicating the code in such an ugly way to support it.
Unfortunately, both TestRemote and Annex.Import needed the Remote
to have a new field added that holds its RemoteStateHandle.
2019-10-14 16:33:27 +00:00
|
|
|
, remoteStateHandle = rs
|
2014-12-16 19:26:13 +00:00
|
|
|
}
|
2011-07-01 19:24:07 +00:00
|
|
|
|
2023-01-09 19:49:20 +00:00
|
|
|
setupInstance :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
|
2023-01-09 21:16:53 +00:00
|
|
|
setupInstance _ mu _ c _ = do
|
2023-01-09 19:49:20 +00:00
|
|
|
u <- maybe (liftIO genUUID) return mu
|
|
|
|
gitConfigSpecialRemote u c [("web", "true")]
|
|
|
|
return (c, u)
|
|
|
|
|
2023-01-09 21:16:53 +00:00
|
|
|
downloadKey :: UrlIncludeExclude -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
|
|
|
downloadKey urlincludeexclude key _af dest p vc =
|
|
|
|
go =<< getWebUrls' urlincludeexclude key
|
2012-11-11 04:51:07 +00:00
|
|
|
where
|
2021-08-18 18:49:01 +00:00
|
|
|
go [] = giveup "no known url"
|
2021-09-01 19:28:22 +00:00
|
|
|
go urls = dl (partition (not . isyoutube) (map getDownloader urls)) >>= \case
|
2021-08-18 18:49:01 +00:00
|
|
|
Just v -> return v
|
2021-09-01 19:28:22 +00:00
|
|
|
Nothing -> giveup $ unwords
|
|
|
|
[ "downloading from all"
|
|
|
|
, show (length urls)
|
|
|
|
, "known url(s) failed"
|
|
|
|
]
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
|
|
|
|
isyoutube (_, YoutubeDownloader) = True
|
|
|
|
isyoutube _ = False
|
2021-08-18 18:49:01 +00:00
|
|
|
|
2021-09-01 19:28:22 +00:00
|
|
|
dl ([], ytus) = flip getM (map fst ytus) $ \u ->
|
|
|
|
ifM (youtubeDlTo key u dest p)
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
( postdl UnVerified
|
2021-09-01 19:28:22 +00:00
|
|
|
, return Nothing
|
|
|
|
)
|
|
|
|
dl (us, ytus) = do
|
|
|
|
iv <- startVerifyKeyContentIncrementally vc key
|
|
|
|
ifM (Url.withUrlOptions $ downloadUrl True key p iv (map fst us) dest)
|
|
|
|
( finishVerifyKeyContentIncrementally iv >>= \case
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
(True, v) -> postdl v
|
2021-09-01 19:28:22 +00:00
|
|
|
(False, _) -> dl ([], ytus)
|
|
|
|
, dl ([], ytus)
|
|
|
|
)
|
|
|
|
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
postdl v@Verified = return (Just v)
|
|
|
|
postdl v = do
|
|
|
|
when (fromKey keyVariety key == VURLKey) $
|
|
|
|
recordvurlkey
|
|
|
|
return (Just v)
|
|
|
|
|
|
|
|
-- For a VURL key that was not verified on download,
|
|
|
|
-- need to generate a hashed key for the content downloaded
|
|
|
|
-- from the web, and record it for later use verifying this content.
|
|
|
|
--
|
|
|
|
-- But when the VURL key has a known size, and already has a
|
|
|
|
-- recorded hashed key, don't record a new key, since the content
|
|
|
|
-- on the web is expected to be stable for such a key.
|
|
|
|
recordvurlkey = case fromKey keySize key of
|
|
|
|
Nothing -> recordvurlkey' =<< getEquivilantKeys key
|
|
|
|
Just _ -> do
|
|
|
|
eks <- getEquivilantKeys key
|
|
|
|
if null eks
|
|
|
|
then recordvurlkey' eks
|
|
|
|
else return ()
|
|
|
|
|
|
|
|
recordvurlkey' eks = do
|
|
|
|
-- Make sure to pick a backend that is cryptographically
|
|
|
|
-- secure.
|
|
|
|
db <- defaultBackend
|
2024-02-29 21:21:29 +00:00
|
|
|
let b = if isCryptographicallySecure db
|
|
|
|
then db
|
|
|
|
else defaultHashBackend
|
add equivilant key log for VURL keys
When downloading a VURL from the web, make sure that the equivilant key
log is populated.
Unfortunately, this does not hash the content while it's being
downloaded from the web. There is not an interface in Backend currently
for incrementally hash generation, only for incremental verification of an
existing hash. So this might add a noticiable delay, and it has to show
a "(checksum...") message. This could stand to be improved.
But, that separate hashing step only has to happen on the first download
of new content from the web. Once the hash is known, the VURL key can have
its hash verified incrementally while downloading except when the
content in the web has changed. (Doesn't happen yet because
verifyKeyContentIncrementally is not implemented yet for VURL keys.)
Note that the equivilant key log file is formatted as a presence log.
This adds a tiny bit of overhead (eg "1 ") per line over just listing the
urls. The reason I chose to use that format is it seems possible that
there will need to be a way to remove an equivilant key at some point in
the future. I don't know why that would be necessary, but it seemed wise
to allow for the possibility.
Downloads of VURL keys from other special remotes that claim urls,
like bittorrent for example, does not popilate the equivilant key log.
So for now, no checksum verification will be done for those.
Sponsored-by: Nicholas Golder-Manning on Patreon
2024-02-29 19:41:57 +00:00
|
|
|
showSideAction (UnquotedString descChecksum)
|
|
|
|
(hashk, _) <- genKey ks nullMeterUpdate b
|
|
|
|
unless (hashk `elem` eks) $
|
|
|
|
setEquivilantKey key hashk
|
|
|
|
where
|
|
|
|
ks = KeySource
|
|
|
|
{ keyFilename = mempty -- avoid adding any extension
|
|
|
|
, contentLocation = toRawFilePath dest
|
|
|
|
, inodeCache = Nothing
|
|
|
|
}
|
2012-01-20 17:23:11 +00:00
|
|
|
|
2020-05-13 18:03:00 +00:00
|
|
|
uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
|
|
|
|
uploadKey _ _ _ = giveup "upload to web not supported"
|
2011-07-01 19:24:07 +00:00
|
|
|
|
2023-01-09 21:16:53 +00:00
|
|
|
dropKey :: UrlIncludeExclude -> Key -> Annex ()
|
|
|
|
dropKey urlincludeexclude k = mapM_ (setUrlMissing k) =<< getWebUrls' urlincludeexclude k
|
2011-07-01 19:24:07 +00:00
|
|
|
|
2023-01-09 21:16:53 +00:00
|
|
|
checkKey :: UrlIncludeExclude -> Key -> Annex Bool
|
|
|
|
checkKey urlincludeexclude key = do
|
|
|
|
us <- getWebUrls' urlincludeexclude key
|
2011-07-01 19:24:07 +00:00
|
|
|
if null us
|
2014-08-06 17:45:19 +00:00
|
|
|
then return False
|
2016-11-16 01:29:54 +00:00
|
|
|
else either giveup return =<< checkKey' key us
|
2013-09-09 06:16:22 +00:00
|
|
|
checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
|
|
|
|
checkKey' key us = firsthit us (Right False) $ \u -> do
|
2013-08-22 22:25:21 +00:00
|
|
|
let (u', downloader) = getDownloader u
|
|
|
|
case downloader of
|
2017-11-30 17:39:20 +00:00
|
|
|
YoutubeDownloader -> youtubeDlCheck u'
|
2019-11-12 17:33:41 +00:00
|
|
|
_ -> catchMsgIO $
|
2019-11-22 20:24:04 +00:00
|
|
|
Url.withUrlOptions $ Url.checkBoth u' (fromKey keySize key)
|
2013-09-09 06:16:22 +00:00
|
|
|
where
|
2014-10-09 18:53:13 +00:00
|
|
|
firsthit [] miss _ = return miss
|
2013-09-09 06:16:22 +00:00
|
|
|
firsthit (u:rest) _ a = do
|
|
|
|
r <- a u
|
|
|
|
case r of
|
2017-11-07 20:15:44 +00:00
|
|
|
Right True -> return r
|
|
|
|
_ -> firsthit rest r a
|
2014-12-08 23:14:24 +00:00
|
|
|
|
|
|
|
getWebUrls :: Key -> Annex [URLString]
|
2023-01-10 18:58:53 +00:00
|
|
|
getWebUrls key = getWebUrls' alwaysInclude key
|
2023-01-09 21:16:53 +00:00
|
|
|
|
|
|
|
getWebUrls' :: UrlIncludeExclude -> Key -> Annex [URLString]
|
2023-01-10 18:58:53 +00:00
|
|
|
getWebUrls' urlincludeexclude key =
|
2023-01-09 21:16:53 +00:00
|
|
|
filter supported <$> getUrls key
|
2014-12-08 23:14:24 +00:00
|
|
|
where
|
2023-01-10 18:58:53 +00:00
|
|
|
supported u = supporteddownloader u
|
|
|
|
&& checkUrlIncludeExclude urlincludeexclude u
|
2023-01-09 21:16:53 +00:00
|
|
|
supporteddownloader u = snd (getDownloader u)
|
2017-11-29 19:49:05 +00:00
|
|
|
`elem` [WebDownloader, YoutubeDownloader]
|
2023-01-10 18:58:53 +00:00
|
|
|
|
|
|
|
urlincludeField :: RemoteConfigField
|
|
|
|
urlincludeField = Accepted "urlinclude"
|
|
|
|
|
|
|
|
urlexcludeField :: RemoteConfigField
|
|
|
|
urlexcludeField = Accepted "urlexclude"
|
|
|
|
|
|
|
|
data UrlIncludeExclude = UrlIncludeExclude
|
|
|
|
{ checkUrlIncludeExclude :: URLString -> Bool
|
|
|
|
}
|
|
|
|
|
|
|
|
alwaysInclude :: UrlIncludeExclude
|
|
|
|
alwaysInclude = UrlIncludeExclude { checkUrlIncludeExclude = const True }
|
|
|
|
|
|
|
|
mkUrlIncludeExclude :: ParsedRemoteConfig -> Annex UrlIncludeExclude
|
|
|
|
mkUrlIncludeExclude = go fallback
|
|
|
|
where
|
|
|
|
go b pc = case (getglob urlincludeField pc, getglob urlexcludeField pc) of
|
|
|
|
(Nothing, Nothing) -> b
|
|
|
|
(minclude, mexclude) -> mk minclude mexclude
|
|
|
|
|
|
|
|
getglob f pc = do
|
|
|
|
glob <- getRemoteConfigValue f pc
|
2023-03-13 23:06:23 +00:00
|
|
|
Just $ compileGlob glob CaseInsensitive (GlobFilePath False)
|
2023-01-10 18:58:53 +00:00
|
|
|
|
|
|
|
mk minclude mexclude = pure $ UrlIncludeExclude
|
|
|
|
{ checkUrlIncludeExclude = \u -> and
|
|
|
|
[ case minclude of
|
|
|
|
Just glob -> matchGlob glob u
|
|
|
|
Nothing -> True
|
|
|
|
, case mexclude of
|
|
|
|
Nothing -> True
|
|
|
|
Just glob -> not (matchGlob glob u)
|
|
|
|
]
|
|
|
|
}
|
|
|
|
|
|
|
|
-- When nothing to include or exclude is specified, only include
|
|
|
|
-- urls that are not explicitly included by other web special remotes.
|
|
|
|
fallback = do
|
|
|
|
rcs <- M.elems . M.filter iswebremote <$> remoteConfigMap
|
|
|
|
l <- forM rcs $ \rc ->
|
|
|
|
parsedRemoteConfig remote rc
|
|
|
|
>>= go (pure neverinclude)
|
|
|
|
pure $ UrlIncludeExclude
|
|
|
|
{ checkUrlIncludeExclude = \u ->
|
|
|
|
not (any (\c -> checkUrlIncludeExclude c u) l)
|
|
|
|
}
|
|
|
|
|
|
|
|
iswebremote rc = (fromProposedAccepted <$> M.lookup typeField rc)
|
|
|
|
== Just (typename remote)
|
|
|
|
|
|
|
|
neverinclude = UrlIncludeExclude { checkUrlIncludeExclude = const False }
|