hGetBuf (or something related) broken for 6.2 with sockets

[George Russell]

I have just installed ghc6.2 on Linux. (I had to compile it from source because the
binaries insist on a glibc version we don't have.)

The attached module contains two functions (serverMain) and (clientMain).
clientMain opens a connection (to localhost) and sends some data along it,
then executes hFlush.
serverMain receives this data.  They should display identical data.

This should be run by (1) compiling the code using
 > ghc Server.hs -c
(2) starting up ghci in this directory, twice, in separate terminal windows.
(3) in both ghci's doing
 > :module Server
(4) in one ghci doing
 > serverMain
(5) in the other ghci doing
 > clientMain

What happens is
(a) the serverMain ghci displays "Iterating" several times.  This is because
hGetBuf appears to be terminating prematurely when there is still data to come
on the socket.  This is a pain (especially as I took several hours finding this
was why my program didn't work), but at least it can be worked around, and the code
in the module does this.
(b) The server module only gets part of the data.  In fact for me it comes to a stop
with
[239][240][241][242][243Iterating
despite there being more data to come.  (And despite the fact that the client has
done hFlush).

I don't know any way of working around (b), so I suspect that means ghc6.2 is unusable
for us.  What a pity no development snapshot was made for 6.2 shortly before its
release, as it might have been possible for me to discover this bug in time for it
to be fixed in 6.2.    (I did try to test the 6.3 development snapshot but was
grounded by the instances bug I've reported elsewhere.)

-------------- next part --------------
module Server where

import Char
import IO
import Random
import Monad

import Network
import GHC.IO(hPutBuf,hGetBuf)
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Ptr


maxLen = (2000 :: Int)


port = PortNumber 11394
host = "localhost"

writeInt :: Handle -> Int -> IO ()
writeInt handle i = hPutStrLn handle (show i)

readInt :: Handle -> IO Int
readInt handle =
   do
      l <- hGetLine handle
      return (read l)

runClient :: Ptr CChar -> Handle -> IO ()
runClient ptr handle =
   do
      mapM_
         (\ _ ->
            writeOut ptr maxLen handle
            >> mapM_       
               (\ toWrite -> writeOut ptr toWrite handle                  
                  )
               [1..255]
            )
         [1..4]
      hFlush handle

writeOut :: Ptr CChar -> Int -> Handle -> IO ()
writeOut ptr toWrite handle =
   do
      putStr ("["++show toWrite)
      hFlush stdout
      writeInt handle toWrite
      hPutBuf handle ptr toWrite
      putStr ("]")
      hFlush stdout

getChars :: Handle -> Ptr CChar -> Int -> IO ()
getChars handle ptr 0 = return ()
getChars handle ptr toRead =
   do
      read <- hGetBuf handle ptr toRead
      if (read == 0) 
         then
            error ("Unexpected EOF") else return ()
      if read < toRead
         then
             putStrLn "Iterating" >> hFlush stdout >>
                getChars handle (plusPtr ptr read) (toRead - read)
         else
             return ()
 

readIn :: Ptr CChar -> Handle -> IO ()
readIn ptr handle =
   do
      toRead <- readInt handle
      putStr ("["++show toRead)
      hFlush stdout
      getChars handle ptr toRead
      putStr "]"
      hFlush stdout

runServer :: Ptr CChar -> Handle -> IO ()
runServer ptr handle =
   do
      readIn ptr handle
      runServer ptr handle

clientMain =
   do
      ptr <- mallocBytes maxLen
      handle <- connectTo host port
      runClient ptr handle
      
serverMain =
   do
      ptr <- mallocBytes maxLen
      socket <- listenOn port
      (handle,hostName,_) <- accept socket
      runServer ptr handle