author | Gianfranco Costamagna <costamagnagianfranco@yahoo.it> |
Fri, 28 Nov 2014 16:03:35 +0100 | |
changeset 10561 | 8b65886906f3 |
parent 10460 | 8dcea9087d75 |
child 10881 | 941b5ab9e5a6 |
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 |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10212
diff
changeset
|
3 |
* Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com> |
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 |
|
10039 | 53 |
handleCmd ["CMD", parameters] = uncurry h $ extractParameters parameters |
8396 | 54 |
where |
9105 | 55 |
h "DELEGATE" n | not $ B.null n = handleCmd ["DELEGATE", n] |
10195 | 56 |
h "SAVEROOM" n | not $ B.null n = handleCmd ["SAVEROOM", n] |
57 |
h "LOADROOM" n | not $ B.null n = handleCmd ["LOADROOM", n] |
|
10194 | 58 |
h "SAVE" n | not $ B.null n = handleCmd ["SAVE", n] |
59 |
h "DELETE" n | not $ B.null n = handleCmd ["DELETE", n] |
|
9105 | 60 |
h "STATS" _ = handleCmd ["STATS"] |
61 |
h "PART" m | not $ B.null m = handleCmd ["PART", m] |
|
62 |
| otherwise = handleCmd ["PART"] |
|
63 |
h "QUIT" m | not $ B.null m = handleCmd ["QUIT", m] |
|
64 |
| otherwise = handleCmd ["QUIT"] |
|
65 |
h "RND" p = handleCmd ("RND" : B.words p) |
|
66 |
h "GLOBAL" p = do |
|
9035
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
9034
diff
changeset
|
67 |
cl <- thisClient |
8547
6898be8aa261
Global notice with /global command. Can now warn users when doing server restart.
unc0rr
parents:
8519
diff
changeset
|
68 |
rnc <- liftM snd ask |
6898be8aa261
Global notice with /global command. Can now warn users when doing server restart.
unc0rr
parents:
8519
diff
changeset
|
69 |
let chans = map (sendChan . client rnc) $ allClients rnc |
9105 | 70 |
return [AnswerClients chans ["CHAT", "[global notice]", p] | isAdministrator cl] |
9448 | 71 |
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
|
72 |
h "FIX" _ = handleCmd ["FIX"] |
9770 | 73 |
h "UNFIX" _ = handleCmd ["UNFIX"] |
9787 | 74 |
h "GREETING" msg = handleCmd ["GREETING", msg] |
10039 | 75 |
h "CALLVOTE" msg | B.null msg = handleCmd ["CALLVOTE"] |
76 |
| otherwise = let (c, p) = extractParameters msg in |
|
77 |
if B.null p then handleCmd ["CALLVOTE", c] else handleCmd ["CALLVOTE", c, p] |
|
78 |
h "VOTE" msg = handleCmd ["VOTE", upperCase msg] |
|
10195 | 79 |
h c p = return [Warning $ B.concat ["Unknown cmd: /", c, " ", p]] |
8396 | 80 |
|
10039 | 81 |
extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b) |
82 |
||
83 |
||
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
|
84 |
handleCmd 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
|
85 |
(ci, irnc) <- ask |
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8478
diff
changeset
|
86 |
let cl = irnc `client` ci |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8478
diff
changeset
|
87 |
if logonPassed cl then |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8478
diff
changeset
|
88 |
if isChecker cl then |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8478
diff
changeset
|
89 |
handleCmd_checker cmd |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8478
diff
changeset
|
90 |
else |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8478
diff
changeset
|
91 |
handleCmd_loggedin cmd |
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
|
92 |
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
|
93 |
handleCmd_NotEntered cmd |
1862 | 94 |
|
4568 | 95 |
|
4612 | 96 |
handleCmd_loggedin ["INFO", asknick] = do |
97 |
(_, rnc) <- ask |
|
4614 | 98 |
maybeClientId <- clientByNick asknick |
5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset
|
99 |
isAdminAsking <- liftM isAdministrator thisClient |
4612 | 100 |
let noSuchClient = isNothing maybeClientId |
101 |
let clientId = fromJust maybeClientId |
|
102 |
let cl = rnc `client` fromJust maybeClientId |
|
103 |
let roomId = clientRoom rnc clientId |
|
104 |
let clRoom = room rnc roomId |
|
9061 | 105 |
let roomMasterSign = if isMaster cl then "+" else "" |
4612 | 106 |
let adminSign = if isAdministrator cl then "@" else "" |
9061 | 107 |
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
|
108 |
let roomStatus = if isJust $ gameInfo clRoom then |
4612 | 109 |
if teamsInGame cl > 0 then "(playing)" else "(spectating)" |
110 |
else |
|
111 |
"" |
|
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
|
112 |
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
|
113 |
if noSuchClient then |
4612 | 114 |
return [] |
115 |
else |
|
116 |
answerClient [ |
|
117 |
"INFO", |
|
118 |
nick cl, |
|
5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset
|
119 |
B.concat ["[", hostStr, "]"], |
4612 | 120 |
protoNumber2ver $ clientProto cl, |
7766 | 121 |
B.concat ["[", rInfo, "]", roomStatus] |
4612 | 122 |
] |
1862 | 123 |
|
124 |
||
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
|
125 |
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
|
126 |
(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
|
127 |
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
|
128 |
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
|
129 |
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
|
130 |
handleCmd_inRoom cmd |