fix test suite breakage

640bc43c38 broke a test. Change that test
to not use encryption=shared. Which required some refactoring.

Sponsored-by: Joshua Antonishen

Test.hs

@@ -90,7 +90,6 @@ import qualified Utility.MoveFile
 import qualified Utility.StatelessOpenPGP
 import qualified Types.Remote
 #ifndef mingw32_HOST_OS
-import qualified Utility.OsString as OS
 import qualified Remote.Helper.Encryptable
 import qualified Types.Crypto
 import qualified Utility.Gpg
@@ -1917,27 +1916,7 @@ test_gpg_crypto = do
 	testscheme "hybrid"
 	testscheme "pubkey"
   where
-	gpgcmd = Utility.Gpg.mkGpgCmd Nothing
-	testscheme scheme = Utility.Tmp.Dir.withTmpDir (literalOsPath "gpgtmp") $ \gpgtmp -> do
-		-- Use the system temp directory as gpg temp directory because 
-		-- it needs to be able to store the agent socket there,
-		-- which can be problematic when testing some filesystems.
-		absgpgtmp <- absPath gpgtmp
-		res <- testscheme' scheme absgpgtmp
-		-- gpg may still be running and would prevent
-		-- removeDirectoryRecursive from succeeding, so
-		-- force removal of the temp directory.
-		liftIO $ removeDirectoryForCleanup (fromOsPath gpgtmp)
-		return res
-	testscheme' scheme absgpgtmp = intmpclonerepo $ do
-		-- Since gpg uses a unix socket, which is limited to a
-		-- short path, use whichever is shorter of absolute
-		-- or relative path.
-		relgpgtmp <- relPathCwdToFile absgpgtmp
-		let gpgtmp = if OS.length relgpgtmp < OS.length absgpgtmp
-			then relgpgtmp 
-			else absgpgtmp
-		void $ Utility.Gpg.testHarness (fromOsPath gpgtmp) gpgcmd $ \environ -> do
+	testscheme scheme = intmpclonerepo $ test_with_gpg $ \gpgcmd environ -> do
 		createDirectory (literalOsPath "dir")
 		let initps =
 			[ "foo"
@@ -1963,7 +1942,7 @@ test_gpg_crypto = do
 		let key = if scheme `elem` ["hybrid","pubkey"]
 			then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
 			else Nothing
-			testEncryptedRemote environ scheme key c [k] @? "invalid crypto setup"
+		testEncryptedRemote gpgcmd environ scheme key c [k] @? "invalid crypto setup"
 	
 		annexed_present annexedfile
 		git_annex' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop"
@@ -1974,7 +1953,7 @@ test_gpg_crypto = do
 		annexed_present annexedfile
 	{- Ensure the configuration complies with the encryption scheme, and
 	 - that all keys are encrypted properly for the given directory remote. -}
-	testEncryptedRemote environ scheme ks c keys = case Remote.Helper.Encryptable.extractCipher pc of
+	testEncryptedRemote gpgcmd environ scheme ks c keys = case Remote.Helper.Encryptable.extractCipher pc of
 		Just cip@Crypto.SharedCipher{} | scheme == "shared" && isNothing ks ->
 			checkKeys cip Nothing
 		Just cip@(Crypto.EncryptedCipher encipher v ks')
@@ -2210,9 +2189,26 @@ test_enableremote_encryption_changes = intmpclonerepo $ do
 		"enableremote disabling encryption"
 	git_annex_shouldfail "enableremote" ["bar", "onlyencryptcreds=yes", dirparam]
 		"enableremote with onlyencryptcreds"
-	git_annex "initremote" ["baz", "type=directory", "encryption=shared", "onlyencryptcreds=yes", dirparam]
-		"initremote"
-	git_annex_shouldfail "enableremote" ["baz", "onlyencryptcreds=no", dirparam]
+	git_annex_shouldfail "initremote" ["baz", "type=directory", "encryption=shared", "onlyencryptcreds=yes", dirparam]
+		"initremote with onlyencryptcreds not allowed with shared encryption"
+	git_annex_shouldfail "initremote" ["baz", "type=directory", "encryption=none", "onlyencryptcreds=yes", dirparam]
+		"initremote with onlyencryptcreds not allowed with no encryption"
+#ifndef mingw32_HOST_OS
+	test_with_gpg $ \_gpgcmd environ -> do
+		git_annex' "initremote"
+			["baz"
+			, "type=directory"
+			, "encryption=hybrid"
+			, "onlyencryptcreds=yes"
+			, "highRandomQuality=false"
+			, "keyid=" ++ Utility.Gpg.testKeyId
+			, dirparam]
+			(Just environ)
+			"initremote with onlyencryptcreds and hybrid encryption"
+		git_annex_shouldfail' "enableremote" ["baz", "onlyencryptcreds=no", dirparam]
+			(Just environ)
 			"enableremote disabling onlyencryptcreds"
-	git_annex "enableremote" ["baz", "onlyencryptcreds=yes", dirparam]
+		git_annex' "enableremote" ["baz", "onlyencryptcreds=yes", dirparam]
+			(Just environ)
 			"enableremote enabling already enabled onlyencryptcreds"
+#endif

Test/Framework.hs

@@ -1,11 +1,11 @@
 {- git-annex test suite framework
  -
- - Copyright 2010-2023 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, CPP #-}
 
 module Test.Framework where
 
@@ -67,6 +67,9 @@ import qualified Utility.Metered
 import qualified Utility.HumanTime
 import qualified Command.Uninit
 import qualified Utility.OsString as OS
+#ifndef mingw32_HOST_OS
+import qualified Utility.Gpg
+#endif
 
 -- Run a process. The output and stderr is captured, and is only
 -- displayed if the process does not return the expected value.
@@ -517,6 +520,33 @@ add_annex f faildesc = ifM (unlockedFiles <$> getTestMode)
 	, git_annex "add" [f] faildesc
 	)
 
+#ifndef mingw32_HOST_OS
+test_with_gpg :: (Utility.Gpg.GpgCmd -> [(String, String)] -> Assertion) -> Assertion
+test_with_gpg a = Utility.Tmp.Dir.withTmpDir (literalOsPath "gpgtmp") $ \gpgtmp -> do
+	-- Use the system temp directory as gpg temp directory because 
+	-- it needs to be able to store the agent socket there,
+	-- which can be problematic when testing some filesystems.
+	absgpgtmp <- absPath gpgtmp
+	res <- go absgpgtmp
+	-- gpg may still be running and would prevent
+	-- removeDirectoryRecursive from succeeding, so
+	-- force removal of the temp directory.
+	liftIO $ removeDirectoryForCleanup (fromOsPath gpgtmp)
+	return res
+  where
+	gpgcmd = Utility.Gpg.mkGpgCmd Nothing
+	go absgpgtmp = do
+		-- Since gpg uses a unix socket, which is limited to a
+		-- short path, use whichever is shorter of absolute
+		-- or relative path.
+		relgpgtmp <- relPathCwdToFile absgpgtmp
+		let gpgtmp = if OS.length relgpgtmp < OS.length absgpgtmp
+			then relgpgtmp 
+			else absgpgtmp
+		void $ Utility.Gpg.testHarness (fromOsPath gpgtmp) gpgcmd $ \environ ->
+			a gpgcmd environ
+#endif
+
 data TestMode = TestMode
 	{ unlockedFiles :: Bool
 	, adjustedUnlockedBranch :: Bool

doc/bugs/tests_fail__58___There_is_no_security_benefit_.mdwn

@@ -50,3 +50,4 @@ supported repository versions: 8 9 10
 upgrade supported from repository versions: 0 1 2 3 4 5 6 7 8 9 10
 ```
 
+> [[fixed|done]] --[[Joey]]