Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Haskell is getting deadlocked in a situation it (in theory) shouldn't be

The following yields a deadlock error message (* Exception: thread blocked indefinitely in an MVar operation). I've thought it through step by step, and I don't see the issue.

  • On the main thread, a MVar is created, and given to producer, running on a new thread
  • producer starts, and blocks at listenOn, waiting for a connection
  • The main thread continues into the loop, and blocks, waiting for the MVar to receive something
  • Once producer gets a connection, it continues into it's loop, and after receiving something from the socket, puts it into the MVar

Meaning (as far as I understand it), it should end up with producer putting something in the MVar, and main waiting to receive something.

If it's getting stuck because listenOn doesn't connect immediately, how can I get around this? The MVar needs to be created in main, and before producer is forked so it can be passed in.

import Control.Concurrent

import Network
import Network.Socket

import System.IO

getSockInfo :: Socket -> IO String
getSockInfo s = do
        info <- getPeerName s
        return $ case info of
            (SockAddrInet port addr) -> "Addr/Port: " ++ (show addr) ++ " / " ++ (show port)
            (SockAddrInet6 port flow addr scope) ->
                "Addr/Port: " ++ (show addr) ++ " / " ++ (show port) ++ "Flow/Scope: " ++ (show flow) ++ " / " ++ (show scope)

producer :: MVar String -> IO ()
producer m = do
    s <- listenOn (PortNumber 5555)
    putStrLn "Listening..."
    info <- getSockInfo s
    putStrLn $ "Connected to " ++ info
    h <- socketToHandle s ReadMode
    loop h m
    where loop h m = do
        message <- hGetLine h
        putMVar m message
        loop h m

main :: IO ()
main = do
    withSocketsDo $ do
        m <- newEmptyMVar
        prod <- forkIO $ producer m
        loop m
        where loop m = do
            n <- takeMVar m
            print n
            loop m
like image 345
Carcigenicate Avatar asked Jul 26 '14 22:07

Carcigenicate


1 Answers

listenOn returns immediately but doesn't give you a connected socket, so attempts to use it or read from it fail. I'm not sure why you aren't seeing an error message to indicate that, since I do when I run your code. In any case the listening thread is probably dying at that point, which leaves the main thread deadlocked as nothing can write to the MVar.

Using accept after listenOn to wait for a remote connection should fix this.

like image 52
GS - Apologise to Monica Avatar answered Sep 29 '22 19:09

GS - Apologise to Monica