[Haskell-cafe] network-conduit failing to close sockets
Michael Snoyman
michael at snoyman.com
Wed Feb 1 17:45:36 CET 2012
2012/2/1 Felipe Almeida Lessa <felipe.lessa at gmail.com>:
> 2012/2/1 Ertugrul Söylemez <es at ertes.de>:
>> Hello there,
>>
>> I have tried to implement a simple echo server using the network-conduit
>> library version 0.2.1. This is the code:
>>
>> module Main where
>>
>> import Data.Conduit
>> import Data.Conduit.Network
>>
>> main :: IO ()
>> main = runTCPServer (ServerSettings 4000 Nothing) ($$)
>>
>> It works, but at some point it dies with too many open files, even
>> though I never open two connections simultaneously:
>>
>> % ./echo-server
>> echo-server: accept: resource exhausted (Too many open files)
>>
>> Apparently it fails to close the sockets properly. This is the client
>> side code I have used for testing in GHCi:
>>
>> > :m Network Control.Monad System.IO
>> > replicateM_ 512 (connectTo "127.0.0.1" (PortNumber 4000) >>=
>> hClose)
>>
>> I'm running the action once, then wait a few seconds to give the server
>> a chance to close the handles. Then I run it again, causing the server
>> program to die with the above mentioned error message.
>>
>> Am I doing something wrong or is this a bug in network-conduit?
>
> This part of network-conduit is very new so bugs are expected.
> Michael, it seems that runTCPServer [1] should setup a release key on
> the ResourceT in order to close the socket after app finishes, right?
>
> Cheers! =)
>
> [1] http://hackage.haskell.org/packages/archive/network-conduit/0.2.1/doc/html/src/Data-Conduit-Network.html#runTCPServer
>
> --
> Felipe.
Good catch, thanks guys. New version released.
Note: there was the same bug in runTCPClient, the new test suite
checks for both.
Michael
More information about the Haskell-Cafe
mailing list