async exception safety for openFd

Audited for openFile and openFd, and this fixes all the ones I found
where an async exception could prevent the file getting closed.

Except for the lock pool, which is a whole other can of worms.

Annex/Init.hs

@@ -230,7 +230,7 @@ probeLockSupport = withEventuallyCleanedOtherTmp $ \tmp -> do
   where
 	go f mode = do
 		nukeFile f
-		let locktest = 
+		let locktest = mask $ const $
 			Posix.lockExclusive (Just mode) f
 				>>= Posix.dropLock
 		ok <- isRight <$> tryNonAsync locktest

Annex/LockPool/PosixOrPid.hs

@@ -94,4 +94,5 @@ tryPidLock m f posixlock = debugLocks $ liftIO . go =<< pidLockFile
 -- avoid complicating any code that might expect to be able to see that
 -- lock file. But, it's not locked.
 dummyPosixLock :: Maybe FileMode -> LockFile -> IO ()
-dummyPosixLock m f = closeFd =<< openLockFile ReadLock m f
+dummyPosixLock m f = mask $ const $
+	closeFd =<< openLockFile ReadLock m f

Utility/LockFile/PidLock.hs

@@ -174,12 +174,13 @@ linkToLock (Just _) src dest = do
 				, return False
 				)
 		Left _ -> catchBoolIO $ do
-			fd <- openFd dest WriteOnly
-				(Just $ combineModes readModes)
-				(defaultFileFlags {exclusive = True})
-			h <- fdToHandle fd
-			readFile src >>= hPutStr h
-			hClose h
+			let setup = do
+				fd <- openFd dest WriteOnly
+					(Just $ combineModes readModes)
+					(defaultFileFlags {exclusive = True})
+				fdToHandle fd
+			let cleanup = hClose
+			bracket setup cleanup (\h -> readFile src >>= hPutStr h)
 			return True
   where
 	checklinked = do

Utility/LockFile/Posix.hs

@@ -58,7 +58,7 @@ lock lockreq mode lockfile = do
 
 -- Tries to take an lock, but does not block.
 tryLock :: LockRequest -> Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
-tryLock lockreq mode lockfile = do
+tryLock lockreq mode lockfile = mask $ const $ do
 	l <- openLockFile lockreq mode lockfile
 	v <- tryIO $ setLock l (lockreq, AbsoluteSeek, 0, 0)
 	case v of
@@ -92,14 +92,17 @@ getLockStatus lockfile = do
 		Just (Just pid) -> StatusLockedBy pid
 
 getLockStatus' :: LockFile -> IO (Maybe (Maybe ProcessID))
-getLockStatus' lockfile = go =<< catchMaybeIO open
+getLockStatus' lockfile = bracket open close go
   where
-	open = openLockFile ReadLock Nothing lockfile
-	go Nothing = return Nothing
+	open = catchMaybeIO $ openLockFile ReadLock Nothing lockfile
+
+	close (Just h) = closeFd h
+	close Nothing = return ()
+
 	go (Just h) = do
 		v <- getLock h (ReadLock, AbsoluteSeek, 0, 0)
-		closeFd h
 		return (Just (fmap fst v))
+	go Nothing = return Nothing
 
 dropLock :: LockHandle -> IO ()
 dropLock (LockHandle fd) = closeFd fd

doc/todo/more_extensive_retries_to_mask_transient_failures/comment_15_f371b5cbb216967d803dfa04707e6ba2._comment

@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 15"""
+ date="2020-06-05T19:00:07Z"
+ content="""
+Some progress: All threads that `async` or `forkOS` starts are now
+confirmed to get shut down when an async exception reaches the code that
+uses them. All uses of SomeException are confirmed to not catch async
+exceptions. All file opening is confirmed to bracket and close (except for
+the lock pool).
+
+Still to do:
+
+* process things noted in comment #13
+* data structures that get modified while an action is running and need
+  to be cleaned up on an async exception (eg the lock pool)
+"""]]