author | sheepluva |
Sat, 03 Dec 2016 09:09:16 +0100 | |
changeset 12103 | 966a9739812f |
parent 11046 | 47a8c19ecb60 |
child 13084 | 81c154fd4380 |
permissions | -rw-r--r-- |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
1 |
{- |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
2 |
* Hedgewars, a free turn based strategy game |
11046 | 3 |
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
4 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
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:
10212
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:
10212
diff
changeset
|
7 |
* the Free Software Foundation; version 2 of the License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
8 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
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:
10212
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:
10212
diff
changeset
|
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
12 |
* GNU General Public License for more details. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
13 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
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:
10212
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:
10212
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:
10212
diff
changeset
|
17 |
\-} |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
18 |
|
8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset
|
19 |
{-# LANGUAGE OverloadedStrings, CPP #-} |
1804 | 20 |
module HWProtoNEState where |
21 |
||
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
22 |
import Control.Monad.Reader |
10076 | 23 |
import qualified Data.ByteString.Lazy as BL |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
24 |
import qualified Data.ByteString.Char8 as B |
10076 | 25 |
import Data.Digest.Pure.SHA |
1804 | 26 |
-------------------------------------- |
27 |
import CoreTypes |
|
28 |
import Utils |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
29 |
import RoomsAndClients |
10212 | 30 |
import HandlerUtils |
1804 | 31 |
|
4989 | 32 |
handleCmd_NotEntered :: CmdHandler |
1804 | 33 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
34 |
handleCmd_NotEntered ["NICK", newNick] = do |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
35 |
(ci, irnc) <- ask |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
36 |
let cl = irnc `client` ci |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset
|
37 |
if not . B.null $ nick cl then return [ProtocolError $ loc "Nickname already chosen"] |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
38 |
else |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset
|
39 |
if illegalName newNick then return [ByeClient $ loc "Illegal nickname"] |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
40 |
else |
4991 | 41 |
return $ |
42 |
ModifyClient (\c -> c{nick = newNick}) : |
|
43 |
AnswerClients [sendChan cl] ["NICK", newNick] : |
|
44 |
[CheckRegistered | clientProto cl /= 0] |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
45 |
|
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
46 |
handleCmd_NotEntered ["PROTO", protoNum] = do |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
47 |
(ci, irnc) <- ask |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
48 |
let cl = irnc `client` ci |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset
|
49 |
if clientProto cl > 0 then return [ProtocolError $ loc "Protocol already known"] |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
50 |
else |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset
|
51 |
if parsedProto == 0 then return [ProtocolError $ loc "Bad number"] |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
52 |
else |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
53 |
return $ |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
54 |
ModifyClient (\c -> c{clientProto = parsedProto}) : |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4991
diff
changeset
|
55 |
AnswerClients [sendChan cl] ["PROTO", showB parsedProto] : |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
56 |
[CheckRegistered | not . B.null $ nick cl] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
57 |
where |
5090 | 58 |
parsedProto = readInt_ protoNum |
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset
|
59 |
|
3536 | 60 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
61 |
handleCmd_NotEntered ["PASSWORD", passwd] = do |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
62 |
(ci, irnc) <- ask |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
63 |
let cl = irnc `client` ci |
1879 | 64 |
|
10076 | 65 |
if clientProto cl < 48 && passwd == webPassword cl then |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
66 |
return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"] | isAdministrator cl] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
67 |
else |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
68 |
return [ByeClient "Authentication failed"] |
1879 | 69 |
|
1804 | 70 |
|
10076 | 71 |
handleCmd_NotEntered ["PASSWORD", passwd, clientSalt] = do |
72 |
(ci, irnc) <- ask |
|
73 |
let cl = irnc `client` ci |
|
74 |
||
75 |
let clientHash = h [clientSalt, serverSalt cl, webPassword cl, showB $ clientProto cl, "!hedgewars"] |
|
76 |
let serverHash = h [serverSalt cl, clientSalt, webPassword cl, showB $ clientProto cl, "!hedgewars"] |
|
77 |
||
78 |
if passwd == clientHash then |
|
10077 | 79 |
return [ |
10076 | 80 |
AnswerClients [sendChan cl] ["SERVER_AUTH", serverHash] |
10077 | 81 |
, JoinLobby |
82 |
] |
|
10076 | 83 |
else |
84 |
return [ByeClient "Authentication failed"] |
|
85 |
where |
|
86 |
h = B.pack . showDigest . sha1 . BL.fromChunks |
|
87 |
||
8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset
|
88 |
#if defined(OFFICIAL_SERVER) |
8371 | 89 |
handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do |
90 |
(ci, irnc) <- ask |
|
91 |
let cl = irnc `client` ci |
|
92 |
||
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset
|
93 |
if parsedProto == 0 then return [ProtocolError $ loc "Bad number"] |
8371 | 94 |
else |
95 |
return $ [ |
|
96 |
ModifyClient (\c -> c{clientProto = parsedProto, nick = newNick, webPassword = password, isChecker = True}) |
|
97 |
, CheckRegistered] |
|
98 |
where |
|
99 |
parsedProto = readInt_ protoNum |
|
8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset
|
100 |
#endif |
8371 | 101 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
102 |
handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"] |