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

testremote: Add testing of behavior when remote is not available

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

21
Remote/Git.hs
View file

@ -55,6 +55,7 @@ import Creds
import Control.Concurrent
import Control.Concurrent.MSampleVar
import qualified Data.Map as M
import Network.URI
remote :: RemoteType
remote = RemoteType {
@ -156,8 +157,22 @@ gen r u c gc
, readonly = Git.repoIsHttp r
, availability = availabilityCalc r
, remotetype = remote
, mkUnavailable = unavailable r u c gc
}
unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
unavailable r u c gc = gen r' u c gc
where
r' = case Git.location r of
Git.Local { Git.gitdir = d } ->
r { Git.location = Git.LocalUnknown d }
Git.Url url -> case uriAuthority url of
Just auth ->
let auth' = auth { uriRegName = "!dne!" }
in r { Git.location = Git.Url (url { uriAuthority = Just auth' })}
Nothing -> r { Git.location = Git.Unknown }
_ -> r -- already unavailable
{- Checks relatively inexpensively if a repository is available for use. -}
repoAvail :: Git.Repo -> Annex Bool
repoAvail r
@ -180,7 +195,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo
tryGitConfigRead r
| haveconfig r = return r -- already read
| Git.repoIsSsh r = store $ do
v <- Ssh.onRemote r (pipedconfig, Left undefined) "configlist" [] []
v <- Ssh.onRemote r (pipedconfig, return (Left undefined)) "configlist" [] []
case v of
Right r'
| haveconfig r' -> return r'
@ -298,8 +313,8 @@ inAnnex rmt key
)
checkremote = Ssh.inAnnex r key
checklocal = guardUsable r (cantCheck r) $
fromMaybe (cantCheck r)
<$> onLocal rmt (Annex.Content.inAnnexSafe key)
maybe (cantCheck r) return
=<< onLocal rmt (Annex.Content.inAnnexSafe key)
keyUrls :: Remote -> Key -> [String]
keyUrls r key = map tourl locs'