[GHC] #14621: GHC 8.2 GCed too early

[GHC]

#14621: GHC 8.2 GCed too early
-------------------------------------+-------------------------------------
        Reporter:  kazu-yamamoto     |                Owner:  (none)
            Type:  bug               |               Status:  upstream
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.2.2
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------
Changes (by bgamari):

 * status:  new => upstream


Old description:

> The network package uses mkWeakVar so that unreachable Sockets can be
> GCed. See the master branch of https://github.com/haskell/network
>
> {{{
> mkSocket :: CInt
>          -> Family
>          -> SocketType
>          -> ProtocolNumber
>          -> SocketStatus
>          -> IO Socket
> mkSocket fd fam sType pNum stat = do
>    mStat <- newMVar stat
>    withSocketsDo $ return ()
>    let sock = Socket fd fam sType pNum mStat
> ##if MIN_VERSION_base(4,6,0)
>    _ <- mkWeakMVar mStat $ close sock
> ##endif
>    return sock
> }}}
>
> The following code cause "threadWait: invalid argument (Bad file
> descriptor)" in accept:
>
> {{{
> module Main where
>
> import Control.Concurrent (forkIO)
> import Control.Monad (void, forever)
> import Network.Socket hiding (recv)
> import Network.Socket.ByteString (recv, sendAll)
>
> main :: IO ()
> main = do
>     let localhost = "localhost"
>         listenPort = "9876"
>         connectPort = "6789"
>     proxy localhost listenPort connectPort
>
> proxy :: HostName -> ServiceName -> ServiceName -> IO ()
> proxy localhost listenPort connectPort = do
>     fromClient <- serverSocket localhost listenPort
>     toServer <- clientSocket localhost connectPort
>     void $ forkIO $ relay toServer fromClient
>     relay fromClient toServer
>
> relay :: Socket -> Socket -> IO ()
> relay s1 s2 = forever $ do
>     payload <- recv s1 4096
>     sendAll s2 payload
>
> serverSocket :: HostName -> ServiceName -> IO Socket
> serverSocket host port = do
>     let hints = defaultHints {
>                 addrFlags = [AI_PASSIVE]
>               , addrSocketType = Stream
>               }
>     addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)
>     sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol
> addr)
>     bind sock (addrAddress addr)
>     listen sock 1
>     fst <$> accept sock
>
> clientSocket :: HostName -> ServiceName -> IO Socket
> clientSocket host port = do
>     let hints = defaultHints { addrSocketType = Stream }
>     addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)
>     sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol
> addr)
>     connect sock (addrAddress addr)
>     return sock
> }}}
>
> GC frees sock while accepting. This occurs with GHC 8.2 or higher.

New description:

 The network package uses mkWeakVar so that unreachable Sockets can be
 GCed. See the master branch of https://github.com/haskell/network

 {{{#!hs
 mkSocket :: CInt
          -> Family
          -> SocketType
          -> ProtocolNumber
          -> SocketStatus
          -> IO Socket
 mkSocket fd fam sType pNum stat = do
    mStat <- newMVar stat
    withSocketsDo $ return ()
    let sock = Socket fd fam sType pNum mStat
 ##if MIN_VERSION_base(4,6,0)
    _ <- mkWeakMVar mStat $ close sock
 ##endif
    return sock
 }}}

 The following code cause "threadWait: invalid argument (Bad file
 descriptor)" in accept:

 {{{#!hs
 module Main where

 import Control.Concurrent (forkIO)
 import Control.Monad (void, forever)
 import Network.Socket hiding (recv)
 import Network.Socket.ByteString (recv, sendAll)

 main :: IO ()
 main = do
     let localhost = "localhost"
         listenPort = "9876"
         connectPort = "6789"
     proxy localhost listenPort connectPort

 proxy :: HostName -> ServiceName -> ServiceName -> IO ()
 proxy localhost listenPort connectPort = do
     fromClient <- serverSocket localhost listenPort
     toServer <- clientSocket localhost connectPort
     void $ forkIO $ relay toServer fromClient
     relay fromClient toServer

 relay :: Socket -> Socket -> IO ()
 relay s1 s2 = forever $ do
     payload <- recv s1 4096
     sendAll s2 payload

 serverSocket :: HostName -> ServiceName -> IO Socket
 serverSocket host port = do
     let hints = defaultHints {
                 addrFlags = [AI_PASSIVE]
               , addrSocketType = Stream
               }
     addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)
     sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol
 addr)
     bind sock (addrAddress addr)
     listen sock 1
     fst <$> accept sock

 clientSocket :: HostName -> ServiceName -> IO Socket
 clientSocket host port = do
     let hints = defaultHints { addrSocketType = Stream }
     addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)
     sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol
 addr)
     connect sock (addrAddress addr)
     return sock
 }}}

 GC frees sock while accepting. This occurs with GHC 8.2 or higher.

--

Comment:

 This actually appears to be a bug in the `network` library which has been
 exposed by more aggressive optimization by GHC. Specifically, `accept`
 doesn't ensure that the `Socket`'s `status` field is kept alive while the
 `accept` system call is underway. Consequently the GC correctly concludes
 that it can be collected.

 I have opened [[https://github.com/haskell/network/issues/287|network
 #287]] to track this.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14621#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler