Revert "async exception safety for coprocesses"

This reverts commit 7013798df5.

CHANGELOG

@@ -25,6 +25,8 @@ git-annex (8.20200618) UNRELEASED; urgency=medium
     git configs with -c. (Since version 8.20200330.)
   * Bring back git-annex branch read cache. This speeds up some operations;
     git-annex sync --content --all gets 20% faster.
+  * Fix a recently introduced bug that could cause a "fork: resource exhausted"
+    after getting several thousand files.
 
  -- Joey Hess <id@joeyh.name>  Thu, 18 Jun 2020 12:21:14 -0400
 

Utility/CoProcess.hs

@@ -1,7 +1,7 @@
 {- Interface for running a shell command as a coprocess,
  - sending it queries and getting back results.
  -
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2013 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -62,46 +62,28 @@ stop ch = do
 	let p = proc (coProcessCmd $ coProcessSpec s) (coProcessParams $ coProcessSpec s)
 	forceSuccessProcess p (coProcessPid s)
 
-{- Note that concurrent queries are not safe to perform; caller should
- - serialize calls to query.
- -
- - To handle a restartable process, any IO exception thrown by the send and
+{- To handle a restartable process, any IO exception thrown by the send and
  - receive actions are assumed to mean communication with the process
- - failed, and the query is re-run with a new process.
- -
- - If an async exception is received during a query, the state of
- - communication with the process is unknown, so it is killed, and a new
- - one started so the CoProcessHandle can continue to be used by other
- - threads.
- -}
+ - failed, and the failed action is re-run with a new process. -}
 query :: CoProcessHandle -> (Handle -> IO a) -> (Handle -> IO b) -> IO b
-query ch send receive = uninterruptibleMask $ \unmask ->
-	unmask (readMVar ch >>= restartable)
-		`catchAsync` forcerestart
+query ch send receive = do
+	s <- readMVar ch
+	restartable s (send $ coProcessTo s) $ const $
+		restartable s (hFlush $ coProcessTo s) $ const $
+			restartable s (receive $ coProcessFrom s)
+				return
   where
-	go s = do
-		void $ send $ coProcessTo s
-		hFlush $ coProcessTo s
-		receive $ coProcessFrom s
-	
-	restartable s
+	restartable s a cont
 		| coProcessNumRestarts (coProcessSpec s) > 0 =
-			catchMaybeIO (go s)
-				>>= maybe (restart s increstarts restartable) return
-		| otherwise = go s
-	
-	increstarts s = s { coProcessNumRestarts = coProcessNumRestarts s - 1 }
-
-	restart s f cont = do
-		void $ tryNonAsync $ do
+			maybe restart cont =<< catchMaybeIO a
+		| otherwise = cont =<< a
+	restart = do
+		s <- takeMVar ch
+		void $ catchMaybeIO $ do
 			hClose $ coProcessTo s
 			hClose $ coProcessFrom s
 		void $ waitForProcess $ coProcessPid s
-		s' <- withMVarMasked ch $ \_ -> start' (f (coProcessSpec s))
-		cont s'
-
-	forcerestart ex = do
-		s <- readMVar ch
-		terminateProcess (coProcessPid s)
-		restart s id $ \s' -> void $ swapMVar ch s'
-		either throwM throwM ex
+		s' <- start' $ (coProcessSpec s)
+			{ coProcessNumRestarts = coProcessNumRestarts (coProcessSpec s) - 1 }
+		putMVar ch s'
+		query ch send receive

Utility/Exception.hs

@@ -1,6 +1,6 @@
 {- Simple IO exception handling (and some more)
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2016 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -20,7 +20,6 @@ module Utility.Exception (
 	bracketIO,
 	catchNonAsync,
 	tryNonAsync,
-	catchAsync,
 	tryWhenExists,
 	catchIOErrorType,
 	IOErrorType(..),
@@ -88,14 +87,6 @@ catchNonAsync a onerr = a `catches`
 	, M.Handler (\ (e :: SomeException) -> onerr e)
 	]
 
-{- Catches only async exceptions. -}
-catchAsync :: MonadCatch m => m a -> (Either AsyncException SomeAsyncException -> m a) -> m a
-catchAsync a onerr = a `catches`
-	[ M.Handler (\ (e :: AsyncException) -> onerr (Left e))
-	, M.Handler (\ (e :: SomeAsyncException) -> onerr (Right e))
-	, M.Handler (\ (e :: SomeException) -> throwM e)
-	]
-
 tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
 tryNonAsync a = go `catchNonAsync` (return . Left)
   where

doc/bugs/resource_exhausted_at_end_of_100k_files_copy.mdwn

@@ -29,3 +29,12 @@ without a problem. --[[Joey]]
 > > is restarting git hash-object due to an IO exception:
 > > "fd:12: hPutStr: illegal operation (handle is closed)
 > > I can't see anything that would close the handle early.
+> > 
+> > Reverted [[!commit 7013798df5a161f00962985ffaea613a87cc4fe4]]
+> > on a hunch, and that seems to have fixed it. Which is very weird,
+> > because AFAICS it was not getting an async exception. Even 
+> > removing the `catchAsync forcerestart` is enough to avoid the problem
+> > though.
+> >
+> > [[fixed|done]] though without full understanding of what that commit
+> > did that caused such strange behavior. --[[Joey]]

doc/todo/more_extensive_retries_to_mask_transient_failures/comment_13_6e5fb676ae08026abeb500d01ab86414._comment

@@ -4,7 +4,7 @@
  date="2020-06-04T19:39:23Z"
  content="""
 I've converted everything to withCreateProcess, except for process pools
-(P2P.IO, Assistant.TransferrerPool, Utility.CoProcess (update: done),
+(P2P.IO, Assistant.TransferrerPool, Utility.CoProcess,
 Remote.External (update: done),
 and P2PSshConnectionPool), which need to be handled as discussed in
 comment 8. And also Git.Command.pipeReadLazy may (or may not) need to be