idtunnelslave.pas

Indy控件的使用源代码

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10405: IdTunnelSlave.pas 
{
{   Rev 1.0    2002.11.12 10:58:38 PM  czhower
}
unit IdTunnelSlave;

interface

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
  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嶯A 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;
          raise 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.ReadBuffer(req, 8);
    except
      try
        Thread.Connection.Disconnect;
      except
        ;
      end;
      Thread.Terminate;
      Exit;
    end;

    numread := 0;
    repeat begin
      s := Thread.Connection.ReadString(1);
      req.UserName[numread+1] := s[1];
      Inc(numread);
    end
    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;