clientthread.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 586 行 · 第 1/2 页

unit ClientThread;

interface

uses
  Classes, IdTCPClient, IdTCPServer, SBSSHClient, SBSSHCommon, SBSSHKeyStorage,
  Windows, SyncObjs, SBSharedResource, SBUtils, SysUtils, Winsock;

type
  TConnection = class;

  TLogEvent = procedure(Sender: TObject; const Log : string; Error : boolean) of object;
  TConnectionEvent = procedure(Sender: TObject; Conn : TConnection) of object;

  TClientThread = class(TThread)
  private
    // Class members
    FError : boolean;
    FCS : TCriticalSection;
    FGuiCS : TCriticalSection;
    FChannels : TList;
    FLogString : string;
    FLogError : boolean;
    FConn : TConnection;
    FNoGUI : boolean;
    // SSH connection TCP client
    FTCPClient : TIdTCPClient;
    // Listening socket
    FTCPServer : TIdTCPServer;
    // SSH stuff
    FSSHClient : TElSSHClient;
    FTunnel : TElLocalPortForwardSSHTunnel;
    FTunnelList : TElSSHTunnelList;
    // Events
    FOnLog : TLogEvent;
    FOnChange : TConnectionEvent;
    FOnConnectionAdd : TConnectionEvent;
    FOnConnectionRemove : TConnectionEvent;
    // Event handlers
    procedure TunnelOpen(Sender : TObject; TunnelConnection : TElSSHTunnelConnection);
    procedure TunnelClose(Sender : TObject; TunnelConnection : TElSSHTunnelConnection);
    procedure TunnelError(Sender : TObject; Error : integer; Data : pointer);
    procedure TunnelConnData(Sender : TObject; Buffer : pointer; Size : longint);
    procedure SSHClientKeyValidate(Sender : TObject; ServerKey : TElSSHKey; var Validate : boolean);
    procedure SSHClientAuthSuccess(Sender : TObject);
    procedure SSHClientAuthFailed(Sender : TObject; AuthenticationType : integer);
    procedure SSHClientSend(Sender : TObject; Buffer : pointer; Size : longint);
    procedure SSHClientReceive(Sender : TObject; Buffer : pointer; MaxSize : longint;
      out Written : longint);
    procedure SSHClientOpen(Sender: TObject);
    procedure SSHClientClose(Sender : TObject);
    procedure SSHClientError(Sender : TObject; ErrorCode : integer);
    procedure TCPServerConnect(AThread: TIdPeerThread);
    procedure TCPServerExecute(AThread: TIdPeerThread);
    procedure TCPServerThreadTerminate(Sender: TObject);
    // auxiliary routines
    procedure Log(const S : string; Error : boolean);
    procedure DoConnectionAdd(Conn : TConnection);
    procedure DoConnectionRemove(Conn : TConnection);
    procedure DoConnectionChange(Conn : TConnection);
    procedure TriggerLog;
    procedure TriggerConnectionChange;
    procedure TriggerConnectionAdd;
    procedure TriggerConnectionRemove;
  public
    constructor Create(const AHost : string; APort : integer;
      const Username, Password : string;
      AForwardPort: integer; const ADestHost: string; ADestPort : integer;
      NoGUI : boolean = false);
    destructor Destroy; override;
    procedure Execute; override;
    property OnLog : TLogEvent read FOnLog write FOnLog;
    property OnConnectionAdd : TConnectionEvent read FOnConnectionAdd write FOnConnectionAdd;
    property OnConnectionRemove : TConnectionEvent read FOnConnectionRemove write FOnConnectionRemove;
    property OnConnectionChange : TConnectionEvent read FOnChange write FOnChange;
  end;

  TInConnectionState = (icsActive, icsClosing, icsClosed);
  TOutConnectionState = (ocsEstablishing, ocsActive, ocsClosing, ocsClosed);
  TConnection = class
  private
    FThread : TIdPeerThread;
    FChannel : TElSSHTunnelConnection;
    FChannelBuffer : ByteArray;
    FSocketBuffer : ByteArray;
    FSharedResource : TElSharedResource;
    FInState : TInConnectionState;
    FOutState : TOutConnectionState;
    FRemoteHost : string;
    FRemotePort : integer;
    FSent : integer;
    FReceived : integer;
  protected
    function ReadFromSocketBuffer(Buffer: pointer; MaxSize: integer): integer;
    function ReadFromChannelBuffer(Buffer: pointer; MaxSize: integer): integer;
    procedure WriteToSocketBuffer(Buffer: pointer; Size: integer);
    procedure WriteToChannelBuffer(Buffer: pointer; Size: integer);
  public
    constructor Create;
    destructor Destroy; override;
    property RemoteHost : string read FRemoteHost;
    property RemotePort : integer read FRemotePort;
    property Sent : integer read FSent;
    property Received : integer read FReceived;
    property InState : TInConnectionState read FInState;
    property OutState : TOutConnectionState read FOutState;
  end;

implementation

uses IdTCPConnection, IdSocketHandle;

constructor TClientThread.Create(const AHost : string; APort : integer;
  const Username, Password : string; AForwardPort: integer; const ADestHost: string;
  ADestPort : integer; NoGUI : boolean = false);
begin
  inherited Create(true);
  // creating tunnel list object
  FTunnelList := TElSSHTunnelList.Create(nil);
  // creating and setting up tunnel object
  FTunnel := TElLocalPortForwardSSHTunnel.Create(nil);
  FTunnel.Port := AForwardPort;
  FTunnel.ToHost := ADestHost;
  FTunnel.ToPort := ADestPort;
  FTunnel.TunnelList := FTunnelList;
  FTunnel.OnOpen := TunnelOpen;
  FTunnel.OnClose := TunnelClose;
  FTunnel.OnError := TunnelError;
  // creating and setting up SSH client object
  FSSHClient := TElSSHClient.Create(nil);
  FSSHClient.UserName := Username;
  FSSHClient.Password := Password;
  FSSHClient.Versions := [sbSSH1, sbSSH2];
  FSSHClient.TunnelList := FTunnelList;
  FSSHClient.CloseIfNoActiveTunnels := false;
  FSSHClient.OnKeyValidate := SSHClientKeyValidate;
  FSSHClient.OnAuthenticationSuccess := SSHClientAuthSuccess;
  FSSHClient.OnAuthenticationFailed := SSHClientAuthFailed;
  FSSHClient.OnSend := SSHClientSend;
  FSSHClient.OnReceive := SSHClientReceive;
  FSSHClient.OnOpenConnection := SSHClientOpen;
  FSSHClient.OnCloseConnection := SSHClientClose;
  FSSHClient.OnError := SSHClientError;
  FSSHClient.ThreadSafe := false;
  // creating socket objects
  FTCPClient := TIdTCPClient.Create(nil);
  FTCPClient.Host := AHost;
  FTCPClient.Port := APort;
  FTCPServer := TIdTCPServer.Create(nil);
  FTCPServer.DefaultPort := AForwardPort;
  FTCPServer.OnConnect := TCPServerConnect;
  FTCPServer.OnExecute := TCPServerExecute;
  // creating channel list
  FChannels := TList.Create;
  FCS := TCriticalSection.Create;
  FGuiCS := TCriticalSection.Create;
  FNoGUI := NoGUI;  
  Resume;
end;

destructor TClientThread.Destroy;
begin
  FreeAndNil(FChannels);
  FreeAndNil(FTCPClient);
  FreeAndNil(FTCPServer);
  FreeAndNil(FSSHClient);
  FreeAndNil(FTunnel);
  FreeAndNil(FTunnelList);
  FreeAndNil(FCS);
  FreeAndNil(FGuiCS);
  inherited;
end;

procedure TClientThread.TunnelOpen(Sender : TObject; TunnelConnection : TElSSHTunnelConnection);
var
  Conn : TConnection;
begin
  Log('SSH channel opened', false);
  Conn := TConnection(TunnelConnection.Data);
  Conn.FChannel := TunnelConnection;
  Conn.FOutState := ocsActive;
  TunnelConnection.OnData := TunnelConnData;
end;

procedure TClientThread.TunnelClose(Sender : TObject; TunnelConnection : TElSSHTunnelConnection);
begin
  if TunnelConnection.Data <> nil then
  begin
    Log('SSH channel closed', false);
    TConnection(TunnelConnection.Data).FOutState := ocsClosed;
    TunnelConnection.Data := nil;
  end;
end;

procedure TClientThread.TunnelError(Sender : TObject; Error : integer; Data : pointer);
begin
  Log('SSH tunnel error ' + IntToStr(Error), false);
  TConnection(Data).FOutState := ocsClosed;
end;

procedure TClientThread.TunnelConnData(Sender : TObject; Buffer : pointer; Size : longint);
begin
  TConnection(TElSSHTunnelConnection(Sender).Data).WriteToSocketBuffer(Buffer, Size);
end;

procedure TClientThread.SSHClientKeyValidate(Sender : TObject; ServerKey : TElSSHKey; var Validate : boolean);
begin
  Log('Server key received (fingerprint=' + DigestToStr(ServerKey.FingerprintMD5) + ')', false);
  Validate := true;
end;

procedure TClientThread.SSHClientAuthSuccess(Sender : TObject);
begin
  Log('SSH authentication succeeded', false);
end;

procedure TClientThread.SSHClientAuthFailed(Sender : TObject; AuthenticationType : integer);
begin
  Log('SSH authentication type ' + IntToStr(AuthenticationType) + ' failed', true);
end;

procedure TClientThread.SSHClientSend(Sender : TObject; Buffer : pointer; Size : longint);
begin
  try
    FTCPClient.WriteBuffer(Buffer^, Size, false);
  except
    FError := true;
  end;
end;

procedure TClientThread.SSHClientReceive(Sender : TObject; Buffer : pointer; MaxSize : longint;
  out Written : longint);
begin
  try
    Written := FTCPClient.Socket.Recv(Buffer^, MaxSize)
  except
    Written := 0;
    FError := true;
  end;
end;

procedure TClientThread.SSHClientOpen(Sender: TObject);
begin
  Log('SSH connection established', false);
end;

procedure TClientThread.SSHClientClose(Sender : TObject);
begin
  Log('SSH connection closed', false);
  FError := true;
end;

procedure TClientThread.SSHClientError(Sender : TObject; ErrorCode : integer);
begin
  Log('SSH protocol error ' + IntToStr(ErrorCode), true);
  FError := true;
end;

procedure TClientThread.TCPServerConnect(AThread: TIdPeerThread);
var
  Conn : TConnection;
begin
  Log('Incoming connection accepted', false);
  Conn := TConnection.Create;
  Conn.FThread := AThread;
  AThread.Data := Conn;
  AThread.FreeOnTerminate := true;
  AThread.OnTerminate := TCPServerThreadTerminate;
  FCS.Acquire;
  try
    FTunnel.Open(Conn);
  finally
    FCS.Release;
  end;
  if not FNoGUI then
  begin
    FGuiCS.Acquire;
    try
      DoConnectionAdd(Conn);
    finally
      FGuiCS.Release;
    end;
  end;
end;

procedure TClientThread.TCPServerExecute(AThread: TIdPeerThread);
var
  Conn : TConnection;
  Buf : array[0..4095] of byte;
  Read : integer;
  S:  string;
begin
  Conn := TConnection(AThread.Data);