make retrieveKeyFile and retrieveKeyFileCheap throw exceptions

Converted retrieveKeyFileCheap to a Maybe, to avoid needing to throw a
exception when a remote doesn't support it.
This commit is contained in:
Joey Hess 2020-05-13 17:05:56 -04:00
parent a6adea4aaf
commit d9c7f81ba4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
32 changed files with 247 additions and 245 deletions

View file

@ -189,15 +189,19 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do
-- so that the remote knows what url it
-- should use to download it.
setTempUrl urlkey loguri
let downloader = \dest p -> fst
<$> Remote.retrieveKeyFile r urlkey
(AssociatedFile (Just (toRawFilePath file))) dest p
let downloader = \dest p ->
tryNonAsync (Remote.retrieveKeyFile r urlkey af dest p) >>= \case
Right _ -> return True
Left e -> do
warning (show e)
return False
ret <- downloadWith addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file
removeTempUrl urlkey
return ret
)
where
loguri = setDownloader uri OtherDownloader
af = AssociatedFile (Just (toRawFilePath file))
startWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> CommandStart
startWeb addunlockedmatcher o urlstring = go $ fromMaybe bad $ parseURI urlstring

View file

@ -41,6 +41,7 @@ import Data.Time.Clock.POSIX
import System.Posix.Types (EpochTime)
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Either
cmd :: Command
cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $
@ -174,17 +175,20 @@ performRemote key afile backend numcopies remote =
cleanup
cleanup `after` a tmp
getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True)
( ifM (Remote.retrieveKeyFileCheap remote key afile tmp)
( ifM (getcheap tmp)
( return (Just True)
, ifM (Annex.getState Annex.fast)
( return Nothing
, Just . fst <$>
Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
, Just . isRight <$> tryNonAsync (getfile' tmp)
)
)
, return (Just False)
)
getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
dummymeter _ = noop
getcheap tmp = case Remote.retrieveKeyFileCheap remote of
Just a -> isRight <$> tryNonAsync (a key afile tmp)
Nothing -> return False
startKey :: Maybe Remote -> Incremental -> (Key, ActionItem) -> NumCopies -> CommandStart
startKey from inc (key, ai) numcopies =

View file

@ -112,5 +112,9 @@ getKey' key afile = dispatch
download (Remote.uuid r) key afile stdRetry
(\p -> do
showAction $ "from " ++ Remote.name r
Remote.retrieveKeyFile r key afile dest p
tryNonAsync (Remote.retrieveKeyFile r key afile dest p) >>= \case
Right v -> return (True, v)
Left e -> do
warning (show e)
return (False, UnVerified)
) witness

View file

@ -207,7 +207,11 @@ fromPerform src removewhen key afile = do
go = notifyTransfer Download afile $
download (Remote.uuid src) key afile stdRetry $ \p ->
getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->
Remote.retrieveKeyFile src key afile t p
tryNonAsync (Remote.retrieveKeyFile src key afile t p) >>= \case
Right v -> return (True, v)
Left e -> do
warning (show e)
return (False, UnVerified)
dispatch _ _ False = stop -- failed
dispatch RemoveNever _ True = next $ return True -- copy complete
dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do

View file

@ -274,8 +274,9 @@ test runannex mkr mkk =
Nothing -> return True
Just verifier -> verifier k (serializeKey k)
get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
Remote.retrieveKeyFile r k (AssociatedFile Nothing)
dest nullMeterUpdate
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
Right v -> return (True, v)
Left _ -> return (False, UnVerified)
store r k = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
remove r k = Remote.removeKey r k
@ -348,10 +349,14 @@ testUnavailable runannex mkr mkk =
Remote.checkPresent r k
, check (== Right False) "retrieveKeyFile" $ \r k ->
getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate
, check (== Right False) "retrieveKeyFileCheap" $ \r k ->
getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> unVerified $
Remote.retrieveKeyFileCheap r k (AssociatedFile Nothing) dest
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
Right v -> return (True, v)
Left _ -> return (False, UnVerified)
, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of
Nothing -> return False
Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
unVerified $ isRight
<$> tryNonAsync (a k (AssociatedFile Nothing) dest)
]
where
check checkval desc a = testCase desc $

View file

@ -53,18 +53,22 @@ toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
toPerform key file remote = go Upload file $
upload (uuid remote) key file stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key file p) >>= \case
Left e -> do
warning (show e)
return False
Right () -> do
Remote.logStatus remote key InfoPresent
return True
Left e -> do
warning (show e)
return False
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
fromPerform key file remote = go Upload file $
download (uuid remote) key file stdRetry $ \p ->
getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $
\t -> Remote.retrieveKeyFile remote key file t p
getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t ->
tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
Right v -> return (True, v)
Left e -> do
warning (show e)
return (False, UnVerified)
go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
go direction file a = notifyTransfer direction file a >>= liftIO . exitBool

View file

@ -48,7 +48,11 @@ start = do
| otherwise = notifyTransfer direction file $
download (Remote.uuid remote) key file stdRetry $ \p ->
getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> do
r <- Remote.retrieveKeyFile remote key file t p
r <- tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
Left e -> do
warning (show e)
return (False, UnVerified)
Right v -> return (True, v)
-- Make sure we get the current
-- associated files data for the key,
-- not old cached data.