Commit 1bc0bbc7 authored by Mart Lubbers's avatar Mart Lubbers

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
parents c64d44fb bac6eb71
Pipeline #30600 passed with stage
in 5 minutes and 44 seconds
......@@ -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}
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment