author  Wuzzy <almikes@aol.com> 
Wed, 13 Apr 2016 02:44:37 +0200  
changeset 11726  4addfad422ab 
parent 11046  47a8c19ecb60 
child 13079  81c154fd4380 
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 
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)"] 