gameServer/NetRoutines.hs
author Wuzzy <Wuzzy2@mail.ru>
Thu, 25 Apr 2019 23:01:05 +0200
changeset 14844 e239378a9400
parent 11860 ad435d95ca4b
permissions -rw-r--r--
Prevent entering “/”, “\” and “:” in team and scheme names. The name of teams and schems is saved in the file name itself, so these characters would cause trouble as they are used in path names in Linux and Windows.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10912
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    14
 * You should have received a copy of the GNU General Public License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    15
 * along with this program; if not, write to the Free Software
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10093
diff changeset
    18
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    19
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
module NetRoutines where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
import Network.Socket
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
import Control.Concurrent.Chan
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
import Data.Time
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    25
import Control.Monad
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
    26
import Data.Unique
10076
b235e520ea21 Mutual authentication: server side
unc0rr
parents: 9528
diff changeset
    27
import qualified Codec.Binary.Base64 as Base64
b235e520ea21 Mutual authentication: server side
unc0rr
parents: 9528
diff changeset
    28
import qualified Control.Exception as E
b235e520ea21 Mutual authentication: server side
unc0rr
parents: 9528
diff changeset
    29
import System.Entropy
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
-----------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
import CoreTypes
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1847
diff changeset
    32
import Utils
10076
b235e520ea21 Mutual authentication: server side
unc0rr
parents: 9528
diff changeset
    33
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    35
acceptLoop :: Socket -> Chan CoreMessage -> IO ()
10912
5b8d8ecef5a8 Catch exceptions in accept() call
unc0rr
parents: 10460
diff changeset
    36
acceptLoop servSock chan = E.bracket openHandle closeHandle (forever . f)
10076
b235e520ea21 Mutual authentication: server side
unc0rr
parents: 9528
diff changeset
    37
    where
10912
5b8d8ecef5a8 Catch exceptions in accept() call
unc0rr
parents: 10460
diff changeset
    38
    f ch = E.try (Network.Socket.accept servSock) >>= \v -> case v of
5b8d8ecef5a8 Catch exceptions in accept() call
unc0rr
parents: 10460
diff changeset
    39
      Left (e :: E.IOException) -> return ()
5b8d8ecef5a8 Catch exceptions in accept() call
unc0rr
parents: 10460
diff changeset
    40
      Right (sock, sockAddr) -> do
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    41
        clientHost <- sockAddr2String sockAddr
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    43
        currentTime <- getCurrentTime
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    44
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    45
        sendChan' <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
    47
        uid <- newUnique
11860
ad435d95ca4b - Use sandi instead of dataenc (bugs.debian.org/836686)
unc0rr
parents: 11561
diff changeset
    48
        salt <- liftM Base64.encode $ hGetEntropy ch 18
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
    49
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    50
        let newClient =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    51
                (ClientInfo
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
    52
                    uid
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    53
                    sendChan'
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    54
                    sock
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    55
                    clientHost
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    56
                    currentTime
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    57
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    58
                    ""
10076
b235e520ea21 Mutual authentication: server side
unc0rr
parents: 9528
diff changeset
    59
                    salt
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    60
                    False
8372
3c193ec03e09 Logon procedure for checkers, introduce invisible clients
unc0rr
parents: 8371
diff changeset
    61
                    False
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    62
                    0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    63
                    0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    64
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    65
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    66
                    False
7757
c20e6c80e249 Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents: 5209
diff changeset
    67
                    False
8245
d1a830c304c7 Change room name if room admin is kicked
unc0rr
parents: 7766
diff changeset
    68
                    False
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 8245
diff changeset
    69
                    False
9109
878f06e9c484 - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents: 8897
diff changeset
    70
                    False
9435
59eec19cb31a 'c' flag for contributors
unc0rr
parents: 9109
diff changeset
    71
                    False
11469
a9957113404a Allow only one query per session
unc0rr
parents: 11046
diff changeset
    72
                    False
11472
f2c36df8c7b1 Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents: 11471
diff changeset
    73
                    False
4986
33fe91b2bcbf Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents: 4932
diff changeset
    74
                    Nothing
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8372
diff changeset
    75
                    Nothing
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10078
diff changeset
    76
                    newEventsInfo
ada172d33988 More work on flood detector
unc0rr
parents: 10078
diff changeset
    77
                    newEventsInfo
ada172d33988 More work on flood detector
unc0rr
parents: 10078
diff changeset
    78
                    newEventsInfo
4987
cf9470964dba Use 'undefined' less (replace with default values and 'error')
unc0rr
parents: 4986
diff changeset
    79
                    0
11471
4b5c7a5c49fd Defer kicking to the time when everything is in consistent state
unc0rr
parents: 11469
diff changeset
    80
                    []
11561
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11472
diff changeset
    81
                    []
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    82
                    )
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    83
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    84
        writeChan chan $ Accept newClient
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    85
        return ()