gameServer/NetRoutines.hs
author nemo
Sat, 13 Nov 2010 08:55:58 -0500
branch0.9.14
changeset 4273 4035d5b78eeb
parent 4242 5e3c5fe2cb14
child 4295 1f5604cd99be
permissions -rw-r--r--
merge (stupid reflexive pull -u)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
     1
{-# LANGUAGE ScopedTypeVariables #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
module NetRoutines where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
     4
import Network
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Network.Socket
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import System.IO
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
     7
import Control.Concurrent
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Control.Concurrent.Chan
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
     9
import Control.Concurrent.STM
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2245
diff changeset
    10
import qualified Control.Exception as Exception
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Data.Time
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
-----------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import CoreTypes
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    14
import ClientIO
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1847
diff changeset
    15
import Utils
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    17
acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    18
acceptLoop servSock coreChan clientCounter = do
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    19
    Exception.handle
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    20
        (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    21
        do
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    22
        (socket, sockAddr) <- Network.Socket.accept servSock
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    24
        cHandle <- socketToHandle socket ReadWriteMode
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    25
        hSetBuffering cHandle LineBuffering
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    26
        clientHost <- sockAddr2String sockAddr
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    28
        currentTime <- getCurrentTime
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    29
        
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    30
        sendChan <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    32
        let newClient =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    33
                (ClientInfo
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    34
                    nextID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    35
                    sendChan
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    36
                    cHandle
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    37
                    clientHost
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    38
                    currentTime
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    39
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    40
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    41
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    42
                    0
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    43
                    0
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    44
                    0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    45
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    46
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    47
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    48
                    undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    49
                    undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    50
                    )
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    52
        writeChan coreChan $ Accept newClient
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    53
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    54
        forkIO $ clientRecvLoop cHandle coreChan nextID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    55
        forkIO $ clientSendLoop cHandle coreChan sendChan nextID
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    56
        return ()
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    57
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    58
    acceptLoop servSock coreChan nextID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    59
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3502
diff changeset
    60
        nextID = clientCounter + 1