Network/Notwork?

[C.Reinke]

> >     - 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
        -> PortID 		-- Port Identifier
        -> IO Handle		-- Connected Socket

connectTo hostname (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)  -- only done if there's an error
        (\sock -> do
            he <- getHostByName hostname
            connect sock (SockAddrInet port (hostAddress he))
            socketToHandle sock ReadWriteMode
      )