summaryrefslogtreecommitdiff
path: root/Test.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-03-17 19:13:52 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-03-17 19:14:41 -0400
commit9a79dc9ec02a430c21ac720d7c6a4ee11a3edcdd (patch)
tree4fcca1001f62396eb1f9ef0d1357b8ff68d16fd4 /Test.hs
parent17be6b8b6663ac37e5b2f6caba2730ebd4f0f42f (diff)
test suite infra for testing mocked ssh remotes
This commit was supported by the NSF-funded DataLad project.
Diffstat (limited to 'Test.hs')
-rw-r--r--Test.hs71
1 files changed, 55 insertions, 16 deletions
diff --git a/Test.hs b/Test.hs
index 7ef0cb5f0..11fac2ea2 100644
--- a/Test.hs
+++ b/Test.hs
@@ -1,6 +1,6 @@
{- git-annex test suite
-
- - Copyright 2010-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -29,13 +29,14 @@ import Test.Tasty.Runners
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Test.Tasty.Ingredients.Rerun
-import Options.Applicative (switch, long, help)
+import Options.Applicative (switch, long, help, internal)
import qualified Data.Map as M
import qualified Data.Aeson
import qualified Data.ByteString.Lazy.UTF8 as BU8
import Common
+import CmdLine.GitAnnex.Options
import qualified Utility.SafeCommand
import qualified Annex
@@ -112,21 +113,31 @@ optParser = TestOptions
<*> switch
( long "keep-failures"
<> help "preserve repositories on test failure"
- )
+ )
+ <*> switch
+ ( long "fakessh"
+ <> internal
+ )
+ <*> cmdParams "non-options are for internal use only"
runner :: Maybe (TestOptions -> IO ())
-runner = Just $ \opts -> isolateGitConfig $ do
- ensuretmpdir
- crippledfilesystem <- Annex.Init.probeCrippledFileSystem' tmpdir
- case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem opts) of
- Nothing -> error "No tests found!?"
- Just act -> ifM act
- ( exitSuccess
- , do
- putStrLn " (This could be due to a bug in git-annex, or an incompatibility"
- putStrLn " with utilities, such as git, installed on this system.)"
- exitFailure
- )
+runner = Just go
+ where
+ go opts
+ | fakeSsh opts = runFakeSsh (internalData opts)
+ | otherwise = runtests opts
+ runtests opts = isolateGitConfig $ do
+ ensuretmpdir
+ crippledfilesystem <- Annex.Init.probeCrippledFileSystem' tmpdir
+ case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem opts) of
+ Nothing -> error "No tests found!?"
+ Just act -> ifM act
+ ( exitSuccess
+ , do
+ putStrLn " (This could be due to a bug in git-annex, or an incompatibility"
+ putStrLn " with utilities, such as git, installed on this system.)"
+ exitFailure
+ )
ingredients :: [Ingredient]
ingredients =
@@ -211,6 +222,7 @@ unitTests note = testGroup ("Unit Tests " ++ note)
, testCase "drop (with remote)" test_drop_withremote
, testCase "drop (untrusted remote)" test_drop_untrustedremote
, testCase "get" test_get
+ , testCase "get (from ssh remote)" test_get_ssh_remote
, testCase "move" test_move
, testCase "copy" test_copy
, testCase "lock" test_lock
@@ -458,7 +470,13 @@ test_drop_untrustedremote = intmpclonerepo $ do
inmainrepo $ annexed_present annexedfile
test_get :: Assertion
-test_get = intmpclonerepo $ do
+test_get = test_get' intmpclonerepo
+
+test_get_ssh_remote :: Assertion
+test_get_ssh_remote = test_get' (with_ssh_origin intmpclonerepo)
+
+test_get' :: (Assertion -> Assertion) -> Assertion
+test_get' setup = setup $ do
inmainrepo $ annexed_present annexedfile
annexed_notpresent annexedfile
git_annex "get" [annexedfile] @? "get of file failed"
@@ -1740,6 +1758,16 @@ innewrepo a = withgitrepo $ \r -> indir r a
inmainrepo :: Assertion -> Assertion
inmainrepo = indir mainrepodir
+with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)
+with_ssh_origin cloner a = cloner $ do
+ origindir <- absPath
+ =<< annexeval (Config.getConfig (Config.ConfigKey config) "/dev/null")
+ let originurl = "localhost:" ++ origindir
+ boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed"
+ a
+ where
+ config = "remote.origin.url"
+
intmpclonerepo :: Assertion -> Assertion
intmpclonerepo a = withtmpclonerepo $ \r -> indir r a
@@ -2072,9 +2100,20 @@ setTestMode testmode = do
, ("GIT_COMMITTER_NAME", "git-annex test")
-- force gpg into batch mode for the tests
, ("GPG_BATCH", "1")
+ -- Make git and git-annex access ssh remotes on the local
+ -- filesystem, without using ssh at all.
+ , ("GIT_SSH_COMMAND", "git-annex test --fakessh --")
, ("TESTMODE", show testmode)
]
+runFakeSsh :: [String] -> IO ()
+runFakeSsh ("-n":ps) = runFakeSsh ps
+runFakeSsh (_host:cmd:[]) = do
+ let p = shell cmd
+ (_, _, _, pid) <- createProcess p
+ forceSuccessProcess p pid
+runFakeSsh ps = error $ "fake ssh option parse error: " ++ show ps
+
getTestMode :: IO TestMode
getTestMode = Prelude.read <$> Utility.Env.getEnvDefault "TESTMODE" ""