openConnection and openConnectionSSL leak file descriptors on connect failures #44

Open
twittner opened this Issue Sep 12, 2013 · 5 comments

Comments

Projects
None yet
3 participants
@twittner

When attempting to open a connection to an address which can be successfully resolved but not connected to openConnection and openConnectionSSL leave the file descriptor belonging to the socket open.

Test-case:

module Main where

import Control.Exception
import Network.Http.Client
import qualified System.IO.Streams as S

main :: IO ()
main = sequence_
     . take 2048
     . repeat $ handle (\e -> print (e :: IOException))
         (get "http://localhost:60000" (\_ i -> S.connect i S.stdout))

One has to handle exceptions within openConnection* to ensure the socket is closed, e.g.

diff --git a/src/Network/Http/Connection.hs b/src/Network/Http/Connection.hs
index d2eb1a4..d1078ce 100644
--- a/src/Network/Http/Connection.hs
+++ b/src/Network/Http/Connection.hs
@@ -39,7 +39,7 @@ import Blaze.ByteString.Builder (Builder)
 import qualified Blaze.ByteString.Builder as Builder (flush, fromByteString,
                                                       toByteString)
 import qualified Blaze.ByteString.Builder.HTTP as Builder (chunkedTransferEncoding, chunkedTransferTerminator)
-import Control.Exception (bracket)
+import Control.Exception (bracket, bracketOnError, onException)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as S
 import Data.Monoid (mappend, mempty)
@@ -176,19 +176,18 @@ openConnection h1' p = do
     is <- getAddrInfo (Just hints) (Just h1) (Just $ show p)
     let addr = head is
     let a = addrAddress addr
-    s <- socket (addrFamily addr) Stream defaultProtocol
-
-    connect s a
-    (i,o1) <- Streams.socketToStreams s
-
-    o2 <- Streams.builderStream o1
-
-    return Connection {
-        cHost  = h2',
-        cClose = close s,
-        cOut   = o2,
-        cIn    = i
-    }
+    bracketOnError (socket (addrFamily addr) Stream defaultProtocol) close $ \s -> do
+        connect s a
+
+        (i, o1) <- Streams.socketToStreams s
+        o2      <- Streams.builderStream o1
+
+        return Connection {
+            cHost  = h2',
+            cClose = close s,
+            cOut   = o2,
+            cIn    = i
+        }
   where
     hints = defaultHints {addrFlags = [AI_ADDRCONFIG, AI_NUMERICSERV]}
     h2' = if p == 80
@@ -234,21 +233,20 @@ openConnectionSSL ctx h1' p = do
         f = addrFamily $ head is
     s <- socket f Stream defaultProtocol

-    connect s a
-
-    ssl <- SSL.connection ctx s
-    SSL.connect ssl
+    connect s a `onException` (close s)

-    (i,o1) <- Streams.sslToStreams ssl
+    bracketOnError (SSL.connection ctx s) (closeSSL s) $ \ssl -> do
+        SSL.connect ssl

-    o2 <- Streams.builderStream o1
+        (i, o1) <- Streams.sslToStreams ssl
+        o2      <- Streams.builderStream o1

-    return Connection {
-        cHost  = h2',
-        cClose = closeSSL s ssl,
-        cOut   = o2,
-        cIn    = i
-    }
+        return Connection {
+            cHost  = h2',
+            cClose = closeSSL s ssl,
+            cOut   = o2,
+            cIn    = i
+        }
   where
     h2' :: ByteString
     h2' = if p == 443

@ghost ghost assigned afcowie Nov 10, 2013

@afcowie

This comment has been minimized.

Show comment
Hide comment
@afcowie

afcowie Mar 3, 2014

Owner

Finally have some time. Will be looking at this this week.

Owner

afcowie commented Mar 3, 2014

Finally have some time. Will be looking at this this week.

@afcowie

This comment has been minimized.

Show comment
Hide comment
@afcowie

afcowie Jul 3, 2014

Owner

Now I finally have some time. :/ Will be looking at this this week, and you can expect this addressed in 0.7.3

Owner

afcowie commented Jul 3, 2014

Now I finally have some time. :/ Will be looking at this this week, and you can expect this addressed in 0.7.3

@afcowie afcowie modified the milestones: v0.7., v0.7.3 Jul 3, 2014

@joamaki

This comment has been minimized.

Show comment
Hide comment
@joamaki

joamaki Jul 25, 2014

Any progress on this?

joamaki commented Jul 25, 2014

Any progress on this?

@afcowie

This comment has been minimized.

Show comment
Hide comment
@afcowie

afcowie Sep 23, 2014

Owner

I'm hammering on an IPv6 problem that may or may not be cause by this part of the code. Either way, I've hacking on http-streams this week.

Owner

afcowie commented Sep 23, 2014

I'm hammering on an IPv6 problem that may or may not be cause by this part of the code. Either way, I've hacking on http-streams this week.

@afcowie afcowie modified the milestones: 0.8.1, v0.7.3 Jan 20, 2015

@afcowie afcowie removed this from the 0.8.1 milestone Apr 18, 2016

@afcowie

This comment has been minimized.

Show comment
Hide comment
@afcowie

afcowie Jun 1, 2017

Owner

Maybe relevant to #105

Owner

afcowie commented Jun 1, 2017

Maybe relevant to #105

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment