Network problem with ghc on WinXP

[robin abraham]

Hi,

I have ghc-6.0.1 on WinXP and Solaris. I have a simple echo server (server.hs 
given below) and client (client.hs given below) and I encounter the following:
1) server.hs compiled and running on Solaris:
   a) client.hs (Solaris) can connect.
   b) client.hs (WinXP) cannot connect.  
   c) telnet (WinXP) can connect.
   d) telnet (Solaris) can connect.
   e) Scan of port 3000 shows server is listening.
   
2) server.hs compiled and running on WinXP:
   a) client.hs (Solaris) cannot connect.
   b) client.hs (WinXP) can connect.
   c) telnet (WinXP) cannot connect.
   d) telnet (Solaris) cannot connect.
   e) Scan of ports does not show server.
   
Basically, when the server is running on WinXP, only the Haskell program 
client.hs (also running on the same WinXP machine) can "converse" with it 
through the socket connection. To verify this, I wrote a client in C# - from the 
WinXP machine, it can connect to server running on my Solaris machine but not to 
server on the same WinXP machine.

Why isn't the server program on WinXP not behaving itself? Any help/guidance 
would be highly appreciated.

Thank you.
Robin.

-- server.hs
module Main where

import SocketPrim
import Concurrent
import System (getArgs,exitFailure)
import Exception(finally)
import MVar
import IO

server_sock :: IO (Socket)
server_sock = do
    s <- socket AF_INET Stream 6
    setSocketOption s ReuseAddr 1
    bindSocket s (SockAddrInet (PortNum portnum) iNADDR_ANY)
    listen s 2
    return s

echo_server :: Socket -> IO ()
echo_server s = do
    (s', clientAddr) <- accept s
    h <- socketToHandle s' ReadWriteMode
    proc <- read_data s' 0
    putStrLn ("server processed "++(show proc)++" bytes")
    sClose s'
    where
        read_data sock totalbytes = do
            str <- recv sock 18
            putStrLn ("Server recv: " ++ str)
            if ((length str) >= 18) 
                then do
                    putStrLn ("Server read: " ++ str)
                    writ <- send sock str
                    putStrLn ("Server wrote: " ++ str)
                    read_data sock $! (totalbytes+(length $! str))
                else do
                    putStrLn ("server read: " ++ str)
                    return totalbytes

message     = "Hello there sailor"
portnum     = 3000

main = withSocketsDo $ do {
    ~[n] <- getArgs;
    ssock <- server_sock; 
    s <- myForkIO (echo_server ssock);
    join s;
    putStrLn "join s";
    }

myForkIO :: IO () -> IO (MVar ())
myForkIO io = do
    mvar <- newEmptyMVar
    forkIO (io `finally` putMVar mvar ())
    return mvar

join :: MVar () -> IO ()
join mvar = readMVar mvar

-- end of server.hs

-- ***********************************************

-- client.hs

module Main where

import SocketPrim
import Concurrent
import System (getArgs,exitFailure)
import Exception(finally)
import MVar
import IO

local       = "128.193.39.108" 
message     = "Hello there sailor"
portnum     = 3000

client_sock = do
    s <- socket AF_INET Stream 6
    ia <- inet_addr local
    connect s (SockAddrInet (PortNum portnum) ia)
    return s

echo_client n = do
    s <- client_sock
    drop <- server_echo s n
    sClose s
    where
        server_echo sock n = if n > 0
            then do 
                send sock message
                putStrLn ("Client wrote: " ++ message)
                str <- recv sock 19
                if (str /= message)
                    then do
                        putStrLn ("Client read error: " ++ str)
                        exitFailure
                    else do
                        putStrLn ("Client read success")
                        server_echo sock (n-1)
            else do 
                putStrLn "Client read nil"
                return []

main = withSocketsDo $ do  
    ~[n] <- getArgs
    c <- myForkIO (echo_client (read n::Int))
    join c
    putStrLn "join c"
    
myForkIO :: IO () -> IO (MVar ())
myForkIO io = do
    mvar <- newEmptyMVar
    forkIO (io `finally` putMVar mvar ())
    return mvar

join :: MVar () -> IO ()
join mvar = readMVar mvar

-- end of client.hs