- using hFlush does *not* seem to cure the problem??
That's worrying, and it perhaps indicates that there's another problem
somewhere. I just tried a small test and hFlush does appear to do the
right thing, so do you think you could boil down your example to
something small that demonstrates the problem? Does it happen only on
Windows, or Un*x too?
Windows only, of course!-) On Solaris, I never even noticed there
might be a problem (it seems to work even without acknowledgment or
hFlush..).
I append my current test MyNetwork module - server and client are
the main functions of the respective apps, nothing else going on, so
it's very small, but for modified copies of some of the Network code
(for use on windows, you'll want to change to the other definition
of whatsWrong and uncomment c_getLastError).
On solaris (ghc version 5.04), this seems to work as shown. On win2k
(ghc version 5.04), with error reporting on, I get:
$ ./server.exe
[1] 1388
tcp: 6
$ ./client.exe huhuadsfas
tcp: 6
CLIENT: huhuadsfas
WSAGetLastError: 10054
Fail: failed
Action: hGetLine
Handle: {loc=socket: 140,type=duplex
(read-write),binary=True,buffering=line}
Reason: No error
File: socket: 140
[1]+ Exit 1 ./server.exe
(on win98, not even the tcp number would be correct, hence the
hardcoded 6). The 10054 error from the hGetLine is the Connection
reset by peer.-message I mentioned earlier.
So it seems that on windows, when the client terminates, the
connection goes down and the server fails when trying to get the
message. Whereas on solaris, the message gets through anyway.
Uncommenting the hFlush in the client makes no difference
whatsoever. Uncomment the acknowledgement in client and server
instead, and it works like a charm (although it does require an
asymmetry between the two processes - I have to know which one
lives longer..).
Over to you,
Claus
--
module MyNetwork where
import System(system,getArgs)
import IO(hPutStrLn
,hGetLine
,hClose
,hFlush
,hSetBuffering
,BufferMode(..)
,IOMode(..)
,Handle)
import Control.Exception as Exception
import Foreign
import Foreign.C
import Network hiding (listenOn,connectTo)
import Network.BSD(getProtocolNumber,getHostByName,hostAddress)
import Network.Socket(Family(..)
,SocketType(..)
,SockAddr(..)
,SocketOption(..)
,socket
,sClose
,setSocketOption
,bindSocket
,listen
,connect
,socketToHandle
,iNADDR_ANY
,maxListenQueue
)
server :: IO ()
server = withSocketsDo $ do
s - listenOn $ PortNumber 9000
loop s
where
loop s = do
l - getInput s
putStrLn $ SERVER: ++l
loop s
getInput s = do
(h,host,portnr) - accept s
hSetBuffering h LineBuffering
l - whatsWrong $ hGetLine h
-- hPutStrLn h ack
-- hClose h -- not a good idea?
return l
client :: IO ()
client = withSocketsDo $ do
args - getArgs
h - connectTo localhost $ PortNumber 9000
hSetBuffering h LineBuffering
let l = unwords args
putStrLn $ CLIENT: ++l
hPutStrLn h l
-- hFlush h
-- hGetLine h -- wait for acknowledgement
return ()
{- only for winsock
foreign import stdcall unsafe WSAGetLastError
c_getLastError :: IO CInt
-}
{-
-- does this exist?
foreign import ccall unsafe getWSErrorDescr
c_getWSError :: CInt - IO (Ptr CChar)
-}
whatsWrong act = act
{-
whatsWrong act =
Exception.catch act
(\e- do
errCode - c_getLastError
--perr - c_getWSError errCode
--err - peekCString perr
putStrLn $ WSAGetLastError: ++show errCode
throw e)
-}
listenOn :: PortID -- ^ Port Identifier
- IO Socket -- ^ Connected Socket
listenOn (PortNumber port) = do
proto - getProtocolNumber tcp
putStrLn $ tcp: ++show proto
let proto = 6 -- bug in ghc's getProtocolNumber..
bracketOnError
(whatsWrong (socket AF_INET Stream proto))
(sClose)
(\sock - do
setSocketOption sock ReuseAddr 1
bindSocket sock (SockAddrInet port iNADDR_ANY)
listen sock maxListenQueue
return sock
)
bracketOnError
:: IO a -- ^ computation to run first (\acquire resource\)
- (a - IO b) -- ^ computation to run last (\release resource\)
- (a - IO c)-- ^ computation to run in-between
- IO c -- returns the value from the in-between computation
bracketOnError before after thing =
block (do
a - before
r - Exception.catch
(unblock (thing a))
(\e - do { after a; throw e })
return r
)
connectTo :: HostName -- Hostname
-
