Commit bbbf03ed authored by Simon Marlow's avatar Simon Marlow

Fix #3128: file descriptor leak when hClose fails

parent 7f97d9d8
......@@ -80,15 +80,17 @@ import Control.Monad
hClose :: Handle -> IO ()
hClose h@(FileHandle _ m) = do
mb_exc <- hClose' h m
case mb_exc of
Nothing -> return ()
Just e -> hClose_rethrow e h
hClose_maybethrow mb_exc h
hClose h@(DuplexHandle _ r w) = do
mb_exc1 <- hClose' h w
mb_exc2 <- hClose' h r
case (do mb_exc1; mb_exc2) of
Nothing -> return ()
Just e -> hClose_rethrow e h
case mb_exc1 of
Nothing -> return ()
Just e -> hClose_maybethrow mb_exc2 h
hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
hClose_maybethrow Nothing h = return ()
hClose_maybethrow (Just e) h = hClose_rethrow e h
hClose_rethrow :: SomeException -> Handle -> IO ()
hClose_rethrow e h =
......
......@@ -503,7 +503,7 @@ mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
-> Bool -- buffered?
-> Maybe TextEncoding
-> NewlineMode
-> (Maybe HandleFinalizer)
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
......@@ -606,17 +606,26 @@ getEncoding (Just te) ha_type = do
-- ---------------------------------------------------------------------------
-- closing Handles
-- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
-- or an IO error occurs on a lazy stream. The semi-closed Handle is
-- then closed immediately. We have to be careful with DuplexHandles
-- though: we have to leave the closing to the finalizer in that case,
-- because the write side may still be in use.
-- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
-- EOF is read or an IO error occurs on a lazy stream. The
-- semi-closed Handle is then closed immediately. We have to be
-- careful with DuplexHandles though: we have to leave the closing to
-- the finalizer in that case, because the write side may still be in
-- use.
hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help handle_ =
case haType handle_ of
ClosedHandle -> return (handle_,Nothing)
_ -> do flushWriteBuffer handle_ -- interruptible
hClose_handle_ handle_
_ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
-- it is important that hClose doesn't fail and
-- leave the Handle open (#3128), so we catch
-- exceptions when flushing the buffer.
(h_, mb_exc2) <- hClose_handle_ handle_
return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
trymaybe :: IO () -> IO (Maybe SomeException)
trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_handle_ Handle__{..} = do
......@@ -629,9 +638,7 @@ hClose_handle_ Handle__{..} = do
-- raise it if necessary.
maybe_exception <-
case haOtherSide of
Nothing -> (do IODevice.close haDevice; return Nothing)
`catchException` \e -> return (Just e)
Nothing -> trymaybe $ IODevice.close haDevice
Just _ -> return Nothing
-- free the spare buffers
......
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