sbindysshclientiohandler9.pas

著名的SecureBlackBox控件完整源码

unit SBIndySSHClientIOHandler9;
interface
uses
  SBUtils,
  SBSSHConstants,
  SBSSHCommon,
  SBSSHClient,
  SBSSHTerm,
  SBSSHKeyStorage,
  IdGlobal,
  IdIOHandler,
  IdException,
  IdComponent,
  IdTCPClient,
  IdTCPConnection,
  IdAntiFreezeBase,
  Classes,
  SysUtils;

type
  TElClientIndySSHTransport = class(TComponent)
  protected
    FOnAuthenticationSuccess: TNotifyEvent;
    FOnAuthenticationFailed: TSSHAuthenticationFailedEvent;
    FOnAuthenticationKeyboard: TSSHAuthenticationKeyboardEvent;
    FOnBanner: TSSHBannerEvent;
    FOnCloseConnection: TSSHCloseConnectionEvent;
    FOnOpenConnection: TSSHOpenConnectionEvent;
    FOnError: TSSHErrorEvent;
    FOnKeyValidate: TSSHKeyValidateEvent;

    FSSHClient: TElSSHClient;
    FTCPClient: TIdTCPClient;
    FErrorOccured: boolean;
    FTunnelList: TElSSHTunnelList;
    FLastError: integer;
    FActive: boolean;

    function GetCloseIfNoActiveTunnels: boolean;
    function GetActive: boolean;
    function GetAuthenticationTypes: integer;
    function GetHost: string;
    function GetIOHandler: TIdIOHandler;
    function GetPort: integer;
    function GetClientHostname: string;
    function GetClientUsername: string;
    function GetCompressionAlgorithmCS: TSSHCompressionAlgorithm;
    function GetCompressionAlgorithms(
      Index: TSSHCompressionAlgorithm): boolean;
    function GetCompressionAlgorithmSC: TSSHCompressionAlgorithm;
    function GetCompressionLevel: integer;
    function GetEncryptionAlgorithmCS: TSSHEncryptionAlgorithm;
    function GetEncryptionAlgorithms(
      Index: TSSHEncryptionAlgorithm): boolean;
    function GetEncryptionAlgorithmSC: TSSHEncryptionAlgorithm;
    function GetForceCompression: boolean;
    function GetKexAlgorithm: TSSHKexAlgorithm;
    function GetKexAlgorithms(Index: TSSHKexAlgorithm): boolean;
    function GetKeyStorage: TElSSHCustomKeyStorage;
    function GetMacAlgorithmCS: TSSHMacAlgorithm;
    function GetMACAlgorithms(Index: TSSHMacAlgorithm): boolean;
    function GetMacAlgorithmSC: TSSHMacAlgorithm;
    function GetPassword: string;
    function GetPublicKeyAlgorithm: TSSHPublicKeyAlgorithm;
    function GetPublicKeyAlgorithms(
      Index: TSSHPublicKeyAlgorithm): boolean;
    function GetServerCloseReason: string;
    function GetServerSoftwareName: string;
    function GetSoftwareName: string;
    function GetUsername: string;
    function GetVersion: TSSHVersion;
    function GetVersions: TSSHVersions;
    procedure SetAuthenticationTypes(const Value: integer);
    procedure SetClientHostname(const Value: string);
    procedure SetClientUsername(const Value: string);
    procedure SetCloseIfNoActiveTunnels(const Value: boolean);
    procedure SetCompressionAlgorithms(Index: TSSHCompressionAlgorithm;
      const Value: boolean);
    procedure SetCompressionLevel(const Value: integer);
    procedure SetEncryptionAlgorithms(Index: TSSHEncryptionAlgorithm;
      const Value: boolean);
    procedure SetForceCompression(const Value: boolean);
    procedure SetKexAlgorithms(Index: TSSHKexAlgorithm;
      const Value: boolean);
    procedure SetKeyStorage(const Value: TElSSHCustomKeyStorage);
    procedure SetMACAlgorithms(Index: TSSHMacAlgorithm;
      const Value: boolean);
    procedure SetPassword(const Value: string);
    procedure SetPublicKeyAlgorithms(Index: TSSHPublicKeyAlgorithm;
      const Value: boolean);
    procedure SetSoftwareName(const Value: string);
    procedure SetUsername(const Value: string);
    procedure SetVersions(const Value: TSSHVersions);
    procedure SetHost(const Value: string);
    procedure SetIOHandler(const Value: TIdIOHandler);
    procedure SetPort(const Value: integer);

    procedure DoSSHAuthenticationFailed(Sender: TObject; AuthenticationType:
      integer);
    procedure DoSSHAuthenticationKeyboard(Sender: TObject; Prompts: TStringList;
      Echo: TBits; Responses: TStringList);
    procedure DoSSHAuthenticationSuccess(Sender: TObject);
    procedure DoSSHOpenConnection(Sender: TObject);
    procedure DoSSHCloseConnection(Sender: TObject);
    procedure DoSSHError(Sender: TObject; ErrorCode: integer);
    procedure DoSSHKeyValidate(Sender: TObject; ServerKey: TElSSHKey; var Validate:
      boolean);
    procedure DoSSHBanner(Sender: TObject; const Text: string; const Language: string);
    procedure DoSSHReceive(Sender: TObject; Buffer: pointer; MaxSize: longint; out
      Written: longint);
    procedure DoSSHSend(Sender: TObject; Buffer: pointer; Size: longint);
    procedure DoTCPDisconnected(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Connect;
    procedure Disconnect;

    property Active: boolean read GetActive;
    property ServerSoftwareName: string read GetServerSoftwareName;
    property Version: TSSHVersion read GetVersion;
    property ServerCloseReason: string read GetServerCloseReason;
    property EncryptionAlgorithmServerToClient: TSSHEncryptionAlgorithm
    read GetEncryptionAlgorithmSC;
    property EncryptionAlgorithmClientToServer: TSSHEncryptionAlgorithm
    read GetEncryptionAlgorithmCS;
    property CompressionAlgorithmServerToClient: TSSHCompressionAlgorithm
    read GetCompressionAlgorithmSC;
    property CompressionAlgorithmClientToServer: TSSHCompressionAlgorithm
    read GetCompressionAlgorithmCS;
    property MacAlgorithmServerToClient: TSSHMacAlgorithm read GetMacAlgorithmSC;
    property MacAlgorithmClientToServer: TSSHMacAlgorithm read GetMacAlgorithmCS;
    property KexAlgorithm: TSSHKexAlgorithm read GetKexAlgorithm;
    property PublicKeyAlgorithm: TSSHPublicKeyAlgorithm read GetPublicKeyAlgorithm;

    property EncryptionAlgorithms[Index: TSSHEncryptionAlgorithm]: boolean
    read GetEncryptionAlgorithms write SetEncryptionAlgorithms;
    property CompressionAlgorithms[Index: TSSHCompressionAlgorithm]: boolean
    read GetCompressionAlgorithms write SetCompressionAlgorithms;
    property MacAlgorithms[Index: TSSHMacAlgorithm]: boolean
    read GetMACAlgorithms write SetMACAlgorithms;
    property KexAlgorithms[Index: TSSHKexAlgorithm]: boolean
    read GetKexAlgorithms write SetKexAlgorithms;
    property PublicKeyAlgorithms[Index: TSSHPublicKeyAlgorithm]: boolean
    read GetPublicKeyAlgorithms write SetPublicKeyAlgorithms;
  published
    property Host: string read GetHost write SetHost;
    property Port: integer read GetPort write SetPort;
    property IOHandler: TIdIOHandler read GetIOHandler write SetIOHandler;

    property KeyStorage: TElSSHCustomKeyStorage read GetKeyStorage write
    SetKeyStorage;

    property AuthenticationTypes: integer read GetAuthenticationTypes
    write SetAuthenticationTypes default SSH_AUTH_TYPE_PASSWORD;
    property ClientHostname: string read GetClientHostname
    write SetClientHostname;
    property ClientUsername: string read GetClientUsername
    write SetClientUsername;
    property CloseIfNoActiveTunnels: boolean read GetCloseIfNoActiveTunnels
    write SetCloseIfNoActiveTunnels;
    property CompressionLevel: integer read GetCompressionLevel
    write SetCompressionLevel default 9;
    property ForceCompression: boolean read GetForceCompression
    write SetForceCompression;
    property Password: string read GetPassword write SetPassword;
    property SoftwareName: string read GetSoftwareName write SetSoftwareName;
    property Username: string read GetUsername write SetUsername;
    property Versions: TSSHVersions read GetVersions write SetVersions;

    property OnAuthenticationKeyboard: TSSHAuthenticationKeyboardEvent read
    FOnAuthenticationKeyboard write FOnAuthenticationKeyboard;
    property OnAuthenticationFailed: TSSHAuthenticationFailedEvent read
    FOnAuthenticationFailed write FOnAuthenticationFailed;
    property OnAuthenticationSuccess: TNotifyEvent read FOnAuthenticationSuccess
    write FOnAuthenticationSuccess;
    property OnBanner: TSSHBannerEvent read FOnBanner write FOnBanner;
    property OnError: TSSHErrorEvent read FOnError write FOnError;
    property OnCloseConnection: TSSHCloseConnectionEvent read FOnCloseConnection
    write FOnCloseConnection;
    property OnKeyValidate: TSSHKeyValidateEvent read FOnKeyValidate write
    FOnKeyValidate;
    property OnOpenConnection: TSSHOpenConnectionEvent read FOnOpenConnection
    write FOnOpenConnection;
  end;

  TElClientIndySSHIOHandlerSocket = class(TIdIOHandler)
  private
    procedure SetOwnTunnel(const Value: boolean);
  protected
    FConnection: TElSSHTunnelConnection;
    FTransport: TElClientIndySSHTransport;
    FTunnel: TElCustomSSHTunnel;
    FTunnelType: TSSHTunnelType;
    FActive: boolean;
    FOwnTunnel: boolean;
    FErrorOccured: boolean;
    FOldOnOpen: TSSHOpenConnectionEvent;
    FOldOnError: TSSHErrorEvent;
    FInputBuffer: TIdManagedBuffer;
    FDestroyConnection: boolean;

    function GetAuthenticationProtocol: string;
    function GetCommand: string;
    function GetEnvironment: TStringList;
    function GetSubsystem: string;
    function GetTerminalInfo: TElTerminalInfo;
    function GetToHost: string;
    function GetToPort: integer;
    function GetScreenNumber: integer;

    procedure SetAuthenticationProtocol(const Value: string);
    procedure SetCommand(const Value: string);
    procedure SetSubsystem(const Value: string);
    procedure SetTerminalInfo(const Value: TElTerminalInfo);
    procedure SetTransport(const Value: TElClientIndySSHTransport);
    procedure SetTunnelType(const Value: TSSHTunnelType);
    procedure SetToPort(const Value: integer);
    procedure SetScreenNumber(const Value: integer);
    procedure SetToHost(const Value: string);
    procedure SetTunnel(const Value: TElCustomSSHTunnel);

    {function ReadFromSource(ARaiseExceptionIfDisconnected: Boolean;
      ATimeout: Integer; ARaiseExceptionOnTimeout: Boolean): Integer; override;}

    procedure DoOnClose(Sender: TObject; CloseType: TSSHCloseType);
    procedure DoOnData(Sender: TObject; Buffer: pointer; Size: longint);
    procedure DoOnError(Sender: TObject; ErrorCode: integer);
    procedure DoOnOpen(Sender: TObject; TunnelConnection: TElSSHTunnelConnection);
    procedure DoOnTunnelError(Sender: TObject; ErrorCode: integer; Data: pointer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Close; override;
    {procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: boolean = true;
      AIgnoreBuffer: boolean = false); override;}
    {procedure CheckForDataOnSource(ATimeout : Integer = 0); override;}
    function Connected: boolean; override;
    procedure Open; override;
    function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; override;
    function Recv(var ABuf; ALen: Integer): Integer; override;
    function Send(var ABuf; ALen: Integer): Integer; override;
    {procedure WriteDirect(ABuffer : TIdBytes); override;}
  published
    property OwnTunnel: boolean read FOwnTunnel write SetOwnTunnel;
    property Tunnel: TElCustomSSHTunnel read FTunnel write SetTunnel;
    property Transport: TElClientIndySSHTransport read FTransport write SetTransport;
    property TunnelType: TSSHTunnelType read FTunnelType write SetTunnelType;
    { terminal tunnels }
    property TerminalInfo: TElTerminalInfo read GetTerminalInfo write SetTerminalInfo;
    property Environment: TStringList read GetEnvironment;
    { command tunnel }
    property Command: string read GetCommand write SetCommand;
    { local/remote port forwarding }
    property ToHost: string read GetToHost write SetToHost;
    property ToPort: integer read GetToPort write SetToPort;
    { custom subsystem tunnel }
    property Subsystem: string read GetSubsystem write SetSubsystem;
    { X11 forwarding tunnel }
    property AuthenticationProtocol: string read GetAuthenticationProtocol
    write SetAuthenticationProtocol;
    property ScreenNumber: integer read GetScreenNumber write SetScreenNumber;
  end;

  EElIdNotImplementedException = class(EIdException);
  EElIdSSHException = class(EIdException);

procedure Register;

implementation

uses
  IdIOHandlerSocket,
  IdSocketHandle;

resourcestring
  SNotImplemented = 'Not implemented';
  SDisconnected = 'Disconnected';
  SCannotConnect = 'Cannot connect';
  SNotConnected = 'Not connected';
  SErrorSocketRead = 'Error while reading from socket';
  SSSHException = 'SSH protocol exception';
  SSSHTransportAlreadySet = 'SSH transport already set';
  SSSHCannotOpenTunnel = 'Cannot open SSH tunnel';

procedure Register;
begin
  RegisterComponents('SSHBlackbox', [TElClientIndySSHIOHandlerSocket,
    TElClientIndySSHTransport]);
end;

{ TElClientIndySSHIOHandlerSocket }

constructor TElClientIndySSHIOHandlerSocket.Create(AOwner: TComponent);
begin
  inherited;

  FConnection := nil;
  FTunnel := nil;
  FTransport := nil;
  FActive := false;
  FOwnTunnel := true;
  FErrorOccured := false;
  FInputBuffer := TIdManagedBuffer.Create;
  FDestroyConnection := false;
end;

procedure TElClientIndySSHIOHandlerSocket.Close;
begin
  if not Assigned(FTransport) then Exit;
  if FActive and Assigned(FConnection) then
  begin
    FActive := false;
    FConnection.Close;
    if FDestroyConnection then
      FreeAndNil(FConnection)
    else
      FConnection := nil;
  end;

  inherited;
end;

function TElClientIndySSHIOHandlerSocket.Recv(var ABuf; ALen: Integer): Integer;
begin
  result := 0;
  try
    if Assigned(FTransport) then
    begin
      FTransport.FSSHClient.DataAvailable;
      Result := Min(ALen, FInputBuffer.Size);

      if Result > 0 then
      begin
        FInputBuffer.Position := 0;
        Result := FInputBuffer.Read(ABuf, Result);
        FInputBuffer.Remove(Result);
      end;
    end
    else
  except
    if FTransport <> nil then
    begin
      FTransport.DoSSHError(Self, ERROR_SSH_CONNECTION_LOST);
      FTransport.Disconnect;
    end;
  end;
end;

function TElClientIndySSHIOHandlerSocket.Send(var ABuf; ALen: Integer): Integer;
begin
  try
    if FActive and Assigned(FConnection) then
      FConnection.SendData(@ABuf, ALen);
  except
    if FTransport <> nil then
    begin
      FTransport.DoSSHError(Self, ERROR_SSH_CONNECTION_LOST);
      FTransport.Disconnect;
    end;
  end;
  Result := ALen;
end;

function TElClientIndySSHIOHandlerSocket.Connected: boolean;
begin
  Result := FActive;
end;

destructor TElClientIndySSHIOHandlerSocket.Destroy;
begin
  if FActive then
    Close;

  FTransport := nil;
  FInputBuffer.Free;

  inherited;
end;

procedure TElClientIndySSHIOHandlerSocket.Open;
begin
  inherited;
  if not Assigned(FTransport) then Exit;

  if not FTransport.Active then
    FTransport.Connect;

  if (FOwnTunnel) and (Assigned(FTunnel)) and (not FActive) then
  begin
    FErrorOccured := false;

    if FTransport.Version = sbSSH1 then
    begin
      if (FTransport.Active) and (FTunnelType <> ttLocalPortToRemoteAddress) then
        raise EElIdSSHException.Create(SSSHCannotOpenTunnel)
      else
        FTunnel.Open(Self);
    end
    else
      FTunnel.Open(Self);

    while (not FErrorOccured) and (not FActive) and (FTransport.Active) do
      FTransport.FSSHClient.DataAvailable;

    if (FErrorOccured) or (not FTransport.Active) then
      raise EElIdSSHException.Create(SSSHCannotOpenTunnel);
  end;
end;

function TElClientIndySSHIOHandlerSocket.Readable(AMSec: Integer): Boolean;
  {
  // Old Readable function
  FTransport.FSSHClient.DataAvailable;

  if Assigned(FConnection) and (FInputBuffer.Size > 0) then
    Result := FActive