Merge branch 'sigpipe' into 'master'

ignore SIGPIPE to prevent server from crash when writing to broken pipes (TCP connections or pipes to child processes) & fix race condition in implementation of 'externalProcess'

See merge request !333

Libraries/iTasks/Internal/TaskServer.icl

@@ -2,7 +2,7 @@ implementation module iTasks.Internal.TaskServer
 
 import Data.Functor
 import Data.Map => qualified updateAt
-import Data.Tuple
+import Data.Tuple, Data.Func
 import StdEnv
 import System.CommandLine
 import System.Time
@@ -72,10 +72,12 @@ where
 
 	installSignalHandlers iworld=:{signalHandlers,world}
 		= case signalInstall SIGTERM world of
-			(Error (_, e), world) = abort ("Couldn't install SIGTERM: " +++ e)
+			(Error (_, e), world) = abort $ concat ["Couldn't install SIGTERM: ", e, "\n"]
 			(Ok h1, world) = case signalInstall SIGINT world of
-				(Error (_, e), world) = abort ("Couldn't install SIGINT: " +++ e)
-				(Ok h2, world) = {iworld & signalHandlers=[h1,h2:signalHandlers], world=world}
+				(Error (_, e), world) = abort $ concat ["Couldn't install SIGINT: ", e, "\n"]
+				(Ok h2, world) = case signalIgnore SIGPIPE world of
+					(Error (_, e), world) = abort $ concat ["Couldn't ignore SIGPIPE: ", e, "\n"]
+					(Ok _, world) = {iworld & signalHandlers=[h1,h2:signalHandlers], world=world}
 
 loop :: !(*IWorld -> (Maybe Timeout,*IWorld)) !*IWorld -> *IWorld
 loop determineTimeout iworld=:{ioTasks,sdsNotifyRequests,signalHandlers}

Libraries/iTasks/WF/Tasks/IO.icl

@@ -71,13 +71,26 @@ where
 			liftOSErr (checkProcess ph)                 >-= \mexitcode->case mexitcode of
 				(Just i) = tuple (Ok (ValueResult (Value i True) (mkTaskEvalInfo lastEval) (mkUIIfReset event rep) (treturn i)))
 				Nothing =
-					readRegister taskId clock                            >-= \_->
-					readRegister taskId sdsin                            >-= \(ReadingDone stdinq)->
-					liftOSErr (writePipe (concat stdinq) pio.stdIn)      >-= \_->
-					(if (stdinq =: []) (tuple (Ok WritingDone)) (write [] sdsin EmptyContext)) >-= \WritingDone ->
+					readRegister taskId clock >-= \_->
+					readRegister taskId sdsin >-= \(ReadingDone stdinq)->
+					if (stdinq =: [])
+						(tuple $ Ok WritingDone)
+						(	// the process might have terminated since `checkProcess`,
+							// for this case we ignore the EPIPE error and handle termination at next task evaluation
+							liftOSErr (writePipeNoErrorOnBrokenPipe (concat stdinq) pio.stdIn) >-= \_ ->
+							write [] sdsin EmptyContext
+						)
+					>-= \WritingDone ->
 					tuple (Ok (ValueResult NoValue (mkTaskEvalInfo lastEval) (mkUIIfReset event rep)
 						(Task (eval (ph, pio)))))
 
+	writePipeNoErrorOnBrokenPipe :: !String !WritePipe !*World -> (!MaybeOSError (), !*World)
+	writePipeNoErrorOnBrokenPipe str pipe world
+		# (res, world)= writePipe str pipe world
+		= case res of
+			Error (32, _) = (Ok (), world)
+			res           = (res,   world)
+
 	rep = stringDisplay ("External process: " <+++ cmd)
 	clock = sdsFocus {start=zero,interval=poll} iworldTimespec