- Imported server changes from Turley (with modifications)

- Bumped version to 0.3.7
- Changed ProtocolVersion o 6
- Fixed TXmlHelper's child node parsing (incorrect usage of FindNode)
- Added TModifyRegionStatus and TDeleteRegionStatus
This commit is contained in:
Andreas Schneider 2008-08-11 22:48:45 +02:00
parent 2409b861e3
commit c95ba906a7
10 changed files with 716 additions and 299 deletions

View File

@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces,
UEnums;
UEnums, URegions;
type
@ -39,7 +39,7 @@ type
TAccount = class(TObject, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
AAccessLevel: TAccessLevel; ARegions: TStringList);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
@ -48,6 +48,7 @@ type
FAccessLevel: TAccessLevel;
FPasswordHash: string;
FLastPos: TPoint;
FRegions: TStringList;
procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint);
@ -56,6 +57,7 @@ type
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos;
property Regions: TStringList read FRegions;
procedure Invalidate;
end;
@ -82,16 +84,26 @@ uses
{ TAccount }
constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
AAccessLevel: TAccessLevel; ARegions: TStringList);
var
i : Integer;
begin
inherited Create;
FOwner := AOwner;
FName := AName;
FPasswordHash := APasswordHash;
FAccessLevel := AAccessLevel;
if ARegions <> nil then
FRegions := ARegions
else
FRegions := TStringList.Create;
end;
constructor TAccount.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
var
xmlElement, xmlRegion: TDOMElement;
nodelist: TDOMNodeList;
i: Integer;
begin
inherited Create;
FOwner := AOwner;
@ -100,6 +112,23 @@ begin
FPasswordHash := TXmlHelper.ReadString(AElement, 'PasswordHash', '');
FLastPos := Point(0, 0);
TXmlHelper.ReadCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
FRegions := TStringList.Create;
xmlElement := TDOMElement(AElement.FindNode('Regions'));
if xmlElement <> nil then
begin
nodeList := xmlElement.GetChildNodes;
for i := 0 to nodeList.Count - 1 do
begin
if nodeList.Item[i].NodeName = 'Region' then
begin
xmlRegion := TDOMElement(nodeList.Item[i]);
if assigned(xmlRegion.FirstChild) then
FRegions.Add(TDOMText(xmlRegion.FirstChild).Data);
end;
end;
nodeList.Free;
end;
end;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
@ -127,11 +156,18 @@ begin
end;
procedure TAccount.Serialize(AElement: TDOMElement);
var
i : Integer;
child : TDOMElement;
begin
TXmlHelper.WriteString(AElement, 'Name', FName);
TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash);
TXmlHelper.WriteInteger(AElement, 'AccessLevel', Integer(FAccessLevel));
TXmlHelper.WriteCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
child := TXmlHelper.AssureElement(AElement, 'Regions');
for i := 0 to FRegions.Count -1 do
if Config.Regions.Find(FRegions[i]) <> nil then //Validate if the region (still) exists
TXmlHelper.WriteString(child, 'Region', FRegions[i]);
end;
{ TAccountList }

View File

@ -30,8 +30,8 @@ unit UAdminHandling;
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, lNet;
Classes, SysUtils, math, UPacket, UPacketHandlers, UConfig, UAccount,
UNetState, UEnhancedMemoryStream, UEnums, URegions;
type
@ -52,6 +52,24 @@ type
TUserListPacket = class(TPacket)
constructor Create;
end;
{ TModifyRegionResponsePacket }
TModifyRegionResponsePacket = class(TPacket)
constructor Create(AStatus: TModifyRegionStatus; ARegion: TRegion);
end;
{ TDeleteRegionResponsePacket }
TDeleteRegionResponsePacket = class(TPacket)
constructor Create(AStatus: TDeleteRegionStatus; ARegionName: string);
end;
{ TUserRegionsPacket }
TRegionListPacket = class(TPacket)
constructor Create;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
@ -59,6 +77,10 @@ procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
@ -68,7 +90,8 @@ implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
@ -96,15 +119,26 @@ var
username, password: string;
accessLevel: TAccessLevel;
netState: TNetState;
regions: TStringList;
i, regionCount: Integer;
begin
username := ABuffer.ReadStringNull;
password := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte);
regionCount := ABuffer.ReadByte;
account := Config.Accounts.Find(username);
if account <> nil then
begin
if password <> '' then
account.PasswordHash := MD5Print(MD5String(password));
account.Regions.Clear;
for i := 0 to regionCount - 1 do
account.Regions.Add(ABuffer.ReadStringNull);
account.Invalidate;
if account.AccessLevel <> accessLevel then
begin
account.AccessLevel := accessLevel;
@ -114,24 +148,34 @@ begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel));
CEDServerInstance.SendPacket(netState,
TAccessLevelChangedPacket.Create(accessLevel));
end;
end;
end;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account));
CEDServerInstance.SendPacket(ANetState,
TModifyUserResponsePacket.Create(muModified, account));
end else
begin
account := TAccount.Create(Config.Accounts, username,
MD5Print(MD5String(password)), accessLevel);
if (username = '') or (Pos('=', username) > 0) then
if username = '' then
begin
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account));
account.Free;
CEDServerInstance.SendPacket(ANetState,
TModifyUserResponsePacket.Create(muInvalidUsername, account));
Exit;
end else
begin
regions := TStringList.Create;
for i := 0 to regionCount - 1 do
regions.Add(ABuffer.ReadStringNull);
account := TAccount.Create(Config.Accounts, username,
MD5Print(MD5String(password)), accessLevel, regions);
Config.Accounts.Add(account);
Config.Accounts.Invalidate;
CEDServerInstance.SendPacket(ANetState,
TModifyUserResponsePacket.Create(muAdded, account));
end;
Config.Accounts.Add(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
end;
end;
@ -158,25 +202,112 @@ begin
end;
Config.Accounts.Remove(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username));
CEDServerInstance.SendPacket(ANetState,
TDeleteUserResponsePacket.Create(duDeleted, username));
end else
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username));
CEDServerInstance.SendPacket(ANetState,
TDeleteUserResponsePacket.Create(duNotFound, username));
end;
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create));
CEDServerInstance.SendPacket(ANetState,
TCompressedPacket.Create(TUserListPacket.Create));
end;
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
regionName: string;
region: TRegion;
status: TModifyRegionStatus;
i, areaCount: Integer;
x1, y1, x2, y2: Word;
begin
regionName := ABuffer.ReadStringNull;
region := Config.Regions.Find(regionName);
if region = nil then
begin
region := TRegion.Create(Config.Regions, regionName);
Config.Regions.Add(region);
status := mrAdded;
end else
begin
region.Areas.Clear;
status := mrModified;
end;
areaCount := ABuffer.ReadByte;
for i := 0 to areaCount - 1 do
begin
x1 := ABuffer.ReadWord;
y1 := ABuffer.ReadWord;
x2 := ABuffer.ReadWord;
y2 := ABuffer.ReadWord;
region.Areas.Add(Min(x1, x2), Min(y1, y2),
Max(x1, x2), Max(y1, y2));
end;
CEDServerInstance.SendPacket(ANetState,
TModifyRegionResponsePacket.Create(status, region));
end;
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
regionName: string;
regions: TRegionList;
i: Integer;
status: TDeleteRegionStatus;
begin
regionName := ABuffer.ReadStringNull;
i := 0;
status := drNotFound;
regions := Config.Regions;
while (i < regions.Count) and (status = drNotFound) do
begin
if TRegion(regions[i]).Name = regionName then
begin
regions.Delete(i);
status := drDeleted;
end else
inc(i);
end;
CEDServerInstance.SendPacket(ANetState,
TDeleteRegionResponsePacket.Create(status, regionName));
end;
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin
CEDServerInstance.SendPacket(ANetState,
TCompressedPacket.Create(TRegionListPacket.Create));
end;
{ TModifyUserResponsePacket }
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus;
AAccount: TAccount);
var
i: Integer;
begin
inherited Create($03, 0);
FStream.WriteByte($05);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel));
if (AStatus = muAdded) or (AStatus = muModified) then
begin
FStream.WriteByte(Byte(AAccount.AccessLevel));
FStream.WriteByte(AAccount.Regions.Count);
if AAccount.Regions.Count > 0 then begin
for i := 0 to AAccount.Regions.Count - 1 do
FStream.WriteStringNull(AAccount.Regions[i]);
end;
end;
{TODO : check for client side modifications!}
end;
{ TDeleteUserResponsePacket }
@ -193,7 +324,7 @@ end;
constructor TUserListPacket.Create;
var
i: Integer;
i, j: Integer;
account: TAccount;
begin
inherited Create($03, 0);
@ -204,6 +335,75 @@ begin
account := TAccount(Config.Accounts.Items[i]);
FStream.WriteStringNull(account.Name);
FStream.WriteByte(Byte(account.AccessLevel));
FStream.WriteByte(account.Regions.Count);
for j := 0 to account.Regions.Count - 1 do
FStream.WriteStringNull(account.Regions[j]);
end;
FStream.WriteWord(Config.Regions.Count);
for i := 0 to Config.Regions.Count - 1 do
FStream.WriteStringNull(TRegion(Config.Regions.Items[i]).Name);
end;
{ TModifyRegionResponsePacket }
constructor TModifyRegionResponsePacket.Create(AStatus: TModifyRegionStatus;
ARegion: TRegion);
var
i, areaCount: Integer;
begin
inherited Create($03, 0);
FStream.WriteByte($08);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(ARegion.Name);
if (AStatus = mrAdded) or (AStatus = mrModified) then
begin
areaCount := ARegion.Areas.Count;
FStream.WriteByte(areaCount);
for i := 0 to areaCount - 1 do
with ARegion.Areas.Rects[i] do
begin
FStream.WriteWord(Left);
FStream.WriteWord(Top);
FStream.WriteWord(Right);
FStream.WriteWord(Bottom);
end;
end;
end;
{ TDeleteRegionResponsePacket }
constructor TDeleteRegionResponsePacket.Create(AStatus: TDeleteRegionStatus;
ARegionName: string);
begin
inherited Create($03, 0);
FStream.WriteByte($09);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(ARegionName);
end;
{ TRegionListPacket }
constructor TRegionListPacket.Create;
var
i, j: Integer;
region: TRegion;
begin
inherited Create($03, 0);
FStream.WriteByte($08);
FStream.WriteByte(Config.Regions.Count);
for i := 0 to Config.Regions.Count - 1 do
begin
region := TRegion(Config.Regions.Items[i]);
FStream.WriteStringNull(region.Name);
FStream.WriteByte(region.Areas.Count);
for j := 0 to region.Areas.Count - 1 do
with region.Areas.Rects[j] do
begin
FStream.WriteWord(Left);
FStream.WriteWord(Top);
FStream.WriteWord(Right);
FStream.WriteWord(Bottom);
end;
end;
end;
@ -219,6 +419,9 @@ initialization
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
AdminPacketHandlers[$08] := TPacketHandler.Create(0, @OnModifyRegionPacket);
AdminPacketHandlers[$09] := TPacketHandler.Create(0, @OnDeleteRegionPacket);
AdminPacketHandlers[$0A] := TPacketHandler.Create(0, @OnListRegionsPacket);
finalization
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then

View File

@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums;
UXmlHelper, UInterfaces, UEnums, URegions;
type
@ -76,6 +76,7 @@ type
FMap: TMapInfo;
FTiledata: string;
FRadarcol: string;
FRegions: TRegionList;
FAccounts: TAccountList;
FChanged: Boolean;
procedure SetPort(const AValue: Integer);
@ -86,6 +87,7 @@ type
property Map: TMapInfo read FMap;
property Tiledata: string read FTiledata write SetTiledata;
property Radarcol: string read FRadarcol write SetRadarcol;
property Regions: TRegionList read FRegions;
property Accounts: TAccountList read FAccounts;
procedure Flush;
procedure Invalidate;
@ -214,11 +216,17 @@ begin
FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul');
FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul');
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Regions'));
if assigned(xmlElement) then
FRegions := TRegionList.Deserialize(Self, xmlElement)
else
Fregions := TRegionList.Create(Self);
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Accounts'));
if not assigned(xmlElement) then
raise TInvalidConfigException.Create('Account information not found');
FAccounts := TAccountList.Deserialize(Self, xmlElement);
xmlDoc.Free;
FChanged := False;
@ -233,6 +241,7 @@ begin
FFilename := AFilename;
FMap := TMapInfo.Create(Self);
FAccounts := TAccountList.Create(Self);
FRegions := TRegionList.Create(Self);
Writeln('Configuring Network');
Writeln('===================');
@ -282,7 +291,7 @@ begin
Write ('Password [hidden]: ');
password := QueryPassword;
FAccounts.Add(TAccount.Create(FAccounts, stringValue,
MD5Print(MD5String(password)), alAdministrator));
MD5Print(MD5String(password)), alAdministrator, nil));
FChanged := True;
end;
@ -291,6 +300,7 @@ destructor TConfig.Destroy;
begin
if Assigned(FMap) then FreeAndNil(FMap);
if Assigned(FAccounts) then FreeAndNil(FAccounts);
if Assigned(FRegions) then FreeAndNil(FRegions);
inherited Destroy;
end;
@ -301,6 +311,7 @@ begin
TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata);
TXmlHelper.WriteString(AElement, 'Radarcol', FRadarcol);
FAccounts.Serialize(TXmlHelper.AssureElement(AElement, 'Accounts'));
FRegions.Serialize(TXmlHelper.AssureElement(AElement, 'Regions'));
end;
procedure TConfig.SetPort(const AValue: Integer);

View File

@ -539,9 +539,11 @@ var
item: PLinkedItem;
packet: TDrawMapPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
cell := GetMapCell(x, y);
if cell <> nil then
begin
@ -571,9 +573,11 @@ var
item: PLinkedItem;
packet: TInsertStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
block := GetStaticBlock(x div 8, y div 8);
if block <> nil then
begin
@ -611,8 +615,10 @@ var
item: PLinkedItem;
packet: TDeleteStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
if block <> nil then
begin
@ -656,8 +662,10 @@ var
item: PLinkedItem;
packet: TElevateStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
if block <> nil then
begin
@ -705,11 +713,14 @@ var
deletePacket: TDeleteStaticPacket;
movePacket: TMoveStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
staticItem := nil;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1);
newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1);
//Check, if both, source and target, are within a valid region
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
if not ValidateAccess(ANetState, alNormal, newX, newY) then Exit;
if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit;
@ -798,8 +809,10 @@ var
item: PLinkedItem;
packet: THueStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
if block <> nil then
begin

View File

@ -1,189 +1,217 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UPacketHandlers;
interface
uses
SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList;
type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object;
{ TPacketHandler }
TPacketHandler = class(TObject)
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
protected
FLength: Cardinal;
FPacketProcessor: TPacketProcessor;
FPacketProcessorMethod: TPacketProcessorMethod;
published
property PacketLength: Cardinal read FLength;
end;
var
PacketHandlers: array[0..$FF] of TPacketHandler;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
uses
UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
begin
Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel);
end;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
PacketHandlers[AID] := APacketHandler;
end;
{ TPacketHandler }
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := APacketProcessor;
FPacketProcessorMethod := nil;
end;
constructor TPacketHandler.Create(ALength: Cardinal;
APacketProcessorMethod: TPacketProcessorMethod);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := nil;
FPacketProcessorMethod := APacketProcessorMethod;
end;
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
if Assigned(FPacketProcessor) then
FPacketProcessor(ABuffer, ANetState)
else if Assigned(FPacketProcessorMethod) then
FPacketProcessorMethod(ABuffer, ANetState);
end;
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
uncompStream: TEnhancedMemoryStream;
uncompBuffer: TDecompressionStream;
targetSize: Cardinal;
packetID: Byte;
begin
targetSize := ABuffer.ReadCardinal;
uncompBuffer := TDecompressionStream.Create(ABuffer);
uncompStream := TEnhancedMemoryStream.Create;
try
uncompStream.CopyFrom(uncompBuffer, targetSize);
uncompStream.Position := 0;
packetID := uncompStream.ReadByte;
if PacketHandlers[packetID] <> nil then
begin
if PacketHandlers[PacketID].PacketLength = 0 then
uncompStream.Position := uncompStream.Position + 4;
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
PacketHandlers[PacketID].Process(uncompStream, ANetState);
uncompStream.Unlock;
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
ANetState.ReceiveQueue.Clear;
CEDServerInstance.Disconnect(ANetState.Socket);
end;
finally
if uncompBuffer <> nil then uncompBuffer.Free;
if uncompStream <> nil then uncompStream.Free;
end;
end;
procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
coords: TBlockCoordsArray;
i: Integer;
begin
if not ValidateAccess(ANetState, alView) then Exit;
SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords));
ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState)));
end;
procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
x, y: Word;
blockSubscriptions: TLinkedList;
begin
if not ValidateAccess(ANetState, alView) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y];
if blockSubscriptions <> nil then
begin
blockSubscriptions.Delete(ANetState);
ANetState.Subscriptions.Remove(blockSubscriptions);
end;
end;
procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
//no operation
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
PacketHandlers[i] := nil;
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket);
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);
PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket);
PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket);
//$06-$0B handled by landscape
PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket);
//$0D handled by radarmap
//$0E handled by landscape
PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket);
finalization
for i := 0 to $FF do
if PacketHandlers[i] <> nil then
PacketHandlers[i].Free;
{$WARNINGS ON}
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UPacketHandlers;
interface
uses
Classes, SysUtils, dzlib, math, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList, URegions;
type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object;
{ TPacketHandler }
TPacketHandler = class(TObject)
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
protected
FLength: Cardinal;
FPacketProcessor: TPacketProcessor;
FPacketProcessorMethod: TPacketProcessorMethod;
published
property PacketLength: Cardinal read FLength;
end;
var
PacketHandlers: array[0..$FF] of TPacketHandler;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; overload;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; overload;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
uses
UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
begin
Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel);
end;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean;
var
i,j: Word;
region: TRegion;
rect: TRect;
begin
if not ValidateAccess(ANetState, ALevel) then Exit(False);
if (ANetState.Account.Regions.Count = 0) or
(ANetState.Account.AccessLevel >= alAdministrator) then Exit(True); //no restrictions
Result := False;
for i := 0 to ANetState.Account.Regions.Count - 1 do
begin
region := Config.Regions.Find(ANetState.Account.Regions[i]);
if region <> nil then
begin
for j := 0 to region.Areas.Count - 1 do
begin
rect := region.Areas.Rects[j];
if InRange(AX, rect.Left, rect.Right) and
InRange(AY, rect.Top, rect.Bottom) then
Exit(True);
end;
end;
end;
end;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
PacketHandlers[AID] := APacketHandler;
end;
{ TPacketHandler }
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := APacketProcessor;
FPacketProcessorMethod := nil;
end;
constructor TPacketHandler.Create(ALength: Cardinal;
APacketProcessorMethod: TPacketProcessorMethod);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := nil;
FPacketProcessorMethod := APacketProcessorMethod;
end;
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
if Assigned(FPacketProcessor) then
FPacketProcessor(ABuffer, ANetState)
else if Assigned(FPacketProcessorMethod) then
FPacketProcessorMethod(ABuffer, ANetState);
end;
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
uncompStream: TEnhancedMemoryStream;
uncompBuffer: TDecompressionStream;
targetSize: Cardinal;
packetID: Byte;
begin
targetSize := ABuffer.ReadCardinal;
uncompBuffer := TDecompressionStream.Create(ABuffer);
uncompStream := TEnhancedMemoryStream.Create;
try
uncompStream.CopyFrom(uncompBuffer, targetSize);
uncompStream.Position := 0;
packetID := uncompStream.ReadByte;
if PacketHandlers[packetID] <> nil then
begin
if PacketHandlers[PacketID].PacketLength = 0 then
uncompStream.Position := uncompStream.Position + 4;
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
PacketHandlers[PacketID].Process(uncompStream, ANetState);
uncompStream.Unlock;
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
ANetState.ReceiveQueue.Clear;
CEDServerInstance.Disconnect(ANetState.Socket);
end;
finally
if uncompBuffer <> nil then uncompBuffer.Free;
if uncompStream <> nil then uncompStream.Free;
end;
end;
procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
coords: TBlockCoordsArray;
i: Integer;
begin
if not ValidateAccess(ANetState, alView) then Exit;
SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords));
ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState)));
end;
procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
x, y: Word;
blockSubscriptions: TLinkedList;
begin
if not ValidateAccess(ANetState, alView) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y];
if blockSubscriptions <> nil then
begin
blockSubscriptions.Delete(ANetState);
ANetState.Subscriptions.Remove(blockSubscriptions);
end;
end;
procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
//no operation
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
PacketHandlers[i] := nil;
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket);
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);
PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket);
PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket);
//$06-$0B handled by landscape
PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket);
//$0D handled by radarmap
//$0E handled by landscape
PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket);
finalization
for i := 0 to $FF do
if PacketHandlers[i] <> nil then
PacketHandlers[i].Free;
{$WARNINGS ON}
end.

View File

@ -34,7 +34,7 @@ uses
SysUtils, Classes,
lnetbase,
UConfig, UCEDServer, URadarMap, ULargeScaleOperations, UPackets,
UAdminHandling, UClientHandling, ULandscape, UPacketHandlers;
UAdminHandling, UClientHandling, ULandscape, UPacketHandlers, URegions;
{$I version.inc}

View File

@ -1,70 +1,75 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UEnums;
{$mode objfpc}{$H+}
interface
type
TLoginState = (lsOK = 0,
lsInvalidUser = 1,
lsInvalidPassword = 2,
lsAlreadyLoggedIn = 3,
lsNoAccess = 4);
TServerState = (ssRunning = 0,
ssFrozen = 1,
ssOther = 2);
TAccessLevel = (alNone = 0,
alView = 1,
alNormal = 2,
alAdministrator = 255);
TModifyUserStatus = (muInvalidUsername = 0,
muAdded = 1,
muModified = 2);
TDeleteUserStatus = (duNotFound = 0,
duDeleted = 1);
function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
implementation
function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
begin
Result := '';
case AAccessLevel of
alNone: Result := 'None';
alView: Result := 'Viewer';
alNormal: Result := 'Normal';
alAdministrator: Result := 'Administrator';
end;
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UEnums;
{$mode objfpc}{$H+}
interface
type
TLoginState = (lsOK = 0,
lsInvalidUser = 1,
lsInvalidPassword = 2,
lsAlreadyLoggedIn = 3,
lsNoAccess = 4);
TServerState = (ssRunning = 0,
ssFrozen = 1,
ssOther = 2);
TAccessLevel = (alNone = 0,
alView = 1,
alNormal = 2,
alAdministrator = 255);
TModifyUserStatus = (muInvalidUsername = 0,
muAdded = 1,
muModified = 2);
TDeleteUserStatus = (duNotFound = 0,
duDeleted = 1);
TModifyRegionStatus = (mrAdded = 0,
mrModified = 1);
TDeleteRegionStatus = (drNotFound = 0,
drDeleted = 1);
function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
implementation
function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
begin
Result := '';
case AAccessLevel of
alNone: Result := 'None';
alView: Result := 'Viewer';
alNormal: Result := 'Normal';
alAdministrator: Result := 'Administrator';
end;
end;
end.

100
URectList.pas Normal file
View File

@ -0,0 +1,100 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2008 Andreas Schneider
*)
unit URectList;
{$mode objfpc}{$H+}
interface
uses
SysUtils,Classes;
type
TRectList = class(TList)
protected
function GetRect(AIndex: Integer): TRect;
procedure SetRect(AIndex: Integer; ARect: TRect);
public
function Add(ALeft, ATop, ARight, ABottom: Integer): Integer;
procedure Clear; override;
procedure Delete(AIndex: Integer); reintroduce;
property Rects[Index: Integer]: TRect read GetRect write SetRect;
end;
PRect = ^TRect;
implementation
{ TRectList }
function TRectList.GetRect(AIndex: Integer): TRect;
begin
Result := PRect(Items[AIndex])^;
end;
procedure TRectList.SetRect(AIndex: Integer; ARect: TRect);
var
internalRect: PRect;
begin
internalRect := Items[AIndex];
System.Move(ARect, internalRect^, SizeOf(TRect));
end;
function TRectList.Add(ALeft, ATop, ARight, ABottom: Integer): Integer;
var
internalRect: PRect;
begin
new(internalRect);
internalRect^.Left := ALeft;
internalRect^.Top := ATop;
internalRect^.Right := ARight;
internalRect^.Bottom := ABottom;
Result := inherited Add(internalRect);
end;
procedure TRectList.Clear;
var
i: Integer;
internalRect: PRect;
begin
for i := 0 to Count - 1 do
begin
internalRect := Items[i];
dispose(internalRect);
end;
inherited;
end;
procedure TRectList.Delete(AIndex: Integer);
var
internalRect: PRect;
begin
internalRect := Items[AIndex];
dispose(internalRect);
inherited Delete(AIndex);
end;
end.

View File

@ -37,6 +37,7 @@ type
{ TXmlHelper }
TXmlHelper = class(TObject)
class function FindChild(AParent: TDOMElement; AName: string): TDOMElement;
class function AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
class procedure WriteString(AParent: TDOMElement; AName, AValue: string);
class function ReadString(AParent: TDOMElement; AName, ADefault: string): string;
@ -52,10 +53,30 @@ implementation
{ TXmlHelper }
class function TXmlHelper.AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
class function TXmlHelper.FindChild(AParent: TDOMElement; AName: string): TDOMElement;
var
i: Integer;
nodeList: TDOMNodeList;
begin
Result := TDOMElement(AParent.FindNode(AName));
if not assigned(Result) then
Result := nil;
nodeList := AParent.GetChildNodes;
i := 0;
while (Result = nil) and (i < nodeList.Count) do
begin
if nodeList.Item[i].NodeName = AName then
Result := TDOMElement(nodeList[i]);
inc(i);
end;
nodeList.Free;
end;
class function TXmlHelper.AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
var
i: Integer;
nodeList: TDOMNodeList;
begin
Result := FindChild(AParent, AName);
if Result = nil then
begin
Result := AParent.OwnerDocument.CreateElement(AName);
AParent.AppendChild(Result);
@ -77,7 +98,7 @@ class function TXmlHelper.ReadString(AParent: TDOMElement; AName, ADefault: stri
var
element: TDOMElement;
begin
element := TDOMElement(AParent.FindNode(AName));
element := FindChild(AParent, AName);
if assigned(element) and assigned(element.FirstChild) then
Result := TDOMText(element.FirstChild).Data
else
@ -125,7 +146,7 @@ var
element: TDOMElement;
tempX, tempY: Integer;
begin
element := TDOMElement(AParent.FindNode(AName));
element := FindChild(AParent, AName);
Result := assigned(element) and TryStrToInt(element.AttribStrings['x'], tempX)
and TryStrToInt(element.AttribStrings['y'], tempY);

View File

@ -1,5 +1,5 @@
const
ProductVersion = '0.3.6';
ProtocolVersion = 5;
ProductVersion = '0.3.7';
ProtocolVersion = 6;
Revision = '41';
Copyright = '2008 Andreas Schneider';