testremote: Add testing of behavior when remote is not available

Added a mkUnavailable method, which a Remote can use to generate a version
of itself that is not available. Implemented for several, but not yet all
remotes.

This allows testing that checkPresent properly throws an exceptions when
it cannot check if a key is present or not. It also allows testing that the
other methods don't throw exceptions in these circumstances.

This immediately found several bugs, which this commit also fixes!

* git remotes using ssh accidentially had checkPresent return
  an exception, rather than throwing it
* The chunking code accidentially returned False rather than
  propigating an exception when there were no chunks and
  checkPresent threw an exception for the non-chunked key.

This commit was sponsored by Carlo Matteo Capocasa.
This commit is contained in:
Joey Hess 2014-08-10 14:52:58 -04:00
parent 2fd9518f72
commit 6adbd50cd9
18 changed files with 92 additions and 30 deletions

View file

@ -348,11 +348,12 @@ checkPresentChunks checker u chunkconfig encryptor basek
v <- check basek
case v of
Right True -> return True
Left e -> checklists (Just e) =<< chunkKeysOnly u basek
_ -> checklists Nothing =<< chunkKeysOnly u basek
| otherwise = checklists Nothing =<< chunkKeys u chunkconfig basek
where
checklists Nothing [] = return False
checklists (Just deferrederror) [] = error deferrederror
checklists (Just deferrederror) [] = throwM deferrederror
checklists d (l:ls)
| not (null l) = do
v <- checkchunks l
@ -362,14 +363,14 @@ checkPresentChunks checker u chunkconfig encryptor basek
Right False -> checklists Nothing ls
| otherwise = checklists d ls
checkchunks :: [Key] -> Annex (Either String Bool)
checkchunks :: [Key] -> Annex (Either SomeException Bool)
checkchunks [] = return (Right True)
checkchunks (k:ks) = do
v <- check k
case v of
Right True -> checkchunks ks
Right False -> return $ Right False
Left e -> return $ Left $ show e
Left e -> return $ Left e
check = tryNonAsync . checker . encryptor

View file

@ -69,7 +69,7 @@ git_annex_shell r command params fields
- a specified error value. -}
onRemote
:: Git.Repo
-> (FilePath -> [CommandParam] -> IO a, a)
-> (FilePath -> [CommandParam] -> IO a, Annex a)
-> String
-> [CommandParam]
-> [(Field, String)]
@ -78,7 +78,7 @@ onRemote r (with, errorval) command params fields = do
s <- git_annex_shell r command params fields
case s of
Just (c, ps) -> liftIO $ with c ps
Nothing -> return errorval
Nothing -> errorval
{- Checks if a remote contains a key. -}
inAnnex :: Git.Repo -> Key -> Annex Bool
@ -86,14 +86,14 @@ inAnnex r k = do
showChecking r
onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] []
where
check c p = dispatch <$> safeSystem c p
dispatch ExitSuccess = True
dispatch (ExitFailure 1) = False
check c p = dispatch =<< safeSystem c p
dispatch ExitSuccess = return True
dispatch (ExitFailure 1) = return False
dispatch _ = cantCheck r
{- Removes a key from a remote. -}
dropKey :: Git.Repo -> Key -> Annex Bool
dropKey r key = onRemote r (boolSystem, False) "dropkey"
dropKey r key = onRemote r (boolSystem, return False) "dropkey"
[ Params "--quiet --force"
, Param $ key2file key
]