- Fixed "UTiledata" spelling in ULandscape.pas

- Added ISerializable and IInvalidate interfaces
- Implemented a TConfig class and XML storage
- Added some more detailed messages when a login fails to the server console
- Removed obsolete IStream interface references
- Readded lbHue in TfrmHueSettings
This commit is contained in:
2008-03-06 22:55:49 +01:00
parent 04a459b524
commit 12773fd63e
18 changed files with 2346 additions and 2525 deletions

View File

@@ -1,181 +1,213 @@
(*
* 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 UAccount;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, md5, contnrs, math, UEnums;
type
{ TAccount }
TAccount = class(TObject)
constructor Create(AAccountString: string);
constructor Create(AName, APasswordHash: string; AAccessLevel: TAccessLevel);
protected
FName: string;
FAccessLevel: TAccessLevel;
FPasswordHash: string;
FLastPos: TPoint;
procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint);
public
property Name: string read FName;
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos;
procedure Flush;
end;
{ TAccountList }
TAccountList = class(TObjectList)
constructor Create; reintroduce;
public
function IndexOf(AName: string): Integer;
function Find(AName: string): TAccount;
procedure Delete(AName: string);
end;
implementation
uses
UCEDServer, UConfig;
{ TAccount }
constructor TAccount.Create(AAccountString: string);
var
i: Integer;
attribs: TStringList;
begin
inherited Create;
i := Pos('=', AAccountString);
if i > 0 then
FName := Trim(Copy(AAccountString, 1, i-1));
AAccountString := Copy(AAccountString, i+1, Length(AAccountString));
attribs := TStringList.Create;
if ExtractStrings([':'], [' '], PChar(AAccountString), attribs) >= 2 then
begin
FAccessLevel := TAccessLevel(StrToInt(attribs.Strings[0]));
FPasswordHash := attribs.Strings[1];
end;
if attribs.Count >= 4 then
begin
FLastPos.x := EnsureRange(StrToInt(attribs.Strings[2]), 0, Config.ReadInteger('Parameters', 'Width', 0) * 8 - 1);
FLastPos.y := EnsureRange(StrToInt(attribs.Strings[3]), 0, Config.ReadInteger('Parameters', 'Height', 0) * 8 - 1);
end else
begin
FLastPos.x := 0;
FLastPos.y := 0;
end;
attribs.Free;
end;
constructor TAccount.Create(AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
begin
inherited Create;
FName := AName;
FPasswordHash := APasswordHash;
FAccessLevel := AAccessLevel;
Flush;
end;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
begin
FAccessLevel := AValue;
Flush;
end;
procedure TAccount.SetPasswordHash(const AValue: string);
begin
FPasswordHash := AValue;
Flush;
end;
procedure TAccount.SetLastPos(const AValue: TPoint);
begin
FLastPos.x := EnsureRange(AValue.x, 0, CEDServerInstance.Landscape.CellWidth - 1);
FLastPos.y := EnsureRange(AValue.y, 0, CEDServerInstance.Landscape.CellHeight - 1);
Flush;
end;
procedure TAccount.Flush;
begin
Config.WriteString('Accounts', FName, IntToStr(Byte(FAccessLevel)) + ':' +
FPasswordHash + ':' + IntToStr(FLastPos.x) + ':' + IntToStr(FLastPos.y));
end;
{ TAccountList }
constructor TAccountList.Create;
begin
inherited Create(True);
end;
function TAccountList.IndexOf(AName: string): Integer;
var
i: Integer;
begin
Result := -1;
i := 0;
while (i < Count) and (Result = -1) do
begin
if TAccount(Items[i]).Name = AName then
Result := i;
Inc(i);
end;
end;
function TAccountList.Find(AName: string): TAccount;
var
i: Integer;
begin
i := IndexOf(AName);
if i > -1 then
Result := TAccount(Items[i])
else
Result := nil;
end;
procedure TAccountList.Delete(AName: string);
var
i: Integer;
begin
i := IndexOf(AName);
if i > -1 then
inherited Delete(i);
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 2008 Andreas Schneider
*)
unit UAccount;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces,
UEnums;
type
{ TAccount }
TAccount = class(TObject, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
FOwner: IInvalidate;
FName: string;
FAccessLevel: TAccessLevel;
FPasswordHash: string;
FLastPos: TPoint;
procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint);
public
property Name: string read FName;
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos;
procedure Invalidate;
end;
{ TAccountList }
TAccountList = class(TObjectList, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate); reintroduce;
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
FOwner: IInvalidate;
public
function IndexOf(AName: string): Integer;
function Find(AName: string): TAccount;
procedure Delete(AName: string);
procedure Invalidate;
end;
implementation
uses
UCEDServer, UConfig;
{ TAccount }
constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
begin
inherited Create;
FOwner := AOwner;
FName := AName;
FPasswordHash := APasswordHash;
FAccessLevel := AAccessLevel;
end;
constructor TAccount.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
begin
inherited Create;
FOwner := AOwner;
FName := TXmlHelper.ReadString(AElement, 'Name', '');
FAccessLevel := TAccessLevel(TXmlHelper.ReadInteger(AElement, 'AccessLevel', 0));
FPasswordHash := TXmlHelper.ReadString(AElement, 'PasswordHash', '');
FLastPos := Point(0, 0);
TXmlHelper.ReadCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
end;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
begin
FAccessLevel := AValue;
Invalidate;
end;
procedure TAccount.SetPasswordHash(const AValue: string);
begin
FPasswordHash := AValue;
Invalidate;
end;
procedure TAccount.SetLastPos(const AValue: TPoint);
begin
FLastPos.x := EnsureRange(AValue.x, 0, CEDServerInstance.Landscape.CellWidth - 1);
FLastPos.y := EnsureRange(AValue.y, 0, CEDServerInstance.Landscape.CellHeight - 1);
Invalidate;
end;
procedure TAccount.Invalidate;
begin
FOwner.Invalidate;
end;
procedure TAccount.Serialize(AElement: 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);
end;
{ TAccountList }
constructor TAccountList.Create(AOwner: IInvalidate);
begin
inherited Create(True);
FOwner := AOwner;
end;
constructor TAccountList.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
var
nodelist: TDOMNodeList;
i: Integer;
begin
Create(AOwner);
nodeList := AElement.GetChildNodes;
for i := 0 to nodeList.Count - 1 do
begin
if nodeList.Item[i].NodeName = 'Account' then
Add(TAccount.Deserialize(Self, TDOMElement(nodeList.Item[i])));
end;
nodeList.Free;
end;
function TAccountList.IndexOf(AName: string): Integer;
var
i: Integer;
begin
Result := -1;
i := 0;
while (i < Count) and (Result = -1) do
begin
if TAccount(Items[i]).Name = AName then
Result := i;
Inc(i);
end;
end;
function TAccountList.Find(AName: string): TAccount;
var
i: Integer;
begin
i := IndexOf(AName);
if i > -1 then
Result := TAccount(Items[i])
else
Result := nil;
end;
procedure TAccountList.Delete(AName: string);
var
i: Integer;
begin
i := IndexOf(AName);
if i > -1 then
inherited Delete(i);
end;
procedure TAccountList.Invalidate;
begin
FOwner.Invalidate;
end;
procedure TAccountList.Serialize(AElement: TDOMElement);
var
i: Integer;
xmlAccount: TDOMElement;
begin
for i := 0 to Count - 1 do
begin
xmlAccount := AElement.OwnerDocument.CreateElement('Account');
AElement.AppendChild(xmlAccount);
TAccount(Items[i]).Serialize(xmlAccount);
end;
end;
end.

View File

@@ -1,226 +1,229 @@
(*
* 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 UAdminHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, lNet;
type
{ TModifyUserResponsePacket }
TModifyUserResponsePacket = class(TPacket)
constructor Create(AStatus: TModifyUserStatus; AAccount: TAccount);
end;
{ TDeleteUserResponsePacket }
TDeleteUserResponsePacket = class(TPacket)
constructor Create(AStatus: TDeleteUserStatus; AUsername: string);
end;
{ TUserListPacket }
TUserListPacket = class(TPacket)
constructor Create;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alAdministrator) then Exit;
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Landscape.Flush;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Quit := True;
end;
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username, password: string;
accessLevel: TAccessLevel;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
password := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte);
account := Accounts.Find(username);
if account <> nil then
begin
if password <> '' then
account.PasswordHash := MD5Print(MD5String(password));
if account.AccessLevel <> accessLevel then
begin
account.AccessLevel := accessLevel;
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel));
end;
end;
end;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account));
end else
begin
account := TAccount.Create(username, MD5Print(MD5String(password)), accessLevel);
if (username = '') or (Pos('=', username) > 0) then
begin
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account));
account.Free;
Exit;
end;
Accounts.Add(account);
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
end;
end;
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username: string;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
account := Accounts.Find(username);
if (account <> nil) and (account <> ANetState.Account) then
begin
Config.DeleteKey('Accounts', username);
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.Disconnect(CEDServerInstance.TCPServer.Iterator);
netState.Account := nil;
end;
end;
Accounts.Remove(account);
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username));
end else
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username));
end;
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create));
end;
{ TModifyUserResponsePacket }
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
begin
inherited Create($03, 0);
FStream.WriteByte($05);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel));
end;
{ TDeleteUserResponsePacket }
constructor TDeleteUserResponsePacket.Create(AStatus: TDeleteUserStatus; AUsername: string);
begin
inherited Create($03, 0);
FStream.WriteByte($06);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AUsername);
end;
{ TUserListPacket }
constructor TUserListPacket.Create;
var
i: Integer;
account: TAccount;
begin
inherited Create($03, 0);
FStream.WriteByte($07);
FStream.WriteWord(Accounts.Count);
for i := 0 to Accounts.Count - 1 do
begin
account := TAccount(Accounts.Items[i]);
FStream.WriteStringNull(account.Name);
FStream.WriteByte(Byte(account.AccessLevel));
end;
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
AdminPacketHandlers[i] := nil;
AdminPacketHandlers[$01] := TPacketHandler.Create(0, @OnFlushPacket);
AdminPacketHandlers[$02] := TPacketHandler.Create(0, @OnQuitPacket);
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
finalization
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then
AdminPacketHandlers[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 2008 Andreas Schneider
*)
unit UAdminHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, lNet;
type
{ TModifyUserResponsePacket }
TModifyUserResponsePacket = class(TPacket)
constructor Create(AStatus: TModifyUserStatus; AAccount: TAccount);
end;
{ TDeleteUserResponsePacket }
TDeleteUserResponsePacket = class(TPacket)
constructor Create(AStatus: TDeleteUserStatus; AUsername: string);
end;
{ TUserListPacket }
TUserListPacket = class(TPacket)
constructor Create;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alAdministrator) then Exit;
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Landscape.Flush;
Config.Flush;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Quit := True;
end;
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username, password: string;
accessLevel: TAccessLevel;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
password := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte);
account := Config.Accounts.Find(username);
if account <> nil then
begin
if password <> '' then
account.PasswordHash := MD5Print(MD5String(password));
if account.AccessLevel <> accessLevel then
begin
account.AccessLevel := accessLevel;
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel));
end;
end;
end;
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
begin
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account));
account.Free;
Exit;
end;
Config.Accounts.Add(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
end;
end;
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username: string;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
account := Config.Accounts.Find(username);
if (account <> nil) and (account <> ANetState.Account) then
begin
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.Disconnect(CEDServerInstance.TCPServer.Iterator);
netState.Account := nil;
end;
end;
Config.Accounts.Remove(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username));
end else
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username));
end;
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create));
end;
{ TModifyUserResponsePacket }
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
begin
inherited Create($03, 0);
FStream.WriteByte($05);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel));
end;
{ TDeleteUserResponsePacket }
constructor TDeleteUserResponsePacket.Create(AStatus: TDeleteUserStatus; AUsername: string);
begin
inherited Create($03, 0);
FStream.WriteByte($06);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AUsername);
end;
{ TUserListPacket }
constructor TUserListPacket.Create;
var
i: Integer;
account: TAccount;
begin
inherited Create($03, 0);
FStream.WriteByte($07);
FStream.WriteWord(Config.Accounts.Count);
for i := 0 to Config.Accounts.Count - 1 do
begin
account := TAccount(Config.Accounts.Items[i]);
FStream.WriteStringNull(account.Name);
FStream.WriteByte(Byte(account.AccessLevel));
end;
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
AdminPacketHandlers[i] := nil;
AdminPacketHandlers[$01] := TPacketHandler.Create(0, @OnFlushPacket);
AdminPacketHandlers[$02] := TPacketHandler.Create(0, @OnQuitPacket);
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
finalization
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then
AdminPacketHandlers[i].Free;
{$WARNINGS ON}
end.

View File

@@ -1,361 +1,358 @@
(*
* 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 UCEDServer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape,
UNetState, UPacket, dateutils,
{$IFDEF Linux}BaseUnix,{$ENDIF}
{$IFDEF Windows}Windows,{$ENDIF}
UPacketHandlers, UConnectionHandling;
type
{ TCEDServer }
TCEDServer = class(TObject)
constructor Create;
destructor Destroy; override;
protected
FLandscape: TLandscape;
FTCPServer: TLTcp;
FQuit: Boolean;
FLastFlush: TDateTime;
FValid: Boolean;
procedure OnAccept(ASocket: TLSocket);
procedure OnCanSend(ASocket: TLSocket);
procedure OnDisconnect(ASocket: TLSocket);
procedure OnReceive(ASocket: TLSocket);
procedure OnError(const AError: string; ASocket: TLSocket);
procedure ProcessBuffer(ANetState: TNetState);
procedure CheckNetStates;
public
property Landscape: TLandscape read FLandscape;
property TCPServer: TLTcp read FTCPServer;
property Quit: Boolean read FQuit write FQuit;
procedure Run;
procedure SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
procedure Disconnect(ASocket: TLSocket);
end;
var
CEDServerInstance: TCEDServer;
implementation
uses
UClientHandling;
{$I version.inc}
{$IFDEF Linux}
procedure OnSigInt(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
procedure OnSigSegv(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Internal error');
Halt;
//if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
{$ENDIF}
{$IFDEF Windows}
function OnConsoleCtrlEvent(ACtrl: DWord): LongBool; stdcall; far;
begin
Result := False;
if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
Result := True;
end;
end;
{$ENDIF}
{ TCEDServer }
constructor TCEDServer.Create;
begin
inherited Create;
FLandscape := TLandscape.Create(Config.ReadString('Paths', 'map', 'map0.mul'),
Config.ReadString('Paths', 'statics', 'statics0.mul'),
Config.ReadString('Paths', 'staidx', 'staidx0.mul'),
Config.ReadString('Paths', 'tiledata', 'tiledata.mul'),
Config.ReadString('Paths', 'radarcol', 'radarcol.mul'),
Config.ReadInteger('Parameters', 'Width', 0),
Config.ReadInteger('Parameters', 'Height', 0),
FValid);
FTCPServer := TLTcp.Create(nil);
FTCPServer.OnAccept := @OnAccept;
FTCPServer.OnCanSend := @OnCanSend;
FTCPServer.OnDisconnect := @OnDisconnect;
FTCPServer.OnReceive := @OnReceive;
FTCPServer.OnError := @OnError;
FQuit := False;
FLastFlush := Now;
end;
destructor TCEDServer.Destroy;
begin
if FTCPServer <> nil then
begin
FTCPServer.IterReset;
if FTCPServer.Iterator <> nil then
while FTCPServer.IterNext do
begin
FTCPServer.Iterator.Disconnect;
if FTCPServer.Iterator.UserData <> nil then
begin
TObject(FTCPServer.Iterator.UserData).Free;
FTCPServer.Iterator.UserData := nil;
end;
end;
FreeAndNil(FTCPServer);
end;
if FLandscape <> nil then FreeAndNil(FLandscape);
inherited Destroy;
end;
procedure TCEDServer.OnAccept(ASocket: TLSocket);
begin
writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress);
ASocket.UserData := TNetState.Create(ASocket);
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion));
end;
procedure TCEDServer.OnCanSend(ASocket: TLSocket);
var
netState: TNetState;
size: Integer;
begin
//writeln('CanSend: ', ASocket.PeerAddress);
netState := TNetState(ASocket.UserData);
if netState = nil then Exit;
while netState.SendQueue.Size > 0 do
begin
size := FTCPServer.Send(netState.SendQueue.Memory^, netState.SendQueue.Size, ASocket);
if size > 0 then
netState.SendQueue.Dequeue(size)
else
Break;
end;
end;
procedure TCEDServer.OnDisconnect(ASocket: TLSocket);
var
netState: TNetState;
begin
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress);
if ASocket.UserData <> nil then
begin
netState := TNetState(ASocket.UserData);
ASocket.UserData := nil;
if netState.Account <> nil then
SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name));
netState.Free;
end;
end;
procedure TCEDServer.OnReceive(ASocket: TLSocket);
var
netState: TNetState;
buffer: array[0..4095] of byte;
size: Integer;
begin
netState := TNetState(ASocket.UserData);
if netState <> nil then
begin
repeat
size := FTCPServer.Get(buffer, 4096, ASocket);
if size > 0 then
netState.ReceiveQueue.Enqueue(buffer, size);
until size <= 0;
ProcessBuffer(netState);
end;
end;
procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
begin
writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError);
//OnDisconnect(ASocket);
end;
procedure TCEDServer.ProcessBuffer(ANetState: TNetState);
var
buffer: TEnhancedMemoryStream;
packetID: Byte;
packetHandler: TPacketHandler;
size: Cardinal;
begin
try
buffer := ANetState.ReceiveQueue;
buffer.Position := 0;
while (buffer.Size >= 1) and ANetState.Socket.Connected do
begin
packetID := buffer.ReadByte;
packetHandler := PacketHandlers[packetID];
if packetHandler <> nil then
begin
ANetState.LastAction := Now;
size := packetHandler.PacketLength;
if size = 0 then
begin
if buffer.Size > 5 then
size := buffer.ReadCardinal
else
Break; //wait for more data
end;
if buffer.Size >= size then
begin
buffer.Lock(buffer.Position, size - buffer.Position); //prevent handler from reading too much
packetHandler.Process(buffer, ANetState);
buffer.Unlock;
buffer.Dequeue(size);
end else
Break; //wait for more data
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress);
Disconnect(ANetState.Socket);
buffer.Clear;
end;
end;
ANetState.LastAction := Now;
except
Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress);
end;
end;
procedure TCEDServer.CheckNetStates;
var
netState: TNetState;
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if netState <> nil then
begin
if FTCPServer.Iterator.Connected then
begin
if (SecondsBetween(netState.LastAction, Now) > 120) then
begin
if netState.Account <> nil then
Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
else
Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress);
Disconnect(netState.Socket);
end;
end else {TODO : Unnecessary ...}
begin
OnDisconnect(FTCPServer.Iterator);
end;
end;
end;
end;
procedure TCEDServer.Run;
begin
if not FValid then
begin
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.');
Exit;
end;
if FTCPServer.Listen(Config.ReadInteger('Network', 'Port', 2597)) then
begin
repeat
FTCPServer.CallAction;
CheckNetStates;
if SecondsBetween(FLastFlush, Now) >= 60 then
begin
FLandscape.Flush;
FLastFlush := Now;
end;
Sleep(1);
until FQuit;
end;
end;
procedure TCEDServer.SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
var
netState: TNetState;
begin
if ANetState <> nil then
begin
ANetState.SendQueue.Seek(0, soFromEnd);
ANetState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(ANetState.Socket);
end else //broadcast
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then
begin
netState.SendQueue.Seek(0, soFromEnd);
netState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(netState.Socket);
end;
end;
end;
if AFreePacket then
APacket.Free;
end;
procedure TCEDServer.Disconnect(ASocket: TLSocket);
begin
if ASocket.Connected then
begin
ASocket.Disconnect;
//OnDisconnect(ASocket);
//Handling of the disconnect is done in CheckNetStates after each CallAction
end;
end;
initialization
{$IFDEF Linux}
FpSignal(SIGINT, @OnSigInt);
//FpSignal(SIGSEGV, @OnSigSegv);
{$ENDIF}
{$IFDEF Windows}
SetConsoleCtrlHandler(@OnConsoleCtrlEvent, True);
{$ENDIF}
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 UCEDServer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape,
UNetState, UPacket, dateutils,
{$IFDEF Linux}BaseUnix,{$ENDIF}
{$IFDEF Windows}Windows,{$ENDIF}
UPacketHandlers, UConnectionHandling;
type
{ TCEDServer }
TCEDServer = class(TObject)
constructor Create;
destructor Destroy; override;
protected
FLandscape: TLandscape;
FTCPServer: TLTcp;
FQuit: Boolean;
FLastFlush: TDateTime;
FValid: Boolean;
procedure OnAccept(ASocket: TLSocket);
procedure OnCanSend(ASocket: TLSocket);
procedure OnDisconnect(ASocket: TLSocket);
procedure OnReceive(ASocket: TLSocket);
procedure OnError(const AError: string; ASocket: TLSocket);
procedure ProcessBuffer(ANetState: TNetState);
procedure CheckNetStates;
public
property Landscape: TLandscape read FLandscape;
property TCPServer: TLTcp read FTCPServer;
property Quit: Boolean read FQuit write FQuit;
procedure Run;
procedure SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
procedure Disconnect(ASocket: TLSocket);
end;
var
CEDServerInstance: TCEDServer;
implementation
uses
UClientHandling;
{$I version.inc}
{$IFDEF Linux}
procedure OnSigInt(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
procedure OnSigSegv(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Internal error');
Halt;
//if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
{$ENDIF}
{$IFDEF Windows}
function OnConsoleCtrlEvent(ACtrl: DWord): LongBool; stdcall; far;
begin
Result := False;
if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
Result := True;
end;
end;
{$ENDIF}
{ TCEDServer }
constructor TCEDServer.Create;
begin
inherited Create;
FLandscape := TLandscape.Create(Config.Map.MapFile, Config.Map.StaticsFile,
Config.Map.StaIdxFile, Config.Tiledata, Config.Radarcol, Config.Map.Width,
Config.Map.Height, FValid);
FTCPServer := TLTcp.Create(nil);
FTCPServer.OnAccept := @OnAccept;
FTCPServer.OnCanSend := @OnCanSend;
FTCPServer.OnDisconnect := @OnDisconnect;
FTCPServer.OnReceive := @OnReceive;
FTCPServer.OnError := @OnError;
FQuit := False;
FLastFlush := Now;
end;
destructor TCEDServer.Destroy;
begin
if FTCPServer <> nil then
begin
FTCPServer.IterReset;
if FTCPServer.Iterator <> nil then
while FTCPServer.IterNext do
begin
FTCPServer.Iterator.Disconnect;
if FTCPServer.Iterator.UserData <> nil then
begin
TObject(FTCPServer.Iterator.UserData).Free;
FTCPServer.Iterator.UserData := nil;
end;
end;
FreeAndNil(FTCPServer);
end;
if FLandscape <> nil then FreeAndNil(FLandscape);
inherited Destroy;
end;
procedure TCEDServer.OnAccept(ASocket: TLSocket);
begin
writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress);
ASocket.UserData := TNetState.Create(ASocket);
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion));
end;
procedure TCEDServer.OnCanSend(ASocket: TLSocket);
var
netState: TNetState;
size: Integer;
begin
//writeln('CanSend: ', ASocket.PeerAddress);
netState := TNetState(ASocket.UserData);
if netState = nil then Exit;
while netState.SendQueue.Size > 0 do
begin
size := FTCPServer.Send(netState.SendQueue.Memory^, netState.SendQueue.Size, ASocket);
if size > 0 then
netState.SendQueue.Dequeue(size)
else
Break;
end;
end;
procedure TCEDServer.OnDisconnect(ASocket: TLSocket);
var
netState: TNetState;
begin
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress);
if ASocket.UserData <> nil then
begin
netState := TNetState(ASocket.UserData);
ASocket.UserData := nil;
if netState.Account <> nil then
SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name));
netState.Free;
end;
end;
procedure TCEDServer.OnReceive(ASocket: TLSocket);
var
netState: TNetState;
buffer: array[0..4095] of byte;
size: Integer;
begin
netState := TNetState(ASocket.UserData);
if netState <> nil then
begin
repeat
size := FTCPServer.Get(buffer, 4096, ASocket);
if size > 0 then
netState.ReceiveQueue.Enqueue(buffer, size);
until size <= 0;
ProcessBuffer(netState);
end;
end;
procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
begin
writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError);
//OnDisconnect(ASocket);
end;
procedure TCEDServer.ProcessBuffer(ANetState: TNetState);
var
buffer: TEnhancedMemoryStream;
packetID: Byte;
packetHandler: TPacketHandler;
size: Cardinal;
begin
try
buffer := ANetState.ReceiveQueue;
buffer.Position := 0;
while (buffer.Size >= 1) and ANetState.Socket.Connected do
begin
packetID := buffer.ReadByte;
packetHandler := PacketHandlers[packetID];
if packetHandler <> nil then
begin
ANetState.LastAction := Now;
size := packetHandler.PacketLength;
if size = 0 then
begin
if buffer.Size > 5 then
size := buffer.ReadCardinal
else
Break; //wait for more data
end;
if buffer.Size >= size then
begin
buffer.Lock(buffer.Position, size - buffer.Position); //prevent handler from reading too much
packetHandler.Process(buffer, ANetState);
buffer.Unlock;
buffer.Dequeue(size);
end else
Break; //wait for more data
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress);
Disconnect(ANetState.Socket);
buffer.Clear;
end;
end;
ANetState.LastAction := Now;
except
Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress);
end;
end;
procedure TCEDServer.CheckNetStates;
var
netState: TNetState;
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if netState <> nil then
begin
if FTCPServer.Iterator.Connected then
begin
if (SecondsBetween(netState.LastAction, Now) > 120) then
begin
if netState.Account <> nil then
Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
else
Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress);
Disconnect(netState.Socket);
end;
end else {TODO : Unnecessary ...}
begin
OnDisconnect(FTCPServer.Iterator);
end;
end;
end;
end;
procedure TCEDServer.Run;
begin
if not FValid then
begin
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.');
Exit;
end;
if FTCPServer.Listen(Config.Port) then
begin
repeat
FTCPServer.CallAction;
CheckNetStates;
if SecondsBetween(FLastFlush, Now) >= 60 then
begin
FLandscape.Flush;
Config.Flush;
FLastFlush := Now;
end;
Sleep(1);
until FQuit;
end;
end;
procedure TCEDServer.SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
var
netState: TNetState;
begin
if ANetState <> nil then
begin
ANetState.SendQueue.Seek(0, soFromEnd);
ANetState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(ANetState.Socket);
end else //broadcast
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then
begin
netState.SendQueue.Seek(0, soFromEnd);
netState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(netState.Socket);
end;
end;
end;
if AFreePacket then
APacket.Free;
end;
procedure TCEDServer.Disconnect(ASocket: TLSocket);
begin
if ASocket.Connected then
begin
ASocket.Disconnect;
//OnDisconnect(ASocket);
//Handling of the disconnect is done in CheckNetStates after each CallAction
end;
end;
initialization
{$IFDEF Linux}
FpSignal(SIGINT, @OnSigInt);
FpSignal(SIGTERM, @OnSigInt); //SIGTERM should shutdown the server cleanly too
//FpSignal(SIGSEGV, @OnSigSegv);
{$ENDIF}
{$IFDEF Windows}
SetConsoleCtrlHandler(@OnConsoleCtrlEvent, True);
{$ENDIF}
end.

View File

@@ -1,207 +1,207 @@
(*
* 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 UClientHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, math;
type
{ TClientConnectedPacket }
TClientConnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientDisconnectedPacket }
TClientDisconnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientListPacket }
TClientListPacket = class(TPacket)
constructor Create(AAvoid: TNetState = nil);
end;
{ TSetClientPosPacket }
TSetClientPosPacket = class(TPacket)
constructor Create(APos: TPoint);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(ASender, AMessage: string);
end;
{ TAccessLevelChangedPacket }
TAccessLevelChangedPacket = class(TPacket)
constructor Create(AAccessLevel: TAccessLevel);
end;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ClientPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
UCEDServer, UPackets;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alView) then Exit;
packetHandler := ClientPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
pos: TPoint;
begin
pos.x := ABuffer.ReadWord;
pos.y := ABuffer.ReadWord;
ANetState.Account.LastPos := pos;
end;
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin
CEDServerInstance.SendPacket(nil, TCompressedPacket.Create(
TChatMessagePacket.Create(ANetState.Account.Name, ABuffer.ReadStringNull)));
end;
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
begin
account := Accounts.Find(ABuffer.ReadStringNull);
if account <> nil then
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
{ TClientConnectedPacket }
constructor TClientConnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($01);
FStream.WriteStringNull(AUsername);
end;
{ TClientDisconnectedPacket }
constructor TClientDisconnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($02);
FStream.WriteStringNull(AUsername);
end;
{ TClientListPacket }
constructor TClientListPacket.Create(AAvoid: TNetState = nil);
var
netState: TNetState;
begin
inherited Create($0C, 0);
FStream.WriteByte($03);
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState <> AAvoid) and (netState.Account <> nil) then
FStream.WriteStringNull(netState.Account.Name);
until not CEDServerInstance.TCPServer.IterNext;
end;
end;
{ TSetClientPosPacket }
constructor TSetClientPosPacket.Create(APos: TPoint);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(EnsureRange(APos.x, 0, CEDServerInstance.Landscape.CellWidth - 1));
FStream.WriteWord(EnsureRange(APos.y, 0, CEDServerInstance.Landscape.CellHeight - 1));
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(ASender, AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(ASender);
FStream.WriteStringNull(AMessage);
end;
{ TAccessLevelChangedPacket }
constructor TAccessLevelChangedPacket.Create(AAccessLevel: TAccessLevel);
begin
inherited Create($0C, 0);
FStream.WriteByte($07);
FStream.WriteByte(Byte(AAccessLevel));
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ClientPacketHandlers[i] := nil;
ClientPacketHandlers[$04] := TPacketHandler.Create(0, @OnUpdateClientPosPacket);
ClientPacketHandlers[$05] := TPacketHandler.Create(0, @OnChatMessagePacket);
ClientPacketHandlers[$06] := TPacketHandler.Create(0, @OnGotoClientPosPacket);
finalization
for i := 0 to $FF do
if ClientPacketHandlers[i] <> nil then
ClientPacketHandlers[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 UClientHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, math;
type
{ TClientConnectedPacket }
TClientConnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientDisconnectedPacket }
TClientDisconnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientListPacket }
TClientListPacket = class(TPacket)
constructor Create(AAvoid: TNetState = nil);
end;
{ TSetClientPosPacket }
TSetClientPosPacket = class(TPacket)
constructor Create(APos: TPoint);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(ASender, AMessage: string);
end;
{ TAccessLevelChangedPacket }
TAccessLevelChangedPacket = class(TPacket)
constructor Create(AAccessLevel: TAccessLevel);
end;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ClientPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
UCEDServer, UPackets;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alView) then Exit;
packetHandler := ClientPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
pos: TPoint;
begin
pos.x := ABuffer.ReadWord;
pos.y := ABuffer.ReadWord;
ANetState.Account.LastPos := pos;
end;
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin
CEDServerInstance.SendPacket(nil, TCompressedPacket.Create(
TChatMessagePacket.Create(ANetState.Account.Name, ABuffer.ReadStringNull)));
end;
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
begin
account := Config.Accounts.Find(ABuffer.ReadStringNull);
if account <> nil then
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
{ TClientConnectedPacket }
constructor TClientConnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($01);
FStream.WriteStringNull(AUsername);
end;
{ TClientDisconnectedPacket }
constructor TClientDisconnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($02);
FStream.WriteStringNull(AUsername);
end;
{ TClientListPacket }
constructor TClientListPacket.Create(AAvoid: TNetState = nil);
var
netState: TNetState;
begin
inherited Create($0C, 0);
FStream.WriteByte($03);
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState <> AAvoid) and (netState.Account <> nil) then
FStream.WriteStringNull(netState.Account.Name);
until not CEDServerInstance.TCPServer.IterNext;
end;
end;
{ TSetClientPosPacket }
constructor TSetClientPosPacket.Create(APos: TPoint);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(EnsureRange(APos.x, 0, CEDServerInstance.Landscape.CellWidth - 1));
FStream.WriteWord(EnsureRange(APos.y, 0, CEDServerInstance.Landscape.CellHeight - 1));
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(ASender, AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(ASender);
FStream.WriteStringNull(AMessage);
end;
{ TAccessLevelChangedPacket }
constructor TAccessLevelChangedPacket.Create(AAccessLevel: TAccessLevel);
begin
inherited Create($0C, 0);
FStream.WriteByte($07);
FStream.WriteByte(Byte(AAccessLevel));
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ClientPacketHandlers[i] := nil;
ClientPacketHandlers[$04] := TPacketHandler.Create(0, @OnUpdateClientPosPacket);
ClientPacketHandlers[$05] := TPacketHandler.Create(0, @OnChatMessagePacket);
ClientPacketHandlers[$06] := TPacketHandler.Create(0, @OnGotoClientPosPacket);
finalization
for i := 0 to $FF do
if ClientPacketHandlers[i] <> nil then
ClientPacketHandlers[i].Free;
{$WARNINGS ON}
end.

View File

@@ -1,182 +1,357 @@
(*
* 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 UConfig;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, IniFiles, md5, Keyboard, UAccount;
var
AppDir: string;
Config: TIniFile;
Accounts: TAccountList;
procedure InitConfig;
function LoadConfig: Boolean;
function TimeStamp: string;
implementation
const
CONFIGVERSION = 2;
function QueryPassword: String;
var
pwChar: char;
begin
Result := '';
InitKeyboard;
try
repeat
pwChar := GetKeyEventChar(TranslateKeyEvent(GetKeyEvent));
case pwChar of
#8: Result := Copy(Result, 1, Length(Result) - 1);
#13: break;
else
Result := Result + pwChar;
end;
until pwChar = #13;
finally
DoneKeyboard;
end;
writeln('');
end;
procedure InitConfig;
var
configFile: string;
stringValue, password: string;
intValue: Integer;
begin
configFile := ChangeFileExt(ParamStr(0), '.ini');
DeleteFile(configFile);
Config := TIniFile.Create(configFile);
Config.WriteInteger('Config', 'Version', CONFIGVERSION);
Writeln('Configuring Network');
Writeln('===================');
Write ('Port [2597]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 2597;
Config.WriteInteger('Network', 'Port', intValue);
Writeln('');
Writeln('Configuring Paths');
Writeln('=================');
Write ('map [map0.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'map0.mul';
Config.WriteString('Paths', 'map', stringValue);
Write ('statics [statics0.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'statics0.mul';
Config.WriteString('Paths', 'statics', stringValue);
Write ('staidx [staidx0.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'staidx0.mul';
Config.WriteString('Paths', 'staidx', stringValue);
Write ('tiledata [tiledata.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'tiledata.mul';
Config.WriteString('Paths', 'tiledata', stringValue);
Write ('radarcol [radarcol.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'radarcol.mul';
Config.WriteString('Paths', 'radarcol', stringValue);
Writeln('');
Writeln('Parameters');
Writeln('==========');
Write ('Map width [768]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 768;
Config.WriteInteger('Parameters', 'Width', intValue);
Write ('Map height [512]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 512;
Config.WriteInteger('Parameters', 'Height', intValue);
Writeln('');
Writeln('Admin account');
Writeln('=============');
repeat
Write('Account name: ');
Readln(stringValue);
until stringValue <> '';
Write ('Password [hidden]: ');
password := QueryPassword;
Config.WriteString('Accounts', stringValue, '255:' + MD5Print(MD5String(password)));
end;
function LoadConfig: Boolean;
var
configFile: string;
values: TStringList;
i: Integer;
begin
configFile := ChangeFileExt(ParamStr(0), '.ini');
if FileExists(configFile) then
begin
Config := TIniFile.Create(configFile);
Result := (Config.ReadInteger('Config', 'Version', 0) = CONFIGVERSION);
if Result then
begin
Accounts := TAccountList.Create;
values := TStringList.Create;
Config.ReadSectionRaw('Accounts', values);
for i := 0 to values.Count - 1 do
Accounts.Add(TAccount.Create(values.Strings[i]));
values.Free;
end;
end else
Result := False;
end;
function TimeStamp: string;
begin
Result := '[' + DateTimeToStr(Now) + '] ';
end;
initialization
begin
AppDir := ExtractFilePath(ParamStr(0));
if AppDir[Length(AppDir)] <> PathDelim then
AppDir := AppDir + PathDelim;
end;
finalization
begin
if Config <> nil then FreeAndNil(Config);
if Accounts <> nil then FreeAndNil(Accounts);
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 2008 Andreas Schneider
*)
unit UConfig;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums;
type
TInvalidConfigVersionExeption = class(Exception);
{ TMapInfo }
TMapInfo = class(TObject, ISerializable)
constructor Create(AOwner: IInvalidate);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
FOwner: IInvalidate;
FMapFile: string;
FStaticsFile: string;
FStaIdxFile: string;
FWidth: Word;
FHeight: Word;
procedure SetHeight(const AValue: Word);
procedure SetMapFile(const AValue: string);
procedure SetStaIdxFile(const AValue: string);
procedure SetStaticsFile(const AValue: string);
procedure SetWidth(const AValue: Word);
public
property MapFile: string read FMapFile write SetMapFile;
property StaticsFile: string read FStaticsFile write SetStaticsFile;
property StaIdxFile: string read FStaIdxFile write SetStaIdxFile;
property Width: Word read FWidth write SetWidth;
property Height: Word read FHeight write SetHeight;
end;
{ TConfig }
TConfig = class(TObject, ISerializable, IInvalidate)
constructor Create(AFilename: string);
constructor Init(AFilename: string);
destructor Destroy; override;
procedure Serialize(AElement: TDOMElement);
protected
FFilename: string;
FPort: Integer;
FMap: TMapInfo;
FTiledata: string;
FRadarcol: string;
FAccounts: TAccountList;
FChanged: Boolean;
procedure SetPort(const AValue: Integer);
procedure SetRadarcol(const AValue: string);
procedure SetTiledata(const AValue: string);
public
property Port: Integer read FPort write SetPort;
property Map: TMapInfo read FMap;
property Tiledata: string read FTiledata write SetTiledata;
property Radarcol: string read FRadarcol write SetRadarcol;
property Accounts: TAccountList read FAccounts;
procedure Flush;
procedure Invalidate;
end;
var
AppDir: string;
ConfigFile: string;
Config: TConfig;
function TimeStamp: string;
implementation
const
CONFIGVERSION = 3;
function QueryPassword: String;
var
pwChar: char;
begin
Result := '';
InitKeyboard;
try
repeat
pwChar := GetKeyEventChar(TranslateKeyEvent(GetKeyEvent));
case pwChar of
#8: Result := Copy(Result, 1, Length(Result) - 1);
#13: break;
else
Result := Result + pwChar;
end;
until pwChar = #13;
finally
DoneKeyboard;
end;
writeln('');
end;
function TimeStamp: string;
begin
Result := '[' + DateTimeToStr(Now) + '] ';
end;
{ TMapInfo }
constructor TMapInfo.Create(AOwner: IInvalidate);
begin
inherited Create;
FOwner := AOwner;
end;
constructor TMapInfo.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
begin
Create(AOwner);
FMapFile := TXmlHelper.ReadString(AElement, 'Map', 'map0.mul');
FStaIdxFile := TXmlHelper.ReadString(AElement, 'StaIdx', 'staidx0.mul');
FStaticsFile := TXmlHelper.ReadString(AElement, 'Statics', 'statics0.mul');
FWidth := TXmlHelper.ReadInteger(AElement, 'Width', 768);
FHeight := TXmlHelper.ReadInteger(AElement, 'Height', 512);
end;
procedure TMapInfo.Serialize(AElement: TDOMElement);
begin
TXmlHelper.WriteString(AElement, 'Map', FMapFile);
TXmlHelper.WriteString(AElement, 'StaIdx', FStaIdxFile);
TXmlHelper.WriteString(AElement, 'Statics', FStaticsFile);
TXmlHelper.WriteInteger(AElement, 'Width', FWidth);
TXmlHelper.WriteInteger(AElement, 'Height', FHeight);
end;
procedure TMapInfo.SetHeight(const AValue: Word);
begin
FHeight := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetMapFile(const AValue: string);
begin
FMapFile := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetStaIdxFile(const AValue: string);
begin
FStaIdxFile := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetStaticsFile(const AValue: string);
begin
FStaticsFile := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetWidth(const AValue: Word);
begin
FWidth := AValue;
FOwner.Invalidate;
end;
{ TConfig }
constructor TConfig.Create(AFilename: string);
var
xmlDoc: TXMLDocument;
version: Integer;
xmlElement: TDOMElement;
begin
inherited Create;
FFilename := AFilename;
ReadXMLFile(xmlDoc, AFilename);
if not ((xmlDoc.DocumentElement.NodeName = 'CEDConfig') and
TryStrToInt(xmlDoc.DocumentElement.AttribStrings['Version'], version) and
(version = CONFIGVERSION)) then
raise TInvalidConfigVersionExeption.Create(Format('%d <> %d', [version, CONFIGVERSION]));
FPort := TXmlHelper.ReadInteger(xmlDoc.DocumentElement, 'Port', 2597);
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Map'));
if not assigned(xmlElement) then
raise TInvalidConfigVersionExeption.Create('Map information not found');
FMap := TMapInfo.Deserialize(Self, xmlElement);
FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul');
FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul');
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Accounts'));
if not assigned(xmlElement) then
raise TInvalidConfigVersionExeption.Create('Account information not found');
FAccounts := TAccountList.Deserialize(Self, xmlElement);
xmlDoc.Free;
FChanged := False;
end;
constructor TConfig.Init(AFilename: string);
var
stringValue, password: string;
intValue: Integer;
begin
inherited Create;
FFilename := AFilename;
FMap := TMapInfo.Create(Self);
FAccounts := TAccountList.Create(Self);
Writeln('Configuring Network');
Writeln('===================');
Write ('Port [2597]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 2597;
FPort := intValue;
Writeln('');
Writeln('Configuring Paths');
Writeln('=================');
Write ('map [map0.mul]: ');
Readln (FMap.MapFile);
if FMap.MapFile = '' then FMap.MapFile := 'map0.mul';
Write ('statics [statics0.mul]: ');
Readln (FMap.StaticsFile);
if FMap.StaticsFile = '' then FMap.StaticsFile := 'statics0.mul';
Write ('staidx [staidx0.mul]: ');
Readln (FMap.StaIdxFile);
if FMap.StaIdxFile = '' then FMap.StaIdxFile := 'staidx0.mul';
Write ('tiledata [tiledata.mul]: ');
Readln (FTiledata);
if FTiledata = '' then FTiledata := 'tiledata.mul';
Write ('radarcol [radarcol.mul]: ');
Readln (FRadarcol);
if FRadarcol = '' then FRadarcol := 'radarcol.mul';
Writeln('');
Writeln('Parameters');
Writeln('==========');
Write ('Map width [768]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 768;
FMap.Width := intValue;
Write ('Map height [512]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 512;
FMap.Height := intValue;
Writeln('');
Writeln('Admin account');
Writeln('=============');
repeat
Write('Account name: ');
Readln(stringValue);
until stringValue <> '';
Write ('Password [hidden]: ');
password := QueryPassword;
FAccounts.Add(TAccount.Create(FAccounts, stringValue,
MD5Print(MD5String(password)), alAdministrator));
FChanged := True;
end;
destructor TConfig.Destroy;
begin
if Assigned(FMap) then FreeAndNil(FMap);
if Assigned(FAccounts) then FreeAndNil(FAccounts);
inherited Destroy;
end;
procedure TConfig.Serialize(AElement: TDOMElement);
begin
TXmlHelper.WriteInteger(AElement, 'Port', FPort);
FMap.Serialize(TXmlHelper.AssureElement(AElement, 'Map'));
TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata);
TXmlHelper.WriteString(AElement, 'Radarcol', FRadarcol);
FAccounts.Serialize(TXmlHelper.AssureElement(AElement, 'Accounts'));
end;
procedure TConfig.SetPort(const AValue: Integer);
begin
FPort := AValue;
Invalidate;
end;
procedure TConfig.SetRadarcol(const AValue: string);
begin
FRadarcol := AValue;
Invalidate;
end;
procedure TConfig.SetTiledata(const AValue: string);
begin
FTiledata := AValue;
Invalidate;
end;
procedure TConfig.Flush;
var
xmlDoc: TXMLDocument;
begin
if FChanged then
begin
xmlDoc := TXMLDocument.Create;
xmlDoc.AppendChild(xmlDoc.CreateElement('CEDConfig'));
xmlDoc.DocumentElement.AttribStrings['Version'] := IntToStr(CONFIGVERSION);
Serialize(xmlDoc.DocumentElement);
WriteXMLFile(xmlDoc, FFilename);
xmlDoc.Free;
FChanged := False;
end;
end;
procedure TConfig.Invalidate;
begin
FChanged := True;
end;
initialization
begin
AppDir := ExtractFilePath(ParamStr(0));
if AppDir[Length(AppDir)] <> PathDelim then
AppDir := AppDir + PathDelim;
{TODO : add command line parameter to specify the config}
Config := nil;
ConfigFile := ChangeFileExt(ParamStr(0), '.xml');
end;
end.

View File

@@ -1,195 +1,198 @@
(*
* 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 UConnectionHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums;
type
{ TProtocolVersion }
TProtocolVersionPacket = class(TPacket)
constructor Create(AVersion: Cardinal);
end;
{ TLoginResponsePacket }
TLoginResponsePacket = class(TPacket)
constructor Create(AState: TLoginState; AAccessLevel: TAccessLevel = alNone);
end;
{ TServerStatePacket }
TServerStatePacket = class(TPacket)
constructor Create(AState: TServerState; AMessage: string = '');
end;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ConnectionPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UClientHandling, UPackets;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
packetHandler := ConnectionPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
username, passwordHash: string;
account: TAccount;
pwHash: string;
netState: TNetState;
invalid: Boolean;
begin
username := ABuffer.ReadStringNull;
passwordHash := MD5Print(MD5String(ABuffer.ReadStringNull));
account := Accounts.Find(username);
if account <> nil then
begin
if account.AccessLevel > alNone then
begin
if account.PasswordHash = passwordHash then
begin
invalid := False;
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsAlreadyLoggedIn));
CEDServerInstance.Disconnect(ANetState.Socket);
invalid := True;
Break;
end;
until not CEDServerInstance.TCPServer.IterNext;
end;
if not invalid then
begin
Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress);
ANetState.Account := account;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account.AccessLevel));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TClientListPacket.Create(ANetState)));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username));
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
end else
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Disconnect(ANetState.Socket);
end;
{ TProtocolVersionPacket }
constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
begin
inherited Create($02, 0);
FStream.WriteByte($01);
FStream.WriteCardinal(AVersion);
end;
{ TLoginResponsePacket }
constructor TLoginResponsePacket.Create(AState: TLoginState;
AAccessLevel: TAccessLevel = alNone);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteByte(Byte(AState));
if AState = lsOK then
begin
FStream.WriteByte(Byte(AAccessLevel));
FStream.WriteWord(Config.ReadInteger('Parameters', 'Width', 768));
FStream.WriteWord(Config.ReadInteger('Parameters', 'Height', 512));
end;
end;
{ TServerStatePacket }
constructor TServerStatePacket.Create(AState: TServerState; AMessage: string = '');
begin
inherited Create($02, 0);
FStream.WriteByte($04);
FStream.WriteByte(Byte(AState));
if AState = ssOther then
FStream.WriteStringNull(AMessage);
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ConnectionPacketHandlers[i] := nil;
ConnectionPacketHandlers[$03] := TPacketHandler.Create(0, @OnLoginRequestPacket);
ConnectionPacketHandlers[$05] := TPacketHandler.Create(0, @OnQuitPacket);
finalization
for i := 0 to $FF do
if ConnectionPacketHandlers[i] <> nil then
ConnectionPacketHandlers[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 2008 Andreas Schneider
*)
unit UConnectionHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums;
type
{ TProtocolVersion }
TProtocolVersionPacket = class(TPacket)
constructor Create(AVersion: Cardinal);
end;
{ TLoginResponsePacket }
TLoginResponsePacket = class(TPacket)
constructor Create(AState: TLoginState; AAccessLevel: TAccessLevel = alNone);
end;
{ TServerStatePacket }
TServerStatePacket = class(TPacket)
constructor Create(AState: TServerState; AMessage: string = '');
end;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ConnectionPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UClientHandling, UPackets;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
packetHandler := ConnectionPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
username, passwordHash: string;
account: TAccount;
pwHash: string;
netState: TNetState;
invalid: Boolean;
begin
username := ABuffer.ReadStringNull;
passwordHash := MD5Print(MD5String(ABuffer.ReadStringNull));
account := Config.Accounts.Find(username);
if account <> nil then
begin
if account.AccessLevel > alNone then
begin
if account.PasswordHash = passwordHash then
begin
invalid := False;
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsAlreadyLoggedIn));
CEDServerInstance.Disconnect(ANetState.Socket);
invalid := True;
Break;
end;
until not CEDServerInstance.TCPServer.IterNext;
end;
if not invalid then
begin
Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress);
ANetState.Account := account;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account.AccessLevel));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TClientListPacket.Create(ANetState)));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username));
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
end else
begin
Writeln(TimeStamp, 'Invalid password for ', username);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
Writeln(TimeStamp, 'Access denied for ', username);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
Writeln(TimeStamp, 'Invalid account specified: ', ANetState.Socket.PeerAddress);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Disconnect(ANetState.Socket);
end;
{ TProtocolVersionPacket }
constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
begin
inherited Create($02, 0);
FStream.WriteByte($01);
FStream.WriteCardinal(AVersion);
end;
{ TLoginResponsePacket }
constructor TLoginResponsePacket.Create(AState: TLoginState;
AAccessLevel: TAccessLevel = alNone);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteByte(Byte(AState));
if AState = lsOK then
begin
FStream.WriteByte(Byte(AAccessLevel));
FStream.WriteWord(Config.Map.Width);
FStream.WriteWord(Config.Map.Height);
end;
end;
{ TServerStatePacket }
constructor TServerStatePacket.Create(AState: TServerState; AMessage: string = '');
begin
inherited Create($02, 0);
FStream.WriteByte($04);
FStream.WriteByte(Byte(AState));
if AState = ssOther then
FStream.WriteStringNull(AMessage);
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ConnectionPacketHandlers[i] := nil;
ConnectionPacketHandlers[$03] := TPacketHandler.Create(0, @OnLoginRequestPacket);
ConnectionPacketHandlers[$05] := TPacketHandler.Create(0, @OnQuitPacket);
finalization
for i := 0 to $FF do
if ConnectionPacketHandlers[i] <> nil then
ConnectionPacketHandlers[i].Free;
{$WARNINGS ON}
end.

View File

@@ -30,7 +30,7 @@ unit ULandscape;
interface
uses
SysUtils, Classes, contnrs, UGenericIndex, UMap, UStatics, UTileData,
SysUtils, Classes, contnrs, UGenericIndex, UMap, UStatics, UTiledata,
UWorldItem, UMulBlock, math,
UTileDataProvider, URadarMap,
UListSort, UCacheManager, ULinkedList, UBufferedStreams,

View File

@@ -14,7 +14,6 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
@@ -29,7 +28,7 @@
<PackageName Value="lnetbase"/>
</Item1>
</RequiredPackages>
<Units Count="8">
<Units Count="9">
<Unit0>
<Filename Value="cedserver.lpr"/>
<IsPartOfProject Value="True"/>
@@ -70,6 +69,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="ULargeScaleOperations"/>
</Unit7>
<Unit8>
<Filename Value="../UInterfaces.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UInterfaces"/>
</Unit8>
</Units>
</ProjectOptions>
<CompilerOptions>
@@ -89,7 +93,7 @@
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
<TargetOS Value="Win32"/>
<TargetOS Value="Linux"/>
</CodeGeneration>
<Linking>
<Debugging>

View File

@@ -1,75 +1,73 @@
(*
* 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
*)
program cedserver;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
SysUtils, Classes,
lnetbase,
UConfig, UCEDServer, URadarMap, ULargeScaleOperations;
{$I version.inc}
begin
Writeln('UO CentrED Server Version ', ProductVersion);
Writeln('Copyright ', Copyright);
//Writeln('================================');
Writeln('');
{$IFDEF Windows}
if not LoadConfig then
begin
InitConfig;
Writeln('');
end;
{$ELSE}
if ParamStr(1) = '--init' then
begin
InitConfig;
Halt;
end;
if not LoadConfig then
begin
Writeln('No valid config file was found. Use --init to create one.');
Halt;
end;
{$ENDIF}
Write(TimeStamp, 'Initializing ... ');
Randomize;
CEDServerInstance := TCEDServer.Create;
Writeln('Done');
CEDServerInstance.Run;
Write(TimeStamp, 'Terminating ... ');
CEDServerInstance.Free;
Writeln('Done');
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 2008 Andreas Schneider
*)
program cedserver;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
SysUtils, Classes,
lnetbase,
UConfig, UCEDServer, URadarMap, ULargeScaleOperations;
{$I version.inc}
begin
Writeln('UO CentrED Server Version ', ProductVersion);
Writeln('Copyright ', Copyright);
//Writeln('================================');
Writeln('');
{$IFDEF Windows}
if FileExists(ConfigFile) then
Config := TConfig.Create(ConfigFile)
else
Config := TConfig.Init(ConfigFile);
{$ELSE}
if ParamStr(1) = '--init' then
Config := TConfig.Init(ConfigFile)
else if FileExists(ConfigFile) then
Config := TConfig.Create(ConfigFile)
else begin
Writeln('No valid config file was found. Use --init to create one.');
Halt;
end;
{$ENDIF}
Write(TimeStamp, 'Initializing ... ');
Randomize;
CEDServerInstance := TCEDServer.Create;
Writeln('Done');
CEDServerInstance.Run;
Write(TimeStamp, 'Terminating ... ');
FreeAndNil(CEDServerInstance);
Config.Flush;
FreeAndNil(Config);
Writeln('Done');
end.