Avoid a test suite failure when the environment does not let gpg be tested

Due to eg, too long a path to the agent socket, caused by running gpg in a
container where /run is not mounted, and/or some other gpg behavior like
unnecessarily making relative paths to its home directory absolute.

CHANGELOG

@@ -41,6 +41,8 @@ git-annex (8.20200331) UNRELEASED; urgency=medium
     expression has been set in groupwanted as the required content of the
     repo, similar to how setting required content to "standard" already
     worked.
+  * Avoid a test suite failure when the environment does not let gpg be
+    tested due to eg, too long a path to the agent socket.
 
  -- Joey Hess <id@joeyh.name>  Mon, 30 Mar 2020 15:58:34 -0400
 

Test.hs

@@ -1576,14 +1576,12 @@ test_crypto = do
 	testscheme scheme = do
 		abstmp <- absPath tmpdir
 		testscheme' scheme abstmp
-	testscheme' scheme abstmp = intmpclonerepo $ whenM (Utility.Path.inPath (Utility.Gpg.unGpgCmd gpgcmd)) $ do
+	testscheme' scheme abstmp = intmpclonerepo $ do
-		-- Use a relative path to avoid too long path to gpg's
-		-- agent socket.
 		gpgtmp <- (</> "gpgtmp") <$> relPathCwdToFile abstmp
 		createDirectoryIfMissing False gpgtmp
 		Utility.Gpg.testTestHarness gpgtmp gpgcmd
 			@? "test harness self-test failed"
-		Utility.Gpg.testHarness gpgtmp gpgcmd $ do
+		void $ Utility.Gpg.testHarness gpgtmp gpgcmd $ do
 			createDirectory "dir"
 			let a cmd = git_annex cmd $
 				[ "foo"

Utility/Gpg.hs

@@ -376,9 +376,18 @@ keyBlock public ls = unlines
 #ifndef mingw32_HOST_OS
 {- Runs an action using gpg in a test harness, in which gpg does
  - not use ~/.gpg/, but sets up the test key in a subdirectory of 
- - the passed directory and uses it. -}
+ - the passed directory and uses it.
-testHarness :: FilePath -> GpgCmd -> IO a -> IO a
+ -
-testHarness tmpdir cmd a = bracket setup cleanup (const a)
+ - If the test harness is not able to be set up (eg, because gpg is not
+ - installed or because there is some problem importing the test key,
+ - perhaps related to the agent socket), the action is not run, and Nothing
+ - is returned.
+ -}
+testHarness :: FilePath -> GpgCmd -> IO a -> IO (Maybe a)
+testHarness tmpdir cmd a = ifM (inPath (unGpgCmd cmd))
+	( bracket (eitherToMaybe <$> tryNonAsync setup) cleanup go
+	, return Nothing
+	)
   where
 	var = "GNUPGHOME"		
 
@@ -395,8 +404,12 @@ testHarness tmpdir cmd a = bracket setup cleanup (const a)
 			[testSecretKey, testKey]
 		return orig
 		
-	cleanup (Just v) = setEnv var v True
+	cleanup (Just (Just v)) = setEnv var v True
-	cleanup Nothing = unsetEnv var
+	cleanup (Just Nothing) = unsetEnv var
+	cleanup Nothing = return ()
+
+	go (Just _) = Just <$> a
+	go Nothing = return Nothing
 
         makenewdir n = do
 		let subdir = tmpdir </> show n
@@ -406,9 +419,12 @@ testHarness tmpdir cmd a = bracket setup cleanup (const a)
 
 {- Tests the test harness. -}
 testTestHarness :: FilePath -> GpgCmd -> IO Bool
-testTestHarness tmpdir cmd = do
+testTestHarness tmpdir cmd =
-	keys <- testHarness tmpdir cmd $ findPubKeys cmd testKeyId
+	testHarness tmpdir cmd (findPubKeys cmd testKeyId) >>= \case
-	return $ KeyIds [testKeyId] == keys
+		Nothing -> do
+			hPutStrLn stderr "unable to test gpg, setting up the test harness did not succeed"
+			return True
+		Just keys -> return $ KeyIds [testKeyId] == keys
 
 checkEncryptionFile :: GpgCmd -> FilePath -> Maybe KeyIds -> IO Bool
 checkEncryptionFile cmd filename keys =

doc/bugs/tests_fail___40__gpg-agent_related__63____41___when_running_build_inside_singularity_container.mdwn

@@ -41,3 +41,5 @@ FWIW,
 
 [[!meta author=yoh]]
 [[!tag projects/datalad]]
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/tests_fail___40__gpg-agent_related__63____41___when_running_build_inside_singularity_container/comment_6_d358bf55d89f5d0609d792a26757d0f4._comment

@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2020-04-28T19:29:05Z"
+ content="""
+Hmm, it could be that /run is not mounted in the container and then gpg
+falls back to putting the socket in the home directory.
+
+Ok, I'm just going to make this test be skipped if it fails to import the
+test key.
+"""]]