1018 lines
26 KiB
Plaintext
1018 lines
26 KiB
Plaintext
|
{
|
|||
|
$Project$
|
|||
|
$Workfile$
|
|||
|
$Revision$
|
|||
|
$DateUTC$
|
|||
|
$Id$
|
|||
|
|
|||
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|||
|
under the dual-licensing agreement described on the Indy website.
|
|||
|
(http://www.indyproject.org/)
|
|||
|
|
|||
|
Copyright:
|
|||
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|||
|
}
|
|||
|
{
|
|||
|
$Log$
|
|||
|
}
|
|||
|
{
|
|||
|
Rev 1.1 12/7/2002 06:43:48 PM JPMugaas
|
|||
|
These should now compile except for Socks server. IPVersion has to be a
|
|||
|
property someplace for that.
|
|||
|
|
|||
|
|
|||
|
Rev 1.0 11/13/2002 08:04:00 AM JPMugaas
|
|||
|
}
|
|||
|
|
|||
|
unit IdTunnelSlave;
|
|||
|
|
|||
|
interface
|
|||
|
|
|||
|
{$i IdCompilerDefines.inc}
|
|||
|
|
|||
|
uses
|
|||
|
SysUtils, Classes, SyncObjs,
|
|||
|
IdTunnelCommon, IdTCPServer, IdTCPClient,
|
|||
|
IdGlobal, IdStack, IdResourceStrings,
|
|||
|
IdThread, IdComponent, IdTCPConnection;
|
|||
|
|
|||
|
type
|
|||
|
TSlaveThread = class;
|
|||
|
TIdTunnelSlave = class;
|
|||
|
|
|||
|
TTunnelEvent = procedure(Thread: TSlaveThread) of object;
|
|||
|
|
|||
|
///////////////////////////////////////////////////////////////////////////////
|
|||
|
// Slave Tunnel classes
|
|||
|
//
|
|||
|
// Client data structure
|
|||
|
TClientData = class
|
|||
|
public
|
|||
|
Id: Integer;
|
|||
|
TimeOfConnection: TDateTime;
|
|||
|
DisconnectedOnRequest: Boolean;
|
|||
|
SelfDisconnected: Boolean;
|
|||
|
ClientAuthorised: Boolean;
|
|||
|
Locker: TCriticalSection;
|
|||
|
Port: Word;
|
|||
|
IpAddr: TIdInAddr;
|
|||
|
constructor Create;
|
|||
|
destructor Destroy; override;
|
|||
|
end;
|
|||
|
|
|||
|
// Slave thread - tunnel thread to communicate with Master
|
|||
|
TSlaveThread = class(TIdThread)
|
|||
|
private
|
|||
|
FLock: TCriticalSection;
|
|||
|
FExecuted: Boolean;
|
|||
|
FConnection: TIdTCPClient;
|
|||
|
protected
|
|||
|
procedure SetExecuted(Value: Boolean);
|
|||
|
function GetExecuted: Boolean;
|
|||
|
procedure AfterRun; override;
|
|||
|
procedure BeforeRun; override;
|
|||
|
public
|
|||
|
SlaveParent: TIdTunnelSlave;
|
|||
|
Receiver: TReceiver;
|
|||
|
property Executed: Boolean read GetExecuted write SetExecuted;
|
|||
|
property Connection: TIdTCPClient read fConnection;
|
|||
|
constructor Create(Slave: TIdTunnelSlave); reintroduce;
|
|||
|
destructor Destroy; override;
|
|||
|
procedure Execute; override;
|
|||
|
procedure Run; override;
|
|||
|
end;
|
|||
|
|
|||
|
// TTunnelEvent = procedure(Thread: TSlaveThread) of object;
|
|||
|
|
|||
|
TIdTunnelSlave = class(TIdTCPServer)
|
|||
|
private
|
|||
|
fiMasterPort: Integer; // Port on which Master Tunnel accepts connections
|
|||
|
fsMasterHost: String; // Address of the Master Tunnel
|
|||
|
SClient: TIdTCPClient; // Client which talks to the Master Tunnel
|
|||
|
// fOnExecute, fOnConnect,
|
|||
|
fOnDisconnect: TIdServerThreadEvent;
|
|||
|
fOnStatus: TIdStatusEvent;
|
|||
|
fOnBeforeTunnelConnect: TSendTrnEventC;
|
|||
|
fOnTransformRead: TTunnelEventC;
|
|||
|
fOnInterpretMsg: TSendMsgEventC;
|
|||
|
fOnTransformSend: TSendTrnEventC;
|
|||
|
fOnTunnelDisconnect: TTunnelEvent;
|
|||
|
|
|||
|
Sender: TSender; // Communication class
|
|||
|
OnlyOneThread: TCriticalSection; // Some locking code
|
|||
|
SendThroughTunnelLock: TCriticalSection; // Some locking code
|
|||
|
GetClientThreadLock: TCriticalSection; // Some locking code
|
|||
|
// LockClientNumber: TCriticalSection;
|
|||
|
StatisticsLocker: TCriticalSection;
|
|||
|
ManualDisconnected: Boolean; // We trigered the disconnection
|
|||
|
StopTransmiting: Boolean;
|
|||
|
fbActive: Boolean;
|
|||
|
fbSocketize: Boolean;
|
|||
|
SlaveThread: TSlaveThread; // Thread which receives data from the Master
|
|||
|
fLogger: TLogger;
|
|||
|
|
|||
|
// Statistics counters
|
|||
|
flConnectedClients, // Number of connected clients
|
|||
|
fNumberOfConnectionsValue,
|
|||
|
fNumberOfPacketsValue,
|
|||
|
fCompressionRatioValue,
|
|||
|
fCompressedBytes,
|
|||
|
fBytesRead,
|
|||
|
fBytesWrite: Integer;
|
|||
|
|
|||
|
SlaveThreadTerminated: Boolean;
|
|||
|
|
|||
|
procedure SendMsg(var Header: TIdHeader; s: String);
|
|||
|
procedure ClientOperation(Operation: Integer; UserId: Integer; s: String);
|
|||
|
procedure DisconectAllUsers;
|
|||
|
//procedure DoStatus(Sender: TComponent; const sMsg: String);
|
|||
|
function GetNumClients: Integer;
|
|||
|
procedure TerminateTunnelThread;
|
|||
|
function GetClientThread(UserID: Integer): TIdPeerThread;
|
|||
|
procedure OnTunnelThreadTerminate(Sender: TObject);
|
|||
|
protected
|
|||
|
fbAcceptConnections: Boolean; // status if we accept new connections
|
|||
|
// it is used with tunnels with some athentication
|
|||
|
// procedure between slave and master tunnel
|
|||
|
|
|||
|
procedure DoConnect(Thread: TIdPeerThread); override;
|
|||
|
procedure DoDisconnect(Thread: TIdPeerThread); override;
|
|||
|
function DoExecute(Thread: TIdPeerThread): boolean; override;
|
|||
|
procedure DoBeforeTunnelConnect(var Header: TIdHeader; var CustomMsg: String); virtual;
|
|||
|
procedure DoTransformRead(Receiver: TReceiver); virtual;
|
|||
|
procedure DoInterpretMsg(var CustomMsg: String); virtual;
|
|||
|
procedure DoTransformSend(var Header: TIdHeader; var CustomMsg: String); virtual;
|
|||
|
procedure DoStatus(Sender: TComponent; const sMsg: String); virtual;
|
|||
|
procedure DoTunnelDisconnect(Thread: TSlaveThread); virtual;
|
|||
|
procedure LogEvent(Msg: String);
|
|||
|
procedure SetActive(pbValue: Boolean); override;
|
|||
|
public
|
|||
|
procedure SetStatistics(Module: Integer; Value: Integer);
|
|||
|
procedure GetStatistics(Module: Integer; var Value: Integer);
|
|||
|
constructor Create(AOwner: TComponent); override;
|
|||
|
destructor Destroy; override;
|
|||
|
//
|
|||
|
property Active: Boolean read FbActive write SetActive;
|
|||
|
property Logger: TLogger read fLogger write fLogger;
|
|||
|
property NumClients: Integer read GetNumClients;
|
|||
|
published
|
|||
|
property MasterHost: string read fsMasterHost write fsMasterHost;
|
|||
|
property MasterPort: Integer read fiMasterPort write fiMasterPort;
|
|||
|
property Socks4: Boolean read fbSocketize write fbSocketize default False;
|
|||
|
// property OnConnect: TIdServerThreadEvent read FOnConnect write FOnConnect;
|
|||
|
property OnDisconnect: TIdServerThreadEvent read FOnDisconnect write FOnDisconnect;
|
|||
|
// property OnExecute: TIdServerThreadEvent read FOnExecute write FOnExecute;
|
|||
|
property OnBeforeTunnelConnect: TSendTrnEventC read fOnBeforeTunnelConnect
|
|||
|
write fOnBeforeTunnelConnect;
|
|||
|
property OnTransformRead: TTunnelEventC read fOnTransformRead
|
|||
|
write fOnTransformRead;
|
|||
|
property OnInterpretMsg: TSendMsgEventC read fOnInterpretMsg write fOnInterpretMsg;
|
|||
|
property OnTransformSend: TSendTrnEventC read fOnTransformSend write fOnTransformSend;
|
|||
|
property OnStatus: TIdStatusEvent read FOnStatus write FOnStatus;
|
|||
|
property OnTunnelDisconnect: TTunnelEvent read FOnTunnelDisconnect write FOnTunnelDisconnect;
|
|||
|
end;
|
|||
|
//
|
|||
|
// END Slave Tunnel classes
|
|||
|
///////////////////////////////////////////////////////////////////////////////
|
|||
|
|
|||
|
implementation
|
|||
|
|
|||
|
uses
|
|||
|
IdCoreGlobal,
|
|||
|
IdException,
|
|||
|
IdSocks,
|
|||
|
IdThreadSafe;
|
|||
|
|
|||
|
Var
|
|||
|
GUniqueID: TIdThreadSafeInteger;
|
|||
|
|
|||
|
function GetNextID: Integer;
|
|||
|
begin
|
|||
|
if Assigned(GUniqueID) then begin
|
|||
|
Result := GUniqueID.Increment;
|
|||
|
end
|
|||
|
else
|
|||
|
result := -1;
|
|||
|
end;
|
|||
|
|
|||
|
///////////////////////////////////////////////////////////////////////////////
|
|||
|
// Slave Tunnel classes
|
|||
|
//
|
|||
|
constructor TIdTunnelSlave.Create(AOwner: TComponent);
|
|||
|
begin
|
|||
|
inherited;
|
|||
|
fbActive := False;
|
|||
|
flConnectedClients := 0;
|
|||
|
fNumberOfConnectionsValue := 0;
|
|||
|
fNumberOfPacketsValue := 0;
|
|||
|
fCompressionRatioValue := 0;
|
|||
|
fCompressedBytes := 0;
|
|||
|
fBytesRead := 0;
|
|||
|
fBytesWrite := 0;
|
|||
|
|
|||
|
fbAcceptConnections := True;
|
|||
|
SlaveThreadTerminated := False;
|
|||
|
OnlyOneThread := TCriticalSection.Create;
|
|||
|
SendThroughTunnelLock := TCriticalSection.Create;
|
|||
|
GetClientThreadLock := TCriticalSection.Create;
|
|||
|
// LockClientNumber := TCriticalSection.Create;
|
|||
|
StatisticsLocker := TCriticalSection.Create;
|
|||
|
|
|||
|
Sender := TSender.Create;
|
|||
|
SClient := TIdTCPClient.Create(nil);
|
|||
|
// POZOR MO<4D>NA NAPAKA
|
|||
|
// SClient.OnStatus := self.DoStatus; ORIGINAL
|
|||
|
SClient.OnStatus := self.OnStatus;
|
|||
|
|
|||
|
ManualDisconnected := False;
|
|||
|
StopTransmiting := False;
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
destructor TIdTunnelSlave.Destroy;
|
|||
|
begin
|
|||
|
|
|||
|
fbAcceptConnections := False;
|
|||
|
StopTransmiting := True;
|
|||
|
ManualDisconnected := True;
|
|||
|
|
|||
|
Active := False;
|
|||
|
|
|||
|
// DisconectAllUsers;
|
|||
|
|
|||
|
try
|
|||
|
if SClient.Connected then begin
|
|||
|
// DisconnectedByServer := False;
|
|||
|
SClient.Disconnect;
|
|||
|
end;
|
|||
|
except
|
|||
|
;
|
|||
|
end;
|
|||
|
|
|||
|
// if Assigned(SlaveThread) then
|
|||
|
// if not SlaveThread.Executed then
|
|||
|
// SlaveThread.TerminateAndWaitFor;
|
|||
|
if not SlaveThreadTerminated then
|
|||
|
TerminateTunnelThread;
|
|||
|
|
|||
|
FreeAndNil(SClient);
|
|||
|
FreeAndNil(Sender);
|
|||
|
// FreeAndNil(LockClientNumber);
|
|||
|
FreeAndNil(OnlyOneThread);
|
|||
|
FreeAndNil(SendThroughTunnelLock);
|
|||
|
FreeAndNil(GetClientThreadLock);
|
|||
|
FreeAndNil(StatisticsLocker);
|
|||
|
Logger := nil;
|
|||
|
|
|||
|
inherited Destroy;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.LogEvent(Msg: String);
|
|||
|
begin
|
|||
|
if Assigned(fLogger) then
|
|||
|
fLogger.LogEvent(Msg);
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DoStatus(Sender: TComponent; const sMsg: String);
|
|||
|
begin
|
|||
|
if Assigned(OnStatus) then begin
|
|||
|
OnStatus(self, hsStatusText, sMsg);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.SetActive(pbValue: Boolean);
|
|||
|
var
|
|||
|
ErrorConnecting: Boolean;
|
|||
|
begin
|
|||
|
// Active = False gets called again by inherited destructor
|
|||
|
if OnlyOneThread = nil then begin
|
|||
|
exit;
|
|||
|
end;
|
|||
|
|
|||
|
OnlyOneThread.Enter;
|
|||
|
try
|
|||
|
|
|||
|
if fbActive = pbValue then begin
|
|||
|
exit;
|
|||
|
end;
|
|||
|
|
|||
|
// if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then begin
|
|||
|
if pbValue then begin
|
|||
|
// DisconnectedByServer := False;
|
|||
|
ManualDisconnected := False;
|
|||
|
StopTransmiting := False;
|
|||
|
ErrorConnecting := False;
|
|||
|
SClient.Host := fsMasterHost;
|
|||
|
SClient.Port := fiMasterPort;
|
|||
|
try
|
|||
|
SClient.Connect;
|
|||
|
except
|
|||
|
fbActive := False;
|
|||
|
IndyRaiseOuterException(EIdTunnelConnectToMasterFailed.Create(RSTunnelConnectToMasterFailed));
|
|||
|
//Exit;
|
|||
|
end;
|
|||
|
if not ErrorConnecting then begin
|
|||
|
SlaveThread := TSlaveThread.Create(self);
|
|||
|
SlaveThreadTerminated := False;
|
|||
|
SlaveThread.Start;
|
|||
|
// Maybe we wait here till authentication of Slave happens
|
|||
|
// here can happen the error if the port is already occupied
|
|||
|
// we must handle this
|
|||
|
try
|
|||
|
inherited SetActive(True);
|
|||
|
fbActive := True;
|
|||
|
fbAcceptConnections := True;
|
|||
|
except
|
|||
|
StopTransmiting := False;
|
|||
|
DisconectAllUsers;
|
|||
|
SClient.Disconnect;
|
|||
|
TerminateTunnelThread;
|
|||
|
fbActive := False;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end
|
|||
|
else begin
|
|||
|
fbAcceptConnections := False;
|
|||
|
StopTransmiting := True;
|
|||
|
ManualDisconnected := True;
|
|||
|
// inherited Active := False; // Cancel accepting new clients
|
|||
|
inherited SetActive(False);
|
|||
|
|
|||
|
DisconectAllUsers; // Disconnect existing ones
|
|||
|
SClient.Disconnect;
|
|||
|
TerminateTunnelThread;
|
|||
|
|
|||
|
fbActive := pbValue;
|
|||
|
end;
|
|||
|
|
|||
|
// end;
|
|||
|
//fbActive := pbValue;
|
|||
|
|
|||
|
finally
|
|||
|
OnlyOneThread.Leave;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
function TIdTunnelSlave.GetNumClients: Integer;
|
|||
|
var
|
|||
|
ClientsNo: Integer;
|
|||
|
begin
|
|||
|
GetStatistics(NumberOfClientsType, ClientsNo);
|
|||
|
Result := ClientsNo;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
|
|||
|
procedure TIdTunnelSlave.SetStatistics(Module: Integer; Value: Integer);
|
|||
|
var
|
|||
|
packets: Real;
|
|||
|
ratio: Real;
|
|||
|
begin
|
|||
|
StatisticsLocker.Enter;
|
|||
|
try
|
|||
|
case Module of
|
|||
|
NumberOfClientsType: begin
|
|||
|
if TIdStatisticsOperation(Value) = soIncrease then begin
|
|||
|
Inc(flConnectedClients);
|
|||
|
Inc(fNumberOfConnectionsValue);
|
|||
|
end
|
|||
|
else begin
|
|||
|
Dec(flConnectedClients);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
NumberOfConnectionsType: begin
|
|||
|
Inc(fNumberOfConnectionsValue);
|
|||
|
end;
|
|||
|
|
|||
|
NumberOfPacketsType: begin
|
|||
|
Inc(fNumberOfPacketsValue);
|
|||
|
end;
|
|||
|
|
|||
|
CompressionRatioType: begin
|
|||
|
ratio := fCompressionRatioValue;
|
|||
|
packets := fNumberOfPacketsValue;
|
|||
|
ratio := (ratio/100.0 * (packets - 1.0) + Value/100.0) / packets;
|
|||
|
fCompressionRatioValue := Trunc(ratio * 100);
|
|||
|
end;
|
|||
|
|
|||
|
CompressedBytesType: begin
|
|||
|
fCompressedBytes := fCompressedBytes + Value;
|
|||
|
end;
|
|||
|
|
|||
|
BytesReadType: begin
|
|||
|
fBytesRead := fBytesRead + Value;
|
|||
|
end;
|
|||
|
|
|||
|
BytesWriteType: begin
|
|||
|
fBytesWrite := fBytesWrite + Value;
|
|||
|
end;
|
|||
|
end;
|
|||
|
finally
|
|||
|
StatisticsLocker.Leave;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
procedure TIdTunnelSlave.GetStatistics(Module: Integer; var Value: Integer);
|
|||
|
begin
|
|||
|
StatisticsLocker.Enter;
|
|||
|
try
|
|||
|
case Module of
|
|||
|
|
|||
|
NumberOfClientsType: begin
|
|||
|
Value := flConnectedClients;
|
|||
|
end;
|
|||
|
|
|||
|
NumberOfConnectionsType: begin
|
|||
|
Value := fNumberOfConnectionsValue;
|
|||
|
end;
|
|||
|
|
|||
|
NumberOfPacketsType: begin
|
|||
|
Value := fNumberOfPacketsValue;
|
|||
|
end;
|
|||
|
|
|||
|
CompressionRatioType: begin
|
|||
|
if fCompressedBytes > 0 then begin
|
|||
|
Value := Trunc((fBytesRead * 1.0) / (fCompressedBytes * 1.0) * 100.0)
|
|||
|
end
|
|||
|
else begin
|
|||
|
Value := 0;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
CompressedBytesType: begin
|
|||
|
Value := fCompressedBytes;
|
|||
|
end;
|
|||
|
|
|||
|
BytesReadType: begin
|
|||
|
Value := fBytesRead;
|
|||
|
end;
|
|||
|
|
|||
|
BytesWriteType: begin
|
|||
|
Value := fBytesWrite;
|
|||
|
end;
|
|||
|
|
|||
|
end;
|
|||
|
finally
|
|||
|
StatisticsLocker.Leave;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
////////////////////////////////////////////////////////////////
|
|||
|
//
|
|||
|
// CLIENT SERVICES
|
|||
|
//
|
|||
|
////////////////////////////////////////////////////////////////
|
|||
|
procedure TIdTunnelSlave.DoConnect(Thread: TIdPeerThread);
|
|||
|
const
|
|||
|
MAXLINE=255;
|
|||
|
var
|
|||
|
SID: Integer;
|
|||
|
s: String;
|
|||
|
req: TIdSocksRequest;
|
|||
|
res: TIdSocksResponse;
|
|||
|
numread: Integer;
|
|||
|
Header: TIdHeader;
|
|||
|
begin
|
|||
|
|
|||
|
if not fbAcceptConnections then begin
|
|||
|
Thread.Connection.Disconnect;
|
|||
|
// don't allow to enter in OnExecute {Do not Localize}
|
|||
|
raise EIdTunnelDontAllowConnections.Create (RSTunnelDontAllowConnections);
|
|||
|
end;
|
|||
|
|
|||
|
SetStatistics(NumberOfClientsType, Integer(soIncrease));
|
|||
|
|
|||
|
Thread.Data := TClientData.Create;
|
|||
|
|
|||
|
// Socket version begin
|
|||
|
if fbSocketize then begin
|
|||
|
try
|
|||
|
Thread.Connection.IOHandler.ReadBuffer(req, 8);
|
|||
|
except
|
|||
|
try
|
|||
|
Thread.Connection.Disconnect;
|
|||
|
except
|
|||
|
;
|
|||
|
end;
|
|||
|
Thread.Terminate;
|
|||
|
Exit;
|
|||
|
end;
|
|||
|
|
|||
|
numread := 0;
|
|||
|
repeat
|
|||
|
s := Thread.Connection.ReadString(1);
|
|||
|
req.UserName[numread+1] := s[1];
|
|||
|
Inc(numread);
|
|||
|
until ((numread >= MAXLINE) or (s[1] = #0));
|
|||
|
SetLength(req.UserName, numread);
|
|||
|
|
|||
|
s := GStack.TInAddrToString(req.IpAddr);
|
|||
|
|
|||
|
res.Version := 0;
|
|||
|
res.OpCode := 90;
|
|||
|
res.Port := req.Port;
|
|||
|
res.IpAddr := req.IpAddr;
|
|||
|
SetString(s, PChar(@res), SizeOf(res));
|
|||
|
Thread.Connection.Write(s);
|
|||
|
end;
|
|||
|
|
|||
|
with TClientData(Thread.Data) do begin
|
|||
|
// Id := Thread.Handle;
|
|||
|
SID := Id;
|
|||
|
TimeOfConnection := Now;
|
|||
|
DisconnectedOnRequest := False;
|
|||
|
if fbSocketize then begin
|
|||
|
Port := GStack.WSNToHs(req.Port);
|
|||
|
IpAddr := req.IpAddr;
|
|||
|
end
|
|||
|
else begin
|
|||
|
Port := self.DefaultPort;
|
|||
|
IpAddr.S_addr := 0;
|
|||
|
end;
|
|||
|
Header.Port := Port;
|
|||
|
Header.IpAddr := IpAddr;
|
|||
|
end;
|
|||
|
|
|||
|
Header.MsgType := tmConnect;
|
|||
|
Header.UserId := SID;
|
|||
|
SendMsg(Header, RSTunnelConnectMsg);
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DoDisconnect(Thread: TIdPeerThread);
|
|||
|
var
|
|||
|
Header: TIdHeader;
|
|||
|
begin
|
|||
|
|
|||
|
try
|
|||
|
with TClientData(Thread.Data) do begin
|
|||
|
if DisconnectedOnRequest = False then begin
|
|||
|
Header.MsgType := tmDisconnect;
|
|||
|
Header.UserId := Id;
|
|||
|
SendMsg(Header, RSTunnelDisconnectMsg);
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
SetStatistics(NumberOfClientsType, Integer(soDecrease));
|
|||
|
except
|
|||
|
;
|
|||
|
end;
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
// Thread to communicate with the user
|
|||
|
// reads the requests and transmits them through the tunnel
|
|||
|
function TIdTunnelSlave.DoExecute(Thread: TIdPeerThread): boolean;
|
|||
|
var
|
|||
|
user: TClientData;
|
|||
|
s: String;
|
|||
|
Header: TIdHeader;
|
|||
|
begin
|
|||
|
result := true;
|
|||
|
|
|||
|
if Thread.Connection.IOHandler.Readable(IdTimeoutInfinite) then begin
|
|||
|
s := Thread.Connection.CurrentReadBuffer;
|
|||
|
try
|
|||
|
user := TClientData(Thread.Data);
|
|||
|
Header.MsgType := tmData;
|
|||
|
Header.UserId := user.Id;
|
|||
|
SendMsg(Header, s);
|
|||
|
except
|
|||
|
Thread.Connection.Disconnect;
|
|||
|
raise;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.SendMsg(var Header: TIdHeader; s: String);
|
|||
|
var
|
|||
|
tmpString: String;
|
|||
|
begin
|
|||
|
|
|||
|
SendThroughTunnelLock.Enter;
|
|||
|
try
|
|||
|
try
|
|||
|
|
|||
|
if not StopTransmiting then begin
|
|||
|
if Length(s) > 0 then begin
|
|||
|
try
|
|||
|
// Custom data transformation before send
|
|||
|
tmpString := s;
|
|||
|
try
|
|||
|
DoTransformSend(Header, tmpString);
|
|||
|
except
|
|||
|
on E: Exception do begin
|
|||
|
raise;
|
|||
|
end;
|
|||
|
end;
|
|||
|
if Header.MsgType = 0 then begin // error ocured in transformation
|
|||
|
raise EIdTunnelTransformErrorBeforeSend.Create(RSTunnelTransformErrorBS);
|
|||
|
end;
|
|||
|
|
|||
|
try
|
|||
|
Sender.PrepareMsg(Header, PChar(tmpString), Length(tmpString));
|
|||
|
except
|
|||
|
raise;
|
|||
|
end;
|
|||
|
|
|||
|
try
|
|||
|
SClient.Write(Sender.Msg);
|
|||
|
except
|
|||
|
StopTransmiting := True;
|
|||
|
raise;
|
|||
|
end;
|
|||
|
except
|
|||
|
;
|
|||
|
raise;
|
|||
|
end;
|
|||
|
end
|
|||
|
end;
|
|||
|
|
|||
|
except
|
|||
|
SClient.Disconnect;
|
|||
|
end;
|
|||
|
|
|||
|
finally
|
|||
|
SendThroughTunnelLock.Leave;
|
|||
|
end;
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DoBeforeTunnelConnect(var Header: TIdHeader; var CustomMsg: String);
|
|||
|
begin
|
|||
|
|
|||
|
if Assigned(fOnBeforeTunnelConnect) then
|
|||
|
fOnBeforeTunnelConnect(Header, CustomMsg);
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DoTransformRead(Receiver: TReceiver);
|
|||
|
begin
|
|||
|
|
|||
|
if Assigned(fOnTransformRead) then
|
|||
|
fOnTransformRead(Receiver);
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DoInterpretMsg(var CustomMsg: String);
|
|||
|
begin
|
|||
|
|
|||
|
if Assigned(fOnInterpretMsg) then
|
|||
|
fOnInterpretMsg(CustomMsg);
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DoTransformSend(var Header: TIdHeader; var CustomMsg: String);
|
|||
|
begin
|
|||
|
|
|||
|
if Assigned(fOnTransformSend) then
|
|||
|
fOnTransformSend(Header, CustomMsg);
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DoTunnelDisconnect(Thread: TSlaveThread);
|
|||
|
begin
|
|||
|
|
|||
|
try
|
|||
|
StopTransmiting := True;
|
|||
|
if not ManualDisconnected then begin
|
|||
|
if Active then begin
|
|||
|
Active := False;
|
|||
|
end;
|
|||
|
end;
|
|||
|
except
|
|||
|
;
|
|||
|
end;
|
|||
|
|
|||
|
If Assigned(OnTunnelDisconnect) then
|
|||
|
OnTunnelDisconnect(Thread);
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.OnTunnelThreadTerminate(Sender:TObject);
|
|||
|
begin
|
|||
|
// Just set the flag
|
|||
|
SlaveThreadTerminated := True;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
function TIdTunnelSlave.GetClientThread(UserID: Integer): TIdPeerThread;
|
|||
|
var
|
|||
|
user: TClientData;
|
|||
|
Thread: TIdPeerThread;
|
|||
|
i: integer;
|
|||
|
begin
|
|||
|
|
|||
|
// GetClientThreadLock.Enter;
|
|||
|
Result := nil;
|
|||
|
with ThreadMgr.ActiveThreads.LockList do
|
|||
|
try
|
|||
|
try
|
|||
|
for i := 0 to Count-1 do begin
|
|||
|
try
|
|||
|
if Assigned(Items[i]) then begin
|
|||
|
Thread := TIdPeerThread(Items[i]);
|
|||
|
if Assigned(Thread.Data) then begin
|
|||
|
user := TClientData(Thread.Data);
|
|||
|
if user.Id = UserID then begin
|
|||
|
Result := Thread;
|
|||
|
break;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
except
|
|||
|
Result := nil;
|
|||
|
end;
|
|||
|
end;
|
|||
|
except
|
|||
|
Result := nil;
|
|||
|
end;
|
|||
|
finally
|
|||
|
ThreadMgr.ActiveThreads.UnlockList;
|
|||
|
// GetClientThreadLock.Leave;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
procedure TIdTunnelSlave.TerminateTunnelThread;
|
|||
|
begin
|
|||
|
|
|||
|
OnlyOneThread.Enter;
|
|||
|
try
|
|||
|
if Assigned(SlaveThread) then begin
|
|||
|
if not IsCurrentThread(SlaveThread) then begin
|
|||
|
SlaveThread.TerminateAndWaitFor;
|
|||
|
SlaveThread.Free;
|
|||
|
SlaveThread := nil;
|
|||
|
end else begin
|
|||
|
SlaveThread.FreeOnTerminate := True;
|
|||
|
end;
|
|||
|
end;
|
|||
|
finally
|
|||
|
OnlyOneThread.Leave;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
|
|||
|
procedure TIdTunnelSlave.ClientOperation(Operation: Integer; UserId: Integer; s: String);
|
|||
|
var
|
|||
|
Thread: TIdPeerThread;
|
|||
|
user: TClientData;
|
|||
|
begin
|
|||
|
if StopTransmiting then begin
|
|||
|
Exit;
|
|||
|
end;
|
|||
|
Thread := GetClientThread(UserID);
|
|||
|
if Assigned(Thread) then begin
|
|||
|
try
|
|||
|
case Operation of
|
|||
|
1:
|
|||
|
begin
|
|||
|
try
|
|||
|
if Thread.Connection.Connected then begin
|
|||
|
try
|
|||
|
Thread.Connection.Write(s);
|
|||
|
except
|
|||
|
end;
|
|||
|
end;
|
|||
|
except
|
|||
|
try
|
|||
|
Thread.Connection.Disconnect;
|
|||
|
except
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
2:
|
|||
|
begin
|
|||
|
user := TClientData(Thread.Data);
|
|||
|
user.DisconnectedOnRequest := True;
|
|||
|
Thread.Connection.Disconnect;
|
|||
|
end;
|
|||
|
end;
|
|||
|
except
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TIdTunnelSlave.DisconectAllUsers;
|
|||
|
begin
|
|||
|
TerminateAllThreads;
|
|||
|
end;
|
|||
|
//
|
|||
|
// END Slave Tunnel classes
|
|||
|
///////////////////////////////////////////////////////////////////////////////
|
|||
|
|
|||
|
constructor TClientData.Create;
|
|||
|
begin
|
|||
|
inherited Create;
|
|||
|
id := GetNextID;
|
|||
|
Locker := TCriticalSection.Create;
|
|||
|
SelfDisconnected := False;
|
|||
|
end;
|
|||
|
|
|||
|
destructor TClientData.Destroy;
|
|||
|
begin
|
|||
|
Locker.Free;
|
|||
|
inherited Destroy;
|
|||
|
end;
|
|||
|
|
|||
|
constructor TSlaveThread.Create(Slave: TIdTunnelSlave);
|
|||
|
begin
|
|||
|
SlaveParent := Slave;
|
|||
|
// FreeOnTerminate := True;
|
|||
|
FreeOnTerminate := False;
|
|||
|
FExecuted := False;
|
|||
|
FConnection := Slave.SClient;
|
|||
|
OnTerminate := Slave.OnTunnelThreadTerminate;
|
|||
|
// InitializeCriticalSection(FLock);
|
|||
|
FLock := TCriticalSection.Create;
|
|||
|
Receiver := TReceiver.Create;
|
|||
|
inherited Create(True);
|
|||
|
StopMode := smTerminate;
|
|||
|
end;
|
|||
|
|
|||
|
destructor TSlaveThread.Destroy;
|
|||
|
begin
|
|||
|
// Executed := True;
|
|||
|
Connection.Disconnect;
|
|||
|
Receiver.Free;
|
|||
|
// DeleteCriticalSection(FLock);
|
|||
|
FLock.Destroy;
|
|||
|
inherited Destroy;
|
|||
|
end;
|
|||
|
|
|||
|
|
|||
|
procedure TSlaveThread.SetExecuted(Value: Boolean);
|
|||
|
begin
|
|||
|
// Lock;
|
|||
|
FLock.Enter;
|
|||
|
try
|
|||
|
FExecuted := Value;
|
|||
|
finally
|
|||
|
// Unlock;
|
|||
|
FLock.Leave;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
function TSlaveThread.GetExecuted: Boolean;
|
|||
|
begin
|
|||
|
// Lock;
|
|||
|
FLock.Enter;
|
|||
|
try
|
|||
|
Result := FExecuted;
|
|||
|
finally
|
|||
|
// Unlock;
|
|||
|
FLock.Leave;
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TSlaveThread.Execute;
|
|||
|
begin
|
|||
|
inherited;
|
|||
|
Executed := True;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TSlaveThread.Run;
|
|||
|
var
|
|||
|
Header: TIdHeader;
|
|||
|
s: String;
|
|||
|
CustomMsg: String;
|
|||
|
begin
|
|||
|
try
|
|||
|
if Connection.IOHandler.Readable(IdTimeoutInfinite) then begin
|
|||
|
// if Connection.Binding.Readable(IdTimeoutDefault) then begin
|
|||
|
Receiver.Data := Connection.CurrentReadBuffer;
|
|||
|
|
|||
|
// increase the packets counter
|
|||
|
SlaveParent.SetStatistics(NumberOfPacketsType, 0);
|
|||
|
|
|||
|
while (Receiver.TypeDetected) and (not Terminated) do begin
|
|||
|
if Receiver.NewMessage then begin
|
|||
|
if Receiver.CRCFailed then begin
|
|||
|
raise EIdTunnelCRCFailed.Create(RSTunnelCRCFailed);
|
|||
|
end;
|
|||
|
|
|||
|
try
|
|||
|
// Custom data transformation
|
|||
|
SlaveParent.DoTransformRead(Receiver);
|
|||
|
except
|
|||
|
IndyRaiseOuterException(EIdTunnelTransformError.Create(RSTunnelTransformError));
|
|||
|
end;
|
|||
|
|
|||
|
// Action
|
|||
|
case Receiver.Header.MsgType of
|
|||
|
0: // transformation of data failed, disconnect the tunnel
|
|||
|
begin
|
|||
|
SlaveParent.ManualDisconnected := False;
|
|||
|
raise EIdTunnelMessageTypeRecognitionError.Create(RSTunnelMessageTypeError);
|
|||
|
end; // Failure END
|
|||
|
|
|||
|
|
|||
|
1: // Data
|
|||
|
begin
|
|||
|
try
|
|||
|
SetString(s, Receiver.Msg, Receiver.MsgLen);
|
|||
|
SlaveParent.ClientOperation(1, Receiver.Header.UserId, s);
|
|||
|
except
|
|||
|
IndyRaiseOuterException(EIdTunnelMessageHandlingFailed.Create(RSTunnelMessageHandlingError));
|
|||
|
end;
|
|||
|
end; // Data END
|
|||
|
|
|||
|
2: // Disconnect
|
|||
|
begin
|
|||
|
try
|
|||
|
SlaveParent.ClientOperation(2, Receiver.Header.UserId, ''); {Do not Localize}
|
|||
|
except
|
|||
|
IndyRaiseOuterException(EIdTunnelMessageHandlingFailed.Create(RSTunnelMessageHandlingError));
|
|||
|
end;
|
|||
|
end;
|
|||
|
|
|||
|
99: // Session
|
|||
|
begin
|
|||
|
// Custom data interpretation
|
|||
|
CustomMsg := ''; {Do not Localize}
|
|||
|
SetString(CustomMsg, Receiver.Msg, Receiver.MsgLen);
|
|||
|
try
|
|||
|
try
|
|||
|
SlaveParent.DoInterpretMsg(CustomMsg);
|
|||
|
except
|
|||
|
IndyRaiseOuterException(EIdTunnelInterpretationOfMessageFailed.Create(RSTunnelMessageInterpretError));
|
|||
|
end;
|
|||
|
if Length(CustomMsg) > 0 then begin
|
|||
|
Header.MsgType := 99;
|
|||
|
Header.UserId := 0;
|
|||
|
SlaveParent.SendMsg(Header, CustomMsg);
|
|||
|
end;
|
|||
|
except
|
|||
|
SlaveParent.ManualDisconnected := False;
|
|||
|
IndyRaiseOuterException(EIdTunnelCustomMessageInterpretationFailure.Create(RSTunnelMessageCustomInterpretError));
|
|||
|
end;
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
end; // case
|
|||
|
|
|||
|
// Shift of data
|
|||
|
Receiver.ShiftData;
|
|||
|
|
|||
|
end
|
|||
|
else
|
|||
|
break; // break the loop
|
|||
|
|
|||
|
end; // end while
|
|||
|
end; // if readable
|
|||
|
except
|
|||
|
on E: EIdSocketError do begin
|
|||
|
case E.LastError of
|
|||
|
10054: Connection.Disconnect;
|
|||
|
else
|
|||
|
begin
|
|||
|
Terminate;
|
|||
|
end;
|
|||
|
end;
|
|||
|
end;
|
|||
|
on EIdClosedSocket do ;
|
|||
|
else
|
|||
|
raise;
|
|||
|
end;
|
|||
|
if not Connection.Connected then
|
|||
|
Terminate;
|
|||
|
end;
|
|||
|
|
|||
|
procedure TSlaveThread.AfterRun;
|
|||
|
begin
|
|||
|
SlaveParent.DoTunnelDisconnect(self);
|
|||
|
end;
|
|||
|
|
|||
|
procedure TSlaveThread.BeforeRun;
|
|||
|
var
|
|||
|
Header: TIdHeader;
|
|||
|
tmpString: String;
|
|||
|
begin
|
|||
|
tmpString := ''; {Do not Localize}
|
|||
|
try
|
|||
|
SlaveParent.DoBeforeTunnelConnect(Header, tmpString);
|
|||
|
except
|
|||
|
;
|
|||
|
end;
|
|||
|
if Length(tmpString) > 0 then begin
|
|||
|
Header.MsgType := 99;
|
|||
|
Header.UserId := 0;
|
|||
|
SlaveParent.SendMsg(Header, tmpString);
|
|||
|
end;
|
|||
|
|
|||
|
end;
|
|||
|
|
|||
|
initialization
|
|||
|
GUniqueID := TIdThreadSafeInteger.Create;
|
|||
|
finalization
|
|||
|
FreeAndNil(GUniqueID);
|
|||
|
end.
|