author  Wuzzy <Wuzzy2@mail.ru> 
Mon, 21 Jan 2019 19:28:39 +0100  
changeset 14648  be8af70adf2c 
parent 13835  acb8b5530aa8 
permissions  rwrr 
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) 20042015 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 021101301 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 
13081
dce9f0b84a18
Change misleading server error message about nicknames
Wuzzy <Wuzzy2@mail.ru>
parents:
13079
diff
changeset

37 
if not . B.null $ nick cl then return [ProtocolError $ loc "Nickname already provided."] 
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 
13079
81c154fd4380
More userfriendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
11046
diff
changeset

39 
if illegalName newNick then return [ByeClient $ loc "Illegal nickname! Nicknames must be between 140 characters long, must not have a trailing or leading space and must not have any of these characters: $()*+?[]^{}"] 
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 
13079
81c154fd4380
More userfriendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
11046
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 
13079
81c154fd4380
More userfriendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
11046
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 
13673
1aa5e884326a
Fix some string/translation inconsistencies in strings related to leaving
Wuzzy <Wuzzy2@mail.ru>
parents:
13081
diff
changeset

68 
 String is parsed by frontend, do not localize! 
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

69 
return [ByeClient "Authentication failed"] 
1879  70 

1804  71 

10076  72 
handleCmd_NotEntered ["PASSWORD", passwd, clientSalt] = do 
73 
(ci, irnc) < ask 

74 
let cl = irnc `client` ci 

75 

76 
let clientHash = h [clientSalt, serverSalt cl, webPassword cl, showB $ clientProto cl, "!hedgewars"] 

77 
let serverHash = h [serverSalt cl, clientSalt, webPassword cl, showB $ clientProto cl, "!hedgewars"] 

78 

79 
if passwd == clientHash then 

10077  80 
return [ 
10076  81 
AnswerClients [sendChan cl] ["SERVER_AUTH", serverHash] 
10077  82 
, JoinLobby 
83 
] 

10076  84 
else 
13673
1aa5e884326a
Fix some string/translation inconsistencies in strings related to leaving
Wuzzy <Wuzzy2@mail.ru>
parents:
13081
diff
changeset

85 
 String is parsed by frontend, do not localize! 
10076  86 
return [ByeClient "Authentication failed"] 
87 
where 

88 
h = B.pack . showDigest . sha1 . BL.fromChunks 

89 

8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset

90 
#if defined(OFFICIAL_SERVER) 
8371  91 
handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do 
92 
(ci, irnc) < ask 

93 
let cl = irnc `client` ci 

94 

13079
81c154fd4380
More userfriendly server messages
Wuzzy <Wuzzy2@mail.ru>
parents:
11046
diff
changeset

95 
if parsedProto == 0 then return [ProtocolError $ loc "Bad number."] 
8371  96 
else 
97 
return $ [ 

98 
ModifyClient (\c > c{clientProto = parsedProto, nick = newNick, webPassword = password, isChecker = True}) 

99 
, CheckRegistered] 

100 
where 

101 
parsedProto = readInt_ protoNum 

8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset

102 
#endif 
8371  103 

13826
07b3dacd00f8
gameServer: Always report command name if getting an incorrect command
Wuzzy <Wuzzy2@mail.ru>
parents:
13673
diff
changeset

104 
handleCmd_NotEntered (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: not entered)"] 
13835  105 

106 
handleCmd_NotEntered [] = return [ProtocolError "Empty command (state: not entered)"] 