Fix test failure on NFS when cleaning up gpg temp directory

Using removePathForcibly avoids concurrent removal problems.

The i386ancient build still uses an old version of ghc and directory that
do not include removePathForcibly though.

Sponsored-by: Dartmouth College's Datalad project

CHANGELOG

@@ -8,6 +8,7 @@ git-annex (10.20220323) UNRELEASED; urgency=medium
     the user makes manually, and push them out to remotes promptly.
   * multicast: Support uftp 5.0 by switching from aes256-cbc to
     aes256-gcm.
+  * Fix test failure on NFS when cleaning up gpg temp directory.
 
  -- Joey Hess <id@joeyh.name>  Mon, 28 Mar 2022 14:46:10 -0400
 

Test/Framework.hs

@@ -264,7 +264,7 @@ isolateGitConfig a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do
 
 removeDirectoryForCleanup :: FilePath -> IO ()
 #if MIN_VERSION_directory(1,2,7)
- removeDirectoryForCleanup = removePathForcibly
+removeDirectoryForCleanup = removePathForcibly
 #else
 removeDirectoryForCleanup = removeDirectoryRecursive
 #endif

Utility/Tmp/Dir.hs

@@ -1,6 +1,6 @@
 {- Temporary directories
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -63,8 +63,17 @@ removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
 	-- after a process has just written to it and exited.
 	-- Because it's crap, presumably. So, ignore failure
 	-- to delete the temp directory.
-	_ <- tryIO $ removeDirectoryRecursive tmpdir
+	_ <- tryIO $ go tmpdir
 	return ()
 #else
-	removeDirectoryRecursive tmpdir
+	go tmpdir
+#endif
+  where
+  	-- Use removePathForcibly when available, to avoid crashing
+	-- if some other process is removing files in the directory at the
+	-- same time.
+#if MIN_VERSION_directory(1,2,7)
+	go = removePathForcibly
+#else
+	go = removeDirectoryRecursive
 #endif

doc/bugs/sporadic___40____63____41___fail_of_crypto_test__63__/comment_2_a254c4de61a74bf314eb33e301c199f0._comment

@@ -0,0 +1,26 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2022-04-19T16:49:26Z"
+ content="""
+That is a *very* strange message! Because the list is all
+ExitSuccess, but before the code to check that message can run,
+it checks that the list is not `all (== ExitSuccess)`
+
+It should not be possible for a list without an ExitFailure in it to
+get past that check. And it certainly does not normally.
+
+And looking at the log, one of the tests *did* fail:
+
+	    crypto:                                   FAIL
+	      Exception: /tmp/gpgtmpSgOEyq/2/S.gpg-agent.ssh: removeDirectoryRecursive:removeContentsRecursive:removePathRecursive:removeContentsRecursive:removePathRecursive:getSymbolicLinkStatus: does not exist (No such file or directory)
+
+So there must have been an `ExitFailure 1` in the list, even though it
+somehow ends up displaying as containing all `ExitSuccess`. Almost as if
+the content of the list changed. But it cannot, barring a bug in the
+haskell runtime..
+
+As far as the cause of that failure, it should be fixable by using 
+removePathForcibly rather than removeDirectoryRecursive in removeTmpDir.
+I've made that change.
+"""]]