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,64 +1916,44 @@ test_gpg_crypto = do
 	testscheme "hybrid"
 	testscheme "pubkey"
   where
-	gpgcmd = Utility.Gpg.mkGpgCmd Nothing
+	testscheme scheme = intmpclonerepo $ test_with_gpg $ \gpgcmd environ -> do
-	testscheme scheme = Utility.Tmp.Dir.withTmpDir (literalOsPath "gpgtmp") $ \gpgtmp -> do
+		createDirectory (literalOsPath "dir")
-		-- Use the system temp directory as gpg temp directory because 
+		let initps =
-		-- it needs to be able to store the agent socket there,
+			[ "foo"
-		-- which can be problematic when testing some filesystems.
+			, "type=directory"
-		absgpgtmp <- absPath gpgtmp
+			, "encryption=" ++ scheme
-		res <- testscheme' scheme absgpgtmp
+			, "directory=dir"
-		-- gpg may still be running and would prevent
+			, "highRandomQuality=false"
-		-- removeDirectoryRecursive from succeeding, so
+			] ++ if scheme `elem` ["hybrid","pubkey"]
-		-- force removal of the temp directory.
+				then ["keyid=" ++ Utility.Gpg.testKeyId]
-		liftIO $ removeDirectoryForCleanup (fromOsPath gpgtmp)
+				else []
-		return res
+		git_annex' "initremote" initps (Just environ) "initremote"
-	testscheme' scheme absgpgtmp = intmpclonerepo $ do
+		git_annex_shouldfail' "initremote" initps (Just environ) "initremote should not work when run twice in a row"
-		-- Since gpg uses a unix socket, which is limited to a
+		git_annex' "enableremote" initps (Just environ) "enableremote"
-		-- short path, use whichever is shorter of absolute
+		git_annex' "enableremote" initps (Just environ) "enableremote when run twice in a row"
-		-- or relative path.
+		git_annex' "get" [annexedfile] (Just environ) "get of file"
-		relgpgtmp <- relPathCwdToFile absgpgtmp
+		annexed_present annexedfile
-		let gpgtmp = if OS.length relgpgtmp < OS.length absgpgtmp
+		git_annex' "copy" [annexedfile, "--to", "foo"] (Just environ) "copy --to encrypted remote"
-			then relgpgtmp 
+		(c,k) <- annexeval $ do
-			else absgpgtmp
+			uuid <- Remote.nameToUUID "foo"
-		void $ Utility.Gpg.testHarness (fromOsPath gpgtmp) gpgcmd $ \environ -> do
+			rs <- Logs.Remote.readRemoteLog
-			createDirectory (literalOsPath "dir")
+			Just k <- Annex.WorkTree.lookupKey (toOsPath annexedfile)
-			let initps =
+			return (fromJust $ M.lookup uuid rs, k)
-				[ "foo"
+		let key = if scheme `elem` ["hybrid","pubkey"]
-				, "type=directory"
+			then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
-				, "encryption=" ++ scheme
+			else Nothing
-				, "directory=dir"
+		testEncryptedRemote gpgcmd environ scheme key c [k] @? "invalid crypto setup"
-				, "highRandomQuality=false"
-				] ++ if scheme `elem` ["hybrid","pubkey"]
-					then ["keyid=" ++ Utility.Gpg.testKeyId]
-					else []
-			git_annex' "initremote" initps (Just environ) "initremote"
-			git_annex_shouldfail' "initremote" initps (Just environ) "initremote should not work when run twice in a row"
-			git_annex' "enableremote" initps (Just environ) "enableremote"
-			git_annex' "enableremote" initps (Just environ) "enableremote when run twice in a row"
-			git_annex' "get" [annexedfile] (Just environ) "get of file"
-			annexed_present annexedfile
-			git_annex' "copy" [annexedfile, "--to", "foo"] (Just environ) "copy --to encrypted remote"
-			(c,k) <- annexeval $ do
-				uuid <- Remote.nameToUUID "foo"
-				rs <- Logs.Remote.readRemoteLog
-				Just k <- Annex.WorkTree.lookupKey (toOsPath annexedfile)
-				return (fromJust $ M.lookup uuid rs, k)
-			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"
 	
-			annexed_present annexedfile
+		annexed_present annexedfile
-			git_annex' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop"
+		git_annex' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop"
-			annexed_notpresent annexedfile
+		annexed_notpresent annexedfile
-			git_annex' "move" [annexedfile, "--from", "foo"] (Just environ) "move --from encrypted remote"
+		git_annex' "move" [annexedfile, "--from", "foo"] (Just environ) "move --from encrypted remote"
-			annexed_present annexedfile
+		annexed_present annexedfile
-			git_annex_shouldfail' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop should not be allowed with numcopies=2"
+		git_annex_shouldfail' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop should not be allowed with numcopies=2"
-			annexed_present annexedfile
+		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]
+	git_annex_shouldfail "initremote" ["baz", "type=directory", "encryption=shared", "onlyencryptcreds=yes", dirparam]
-		"initremote"
+		"initremote with onlyencryptcreds not allowed with shared encryption"
-	git_annex_shouldfail "enableremote" ["baz", "onlyencryptcreds=no", dirparam]
+	git_annex_shouldfail "initremote" ["baz", "type=directory", "encryption=none", "onlyencryptcreds=yes", dirparam]
-		"enableremote disabling onlyencryptcreds"
+		"initremote with onlyencryptcreds not allowed with no encryption"
-	git_annex "enableremote" ["baz", "onlyencryptcreds=yes", dirparam]
+#ifndef mingw32_HOST_OS
-		"enableremote enabling already enabled onlyencryptcreds"
+	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]
+			(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]]