[GHC] #1114: Socket code dies with SIGPIPE

[GHC]

#1114: Socket code dies with SIGPIPE
---------------------------+------------------------------------------------
    Reporter:  guest       |       Owner:       
        Type:  bug         |      Status:  new  
    Priority:  normal      |   Milestone:       
   Component:  hslibs/net  |     Version:  6.6  
    Severity:  normal      |    Keywords:       
  Difficulty:  Unknown     |    Testcase:       
Architecture:  x86         |          Os:  Linux
---------------------------+------------------------------------------------
GHC socket / IO handle code dies with SIGPIPE.

 Debian Etch
 {{{
 #!sh
 $ uname -a
 Linux alien 2.6.19.1y #7 Mon Dec 25 20:48:36 EET 2006 i686 GNU/Linux

 $ cat /etc/debian_version
 4.0

 $ ghc --version
 The Glorious Glasgow Haskell Compilation System, version 6.6
 }}}

 Test program and strace output are here:

 http://linux.ee/~mzz/ghcpipebug/

 {{{
 #!Makefile
 run: tttd
         strace ./tttd &
         sleep 1
         echo -n | nc -q 0 127.0.0.1 3372; echo -n | nc -q 0 127.0.0.1 3372
         sleep 1

 tttd: tttd.hs
         ghc -o $@ $+ -package network

 clean:
         rm -f tttd *.hi *.o
 }}}

 {{{
 #!hs
 import Control.Concurrent
 import Network
 import System.IO

 -- it won't SIGPIPE, when you comment second hPrint
 player h hOther otherTh = evil >> hClose h
     where evil = hPrint h 13 >> hPrint h 42

 doAccept sock =
      do (h1, _, _) <- accept sock
         (h2, _, _) <- accept sock
         hSetBuffering h1 LineBuffering
         hSetBuffering h2 LineBuffering
         forkIO $ myThreadId >>= forkIO . player h2 h1 >>= player h1 h2
         threadDelay 500000
         hPutStrLn stderr "OK?"

 main = withSocketsDo $ listenOn (PortNumber $ fromIntegral 3372) >>=
 doAccept
 }}}

 {{{
 #!text
 select(0, [], [], NULL, {0, 0})         = 0 (Timeout)
 write(4, "13\n", 3)                     = 3
 gettimeofday({1169512958, 393628}, NULL) = 0
 select(0, [], [], NULL, {0, 0})         = 0 (Timeout)
 write(5, "13\n", 3)                     = 3
 write(5, "42\n", 3)                     = 3
 close(5)                                = 0
 gettimeofday({1169512958, 393914}, NULL) = 0
 select(0, [], [], NULL, {0, 0})         = 0 (Timeout)
 write(4, "42\n", 3)                     = -1 EPIPE (Broken pipe)
 --- SIGPIPE (Broken pipe) @ 0 (0) ---
 +++ killed by SIGPIPE +++
 Process 3541 detached
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/1114>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler