Concurrency problems with Handle

[Arie Peterson]

Hello,


After many hours of vain debugging, I suspect that GHC might not do what I 
think it should do.


I made a module 'Telnet', exporting one function 'telnet', which takes a 
handle (an established connection) and returns an input channel, an output 
channel and a function to close the connection and clean up.
The 'telnet' function creates two channels (input and output), one MVar and 
two threads:
   * One thread takes chars from the output channel and writes them into 
the handle.
   * The other thread reads chars from the handle and puts them in the 
input channel.
   * The MVar regulates writing access to the handle: the reader thread 
sometimes has to respond to telnet commands, but those responses must not 
be interspersed with ordinary data.


Now, if I let one side of the connection send some characters:
   sequence_ $ take 10 $ repeat $ (writeChan outputChan 's')
and I let the other side consume them:
   sequence_ $ take 10 $ repeat $ (putChar =<< readChan inputChan)
then the characters are sent and received correctly, but the receiving side 
shows the characters only after the connection is closed.

If I let both sides send and consume characters in turn, like this:
   sequence_ $ take 10 $ repeat $ threadDelay 250 >> (writeChan outputChan 
's') >> (putChar =<< readChan inputChan)
and
   sequence_ $ take 10 $ repeat $ (putChar =<< readChan inputChan) >> 
threadDelay 250 >> (writeChan outputChan 'c')
, one character is sent, and the other end waits indefinitely before 
sending his character.


Maybe some buffering mechanism is holding my characters?
I already tried hFlush and setting buffering to NoBuffering on all handles.

Could it have anything to with this?
"One final note: the aaaa bbbb example may not work too well on GHC (see 
Scheduling, above), due to the locking on a Handle. Only one thread may 
hold the lock on a Handle at any one time, so if a reschedule happens while 
a thread is holding the lock, the other thread won't be able to run. The 
upshot is that the switch from aaaa to bbbbb happens infrequently. It can 
be improved by lowering the reschedule tick period. We also have a patch 
that causes a reschedule whenever a thread waiting on a lock is woken up, 
but haven't found it to be useful for anything other than this example :-)" 
(http://haskell.org/ghc/docs/latest/html/libraries/base/Control.Concurrent.html#11)

I tried all this both in compiled and interactive mode with GHC 6.0 and 6.2 
on Windows 2000.

Thanks for your time.

Arie Peterson

Telnet.hs, with many superfluous debugging output:
###
module Telnet (telnet) where

import Control.Concurrent (forkIO,killThread)
import Control.Concurrent.Chan (Chan,newChan,readChan,writeChan)
import Control.Concurrent.MVar (MVar,newMVar,takeMVar,putMVar)
import System.IO (Handle,hGetChar,hPutChar)

telnet :: Handle -> IO (Chan Char,Chan Char,IO ())
telnet handle = do
   inputChan <- newChan
   outputChan <- newChan
   writing <- newMVar ()
   readerId <- forkIO $ reader handle inputChan  writing
   writerId <- forkIO $ writer handle outputChan writing
   return
     (
       inputChan,
       outputChan,
       do -- function to close connection
         takeMVar writing
         hPutChar handle '\255' -- IAC
         hPutChar handle '\244' -- IP (Interrupt Process)
         killThread readerId
         killThread writerId
     )

reader :: Handle -> Chan Char -> MVar () -> IO ()
reader handle inputChan writing = sequence_ . repeat $ do
   putStrLn "Telnet.reader: waiting for char in handle"
   c <- hGetChar handle
   putStrLn ("Telnet.reader: received " ++ show c)
   case c of
     '\255' -> hGetChar handle >>= \c -> putStrLn ("Telnet.reader: received 
" ++ show c) >> case c of
       '\255' -> writeChan inputChan '\255' -- escaped IAC
       '\254' -> respond '\253'          -- received DONT, send WONT
       '\253' -> respond '\254'          -- received WONT, send DONT
       '\252' -> respond '\253'          -- received DO, send WONT
       '\251' -> respond '\254'          -- received WILL, send DONT
       _      -> return ()               -- received unknown command, ignore
     c      -> writeChan inputChan c
    where
     respond c = do
       d <- hGetChar handle
       putStrLn ("Telnet.reader: received " ++ show d ++ ", responding")
       takeMVar writing
       hPutChar handle '\255'
       hPutChar handle c
       hPutChar handle d
       putMVar writing ()

writer :: Handle -> Chan Char -> MVar () -> IO ()
writer handle outputChan writing = sequence_ . repeat $ do
   putStrLn "Telnet.writer: waiting for character in chan"
   c <- readChan outputChan
   putStrLn ("Telnet.writer: going to write: " ++ show c)
   takeMVar writing
   case c of
     '\255' -> hPutChar handle '\255' >> hPutChar handle '\255' -- escaped IAC
     _      -> hPutChar handle c
   putMVar writing ()
   putStrLn ("Telnet.writer: written: " ++ show c)