Display progress meter in -J mode when downloading from the web.

Including in addurl, and get --from web, but also in S3 and External
special remotes when a web url is known for content in those remotes.
This commit is contained in:
Joey Hess 2015-11-16 21:00:54 -04:00
parent 1244eb3770
commit e97fce35a6
Failed to extract signature
9 changed files with 36 additions and 30 deletions

View file

@ -503,9 +503,9 @@ checkurl external url =
mkmulti (u, s, f) = (u, s, mkSafeFilePath f)
retrieveUrl :: Retriever
retrieveUrl = fileRetriever $ \f k _p -> do
retrieveUrl = fileRetriever $ \f k p -> do
us <- getWebUrls k
unlessM (downloadUrl us f) $
unlessM (downloadUrl k p us f) $
error "failed to download content"
checkKeyUrl :: Git.Repo -> CheckPresent

View file

@ -421,7 +421,7 @@ lockKey r key callback
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
copyFromRemote r key file dest p = concurrentMetered (Just p) key file $
copyFromRemote r key file dest p = concurrentMetered (Just p) key $
copyFromRemote' r key file dest
copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
@ -445,7 +445,8 @@ copyFromRemote' r key file dest meterupdate
direct <- isDirect
Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p))
=<< Ssh.rsyncParamsRemote direct r Download key dest file
| Git.repoIsHttp (repo r) = unVerified $ Annex.Content.downloadUrl (keyUrls r key) dest
| Git.repoIsHttp (repo r) = unVerified $
Annex.Content.downloadUrl key meterupdate (keyUrls r key) dest
| otherwise = error "copying from non-ssh, non-http remote not supported"
where
{- Feed local rsync's progress info back to the remote,
@ -522,7 +523,7 @@ copyFromRemoteCheap r key af file
)
| Git.repoIsSsh (repo r) =
ifM (Annex.Content.preseedTmp key file)
( fst <$> concurrentMetered Nothing key af
( fst <$> concurrentMetered Nothing key
(copyFromRemote' r key af file)
, return False
)
@ -534,7 +535,7 @@ copyFromRemoteCheap _ _ _ _ = return False
{- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
copyToRemote r key file meterupdate =
concurrentMetered (Just meterupdate) key file $
concurrentMetered (Just meterupdate) key $
copyToRemote' r key file
copyToRemote' :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool

View file

@ -155,8 +155,8 @@ specialRemote' :: SpecialRemoteCfg -> RemoteModifier
specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckpresent baser = encr
where
encr = baser
{ storeKey = \k f p -> cip >>= storeKeyGen k f p
, retrieveKeyFile = \k f d p -> cip >>= unVerified . retrieveKeyFileGen k f d p
{ storeKey = \k _f p -> cip >>= storeKeyGen k p
, retrieveKeyFile = \k _f d p -> cip >>= unVerified . retrieveKeyFileGen k d p
, retrieveKeyFileCheap = \k f d -> cip >>= maybe
(retrieveKeyFileCheap baser k f d)
-- retrieval of encrypted keys is never cheap
@ -183,12 +183,12 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
safely a = catchNonAsync a (\e -> warning (show e) >> return False)
-- chunk, then encrypt, then feed to the storer
storeKeyGen k f p enc = safely $ preparestorer k $ safely . go
storeKeyGen k p enc = safely $ preparestorer k $ safely . go
where
go (Just storer) = preparecheckpresent k $ safely . go' storer
go Nothing = return False
go' storer (Just checker) = sendAnnex k rollback $ \src ->
displayprogress p k f $ \p' ->
displayprogress p k $ \p' ->
storeChunks (uuid baser) chunkconfig k src p'
(storechunk enc storer)
checker
@ -204,10 +204,10 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
storer (enck k) (ByteContent encb) p
-- call retriever to get chunks; decrypt them; stream to dest file
retrieveKeyFileGen k f dest p enc =
retrieveKeyFileGen k dest p enc =
safely $ prepareretriever k $ safely . go
where
go (Just retriever) = displayprogress p k f $ \p' ->
go (Just retriever) = displayprogress p k $ \p' ->
retrieveChunks retriever (uuid baser) chunkconfig
enck k dest p' (sink dest enc)
go Nothing = return False
@ -227,8 +227,8 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
chunkconfig = chunkConfig cfg
displayprogress p k f a
| displayProgress cfg = metered (Just p) k f a
displayprogress p k a
| displayProgress cfg = metered (Just p) k a
| otherwise = a p
{- Sink callback for retrieveChunks. Stores the file content into the

View file

@ -249,8 +249,8 @@ retrieve r info Nothing = case getpublicurl info of
Nothing -> \_ _ _ -> do
warnMissingCredPairFor "S3" (AWS.creds $ uuid r)
return False
Just geturl -> fileRetriever $ \f k _p ->
unlessM (downloadUrl [geturl k] f) $
Just geturl -> fileRetriever $ \f k p ->
unlessM (downloadUrl k p [geturl k] f) $
error "failed to download content"
retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool

View file

@ -72,7 +72,7 @@ gen r _ c gc =
}
downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
downloadKey key _file dest _p = unVerified $ get =<< getWebUrls key
downloadKey key _af dest p = unVerified $ get =<< getWebUrls key
where
get [] = do
warning "no known url"
@ -84,13 +84,13 @@ downloadKey key _file dest _p = unVerified $ get =<< getWebUrls key
case downloader of
QuviDownloader -> do
#ifdef WITH_QUVI
flip downloadUrl dest
flip (downloadUrl key p) dest
=<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u'
#else
warning "quvi support needed for this url"
return False
#endif
_ -> downloadUrl [u'] dest
_ -> downloadUrl key p [u'] dest
downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
downloadKeyCheap _ _ _ = return False