author | Wuzzy <almikes@aol.com> |
Wed, 13 Apr 2016 03:04:24 +0200 | |
changeset 11734 | 2d57eed66d41 |
parent 11580 | db7743e2fad1 |
child 11979 | 1d07f4ceb8c6 |
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 |
|
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
|
19 |
{-# LANGUAGE OverloadedStrings #-} |
1804 | 20 |
module HWProtoCore where |
21 |
||
4612 | 22 |
import Control.Monad.Reader |
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
|
23 |
import Data.Maybe |
4612 | 24 |
import qualified Data.ByteString.Char8 as B |
1804 | 25 |
-------------------------------------- |
26 |
import CoreTypes |
|
27 |
import HWProtoNEState |
|
28 |
import HWProtoLobbyState |
|
29 |
import HWProtoInRoomState |
|
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8478
diff
changeset
|
30 |
import HWProtoChecker |
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
|
31 |
import HandlerUtils |
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
|
32 |
import RoomsAndClients |
4612 | 33 |
import Utils |
1804 | 34 |
|
4989 | 35 |
handleCmd, handleCmd_loggedin :: CmdHandler |
1804 | 36 |
|
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
|
37 |
|
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 |
handleCmd ["PING"] = answerClient ["PONG"] |
1804 | 39 |
|
40 |
||
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
|
41 |
handleCmd ("QUIT" : xs) = return [ByeClient msg] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
42 |
where |
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8396
diff
changeset
|
43 |
msg = if not $ null xs then head xs else loc "bye" |
1804 | 44 |
|
4568 | 45 |
|
4612 | 46 |
handleCmd ["PONG"] = do |
47 |
cl <- thisClient |
|
48 |
if pingsQueue cl == 0 then |
|
8897
d6c310c65c91
- Revert server workaround over desync from r98e2dbdda8c0
unc0rr
parents:
8547
diff
changeset
|
49 |
return [ProtocolError "Protocol violation"] |
4612 | 50 |
else |
51 |
return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})] |
|
4568 | 52 |
|
11054
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
53 |
handleCmd cmd = do |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
54 |
(ci, irnc) <- ask |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
55 |
let cl = irnc `client` ci |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
56 |
if logonPassed cl then |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
57 |
if isChecker cl then |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
58 |
handleCmd_checker cmd |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
59 |
else |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
60 |
handleCmd_loggedin cmd |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
61 |
else |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
62 |
handleCmd_NotEntered cmd |
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
63 |
|
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
64 |
|
6e575b29881c
Check for CMD message a bit further down the control flow
unc0rr
parents:
11046
diff
changeset
|
65 |
handleCmd_loggedin ["CMD", parameters] = uncurry h $ extractParameters parameters |
8396 | 66 |
where |
9105 | 67 |
h "DELEGATE" n | not $ B.null n = handleCmd ["DELEGATE", n] |
10195 | 68 |
h "SAVEROOM" n | not $ B.null n = handleCmd ["SAVEROOM", n] |
69 |
h "LOADROOM" n | not $ B.null n = handleCmd ["LOADROOM", n] |
|
11580 | 70 |
h "SAVE" n | not $ B.null n = let (sn, ln) = B.break (== ' ') n in if B.null ln then return [] else handleCmd ["SAVE", sn, B.tail ln] |
10194 | 71 |
h "DELETE" n | not $ B.null n = handleCmd ["DELETE", n] |
9105 | 72 |
h "STATS" _ = handleCmd ["STATS"] |
73 |
h "PART" m | not $ B.null m = handleCmd ["PART", m] |
|
74 |
| otherwise = handleCmd ["PART"] |
|
75 |
h "QUIT" m | not $ B.null m = handleCmd ["QUIT", m] |
|
76 |
| otherwise = handleCmd ["QUIT"] |
|
77 |
h "RND" p = handleCmd ("RND" : B.words p) |
|
11472
f2c36df8c7b1
Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents:
11471
diff
changeset
|
78 |
h "GLOBAL" p = serverAdminOnly $ do |
8547
6898be8aa261
Global notice with /global command. Can now warn users when doing server restart.
unc0rr
parents:
8519
diff
changeset
|
79 |
rnc <- liftM snd ask |
6898be8aa261
Global notice with /global command. Can now warn users when doing server restart.
unc0rr
parents:
8519
diff
changeset
|
80 |
let chans = map (sendChan . client rnc) $ allClients rnc |
11472
f2c36df8c7b1
Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents:
11471
diff
changeset
|
81 |
return [AnswerClients chans ["CHAT", "[global notice]", p]] |
9448 | 82 |
h "WATCH" f = return [QueryReplay f] |
9753
9579596cf471
- Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9448
diff
changeset
|
83 |
h "FIX" _ = handleCmd ["FIX"] |
9770 | 84 |
h "UNFIX" _ = handleCmd ["UNFIX"] |
10882
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
85 |
h "GREETING" msg | not $ B.null msg = handleCmd ["GREETING", msg] |
10039 | 86 |
h "CALLVOTE" msg | B.null msg = handleCmd ["CALLVOTE"] |
87 |
| otherwise = let (c, p) = extractParameters msg in |
|
88 |
if B.null p then handleCmd ["CALLVOTE", c] else handleCmd ["CALLVOTE", c, p] |
|
10882
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
89 |
h "VOTE" msg | not $ B.null msg = handleCmd ["VOTE", upperCase msg] |
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
90 |
h "FORCE" msg | not $ B.null msg = handleCmd ["VOTE", upperCase msg, "FORCE"] |
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
91 |
h "MAXTEAMS" n | not $ B.null n = handleCmd ["MAXTEAMS", n] |
ed7717f659ae
- Fix ping timeouts after incorrect "/vote" commands (protocol violation)
unc0rr
parents:
10881
diff
changeset
|
92 |
h "INFO" n | not $ B.null n = handleCmd ["INFO", n] |
11033 | 93 |
h "RESTART_SERVER" "YES" = handleCmd ["RESTART_SERVER"] |
11472
f2c36df8c7b1
Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents:
11471
diff
changeset
|
94 |
h "REGISTERED_ONLY" _ = serverAdminOnly $ do |
11470
0ae2e4c13bd1
Allow toggling registration requirement on live server
unc0rr
parents:
11054
diff
changeset
|
95 |
cl <- thisClient |
11472
f2c36df8c7b1
Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents:
11471
diff
changeset
|
96 |
return |
11471
4b5c7a5c49fd
Defer kicking to the time when everything is in consistent state
unc0rr
parents:
11470
diff
changeset
|
97 |
[ModifyServerInfo(\s -> s{isRegisteredUsersOnly = not $ isRegisteredUsersOnly s}) |
11470
0ae2e4c13bd1
Allow toggling registration requirement on live server
unc0rr
parents:
11054
diff
changeset
|
98 |
, AnswerClients [sendChan cl] ["CHAT", "[server]", "'Registered only' state toggled"] |
0ae2e4c13bd1
Allow toggling registration requirement on live server
unc0rr
parents:
11054
diff
changeset
|
99 |
] |
11472
f2c36df8c7b1
Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents:
11471
diff
changeset
|
100 |
h "SUPER_POWER" _ = serverAdminOnly $ return [ModifyClient (\c -> c{hasSuperPower = True})] |
10195 | 101 |
h c p = return [Warning $ B.concat ["Unknown cmd: /", c, " ", p]] |
8396 | 102 |
|
10039 | 103 |
extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b) |
104 |
||
4612 | 105 |
handleCmd_loggedin ["INFO", asknick] = do |
106 |
(_, rnc) <- ask |
|
4614 | 107 |
maybeClientId <- clientByNick asknick |
5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset
|
108 |
isAdminAsking <- liftM isAdministrator thisClient |
4612 | 109 |
let noSuchClient = isNothing maybeClientId |
110 |
let clientId = fromJust maybeClientId |
|
111 |
let cl = rnc `client` fromJust maybeClientId |
|
112 |
let roomId = clientRoom rnc clientId |
|
113 |
let clRoom = room rnc roomId |
|
9061 | 114 |
let roomMasterSign = if isMaster cl then "+" else "" |
4612 | 115 |
let adminSign = if isAdministrator cl then "@" else "" |
9061 | 116 |
let rInfo = if roomId /= lobbyId then B.concat [adminSign, roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby" |
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5060
diff
changeset
|
117 |
let roomStatus = if isJust $ gameInfo clRoom then |
4612 | 118 |
if teamsInGame cl > 0 then "(playing)" else "(spectating)" |
119 |
else |
|
120 |
"" |
|
10061
b7161f00a6ca
hide complete IP of other users, when non-admin requests player info. showing the first two parts of the IP was kinda pointless to begin with (what for?) and has recently lead to increased abuse and lobby flooding due to bots collecting/posting IP tracking information
sheepluva
parents:
10039
diff
changeset
|
121 |
let hostStr = if isAdminAsking then host cl else B.empty |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
122 |
if noSuchClient then |
4612 | 123 |
return [] |
124 |
else |
|
125 |
answerClient [ |
|
126 |
"INFO", |
|
127 |
nick cl, |
|
5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset
|
128 |
B.concat ["[", hostStr, "]"], |
4612 | 129 |
protoNumber2ver $ clientProto cl, |
7766 | 130 |
B.concat ["[", rInfo, "]", roomStatus] |
4612 | 131 |
] |
1862 | 132 |
|
133 |
||
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
|
134 |
handleCmd_loggedin cmd = 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
|
135 |
(ci, rnc) <- 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
|
136 |
if clientRoom rnc ci == lobbyId then |
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
|
137 |
handleCmd_lobby cmd |
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
|
138 |
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
|
139 |
handleCmd_inRoom cmd |