Clean up pipes early on failed forks
authorKlaus Aehlig <aehlig@google.com>
Mon, 4 May 2015 12:43:52 +0000 (14:43 +0200)
committerKlaus Aehlig <aehlig@google.com>
Mon, 4 May 2015 13:18:01 +0000 (15:18 +0200)
...so that we do not accumulate open file descriptors.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Petr Pudlak <pudlak@google.com>

src/Ganeti/Query/Exec.hs

index 8e7ca06..b64b78d 100644 (file)
@@ -62,6 +62,7 @@ module Ganeti.Query.Exec
 
 import Control.Concurrent (rtsSupportsBoundThreads)
 import Control.Concurrent.Lifted (threadDelay)
+import Control.Exception (finally)
 import Control.Monad
 import Control.Monad.Error
 import Data.Functor
@@ -194,8 +195,9 @@ runJobProcess jid s = withErrorLogAt CRITICAL (show jid) $
 forkWithPipe :: ConnectConfig -> (Client -> IO ()) -> IO (ProcessID, Client)
 forkWithPipe conf childAction = do
   (master, child) <- pipeClient conf
-  pid <- forkProcess (closeClient master >> childAction child)
-  closeClient child
+  pid <- finally
+           (forkProcess (closeClient master >> childAction child))
+           $ closeClient child
   return (pid, master)
 
 -- | Forks the job process and starts processing of the given job.