hReady and hWaitForInput block under Windows
While using a Network.Socket converted to a Handle with socketToHandle, calling hReady or hWaitForInput on that handle will block.
This happens within ghci or when compiled with -threaded and executed with "+RTS -N2 -RTS" options.
I've attached a simple server.hs file that listens on a port. Once a client connects it loops until hReady returns true - then it will read from the port. Load it in gchi and execute something like:
servNumber "11333"
I've also attached a quick client.hs module to load in ghci to send data to the port. Load it in ghci and execute something like:
s1 <- openServer "localhost" "11333"
write2Server "blash" s1
Here's the code.
server.hs
import Network.Socket
import Control.Concurrent
import System.IO
-- main = servNumber "11333"
servNumber :: String -> IO ()
servNumber port = withSocketsDo $ do
addrInfos <- getAddrInfo
(Just (defaultHints {addrFlags = [AI_PASSIVE]}))
Nothing (Just port)
let serveraddr = head addrInfos
sock <- socket (addrFamily serveraddr) Stream defaultProtocol
bindSocket sock (addrAddress serveraddr)
listen sock 5
procIncoming sock
where
procIncoming :: Socket -> IO ()
procIncoming masterSock = do
(conSock, _) <- accept masterSock
forkIO $ doWork conSock
procIncoming masterSock
doWork :: Socket -> IO ()
doWork conSock = do
h <- socketToHandle conSock ReadWriteMode
hSetBuffering h LineBuffering
loop h
loop :: Handle -> IO ()
loop h = do
putStrLn "Calling hReady."
ready <- hReady h
--ready <- hWaitForInput h 1
if ready
then hGetLine h >>= putStrLn >> loop h
else loop h
client.hs
import Network.Socket
import Control.Concurrent
import System.IO
openServer :: String -> String -> IO (Handle)
openServer hostname port = withSocketsDo $ do
addrinfos <- getAddrInfo Nothing (Just hostname) (Just port)
let serveraddr = head addrinfos
sock <- socket (addrFamily serveraddr) Stream defaultProtocol
connect sock (addrAddress serveraddr)
h <- socketToHandle sock ReadWriteMode
hSetBuffering h LineBuffering
return h
write2Server :: String -> Handle -> IO ()
write2Server msg h = do
hPutStrLn h msg
hFlush h
closeServer :: Handle -> IO ()
closeServer h = hClose h
Trac metadata
Trac field | Value |
---|---|
Version | 6.12.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | libraries/base |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |