(******************************************************)
(*                                                    *)
(*            EldoS SecureBlackbox Library            *)
(*                                                    *)
(*      Copyright (c) 2002-2003 EldoS Corporation     *)
(*           http://www.secureblackbox.com            *)
(*                                                    *)
(******************************************************)

unit SBIndySSHShellIOHandler;

interface

uses
  Classes, IdIOHandlerSocket, IdSocks, IdSocketHandle, IdGlobal, IdAntiFreezeBase,
  IdException, IdResourceStrings, IdStack, IdStackConsts,
  SBSSHCommon, SBSSHClient, SBSSHKeyStorage, SBSSHConstants;

type
  TElIndySSHShellIOHandlerSocket = class(TIdIOHandlerSocket)
  private
    FClient : TElSSHClient;
    FClientState : integer;
    FTunnelList : TElSSHTunnelList;
    FTunnel : TElShellSSHTunnel;
    FConnection : TElSSHTunnelConnection;
    FDataBuffer : string;
    FExtendedDataBuffer : string;
    FDataReceived : boolean;
    FSocksConnected : boolean;
    function GetEncryptionAlgorithms(Index : TSSHEncryptionAlgorithm) : boolean;
    function GetCompressionAlgorithms(Index : TSSHCompressionAlgorithm) : boolean;
    function GetMACAlgorithms(Index : TSSHMACAlgorithm) : boolean;
    procedure SetEncryptionAlgorithms(Index : TSSHEncryptionAlgorithm; Value : boolean);
    procedure SetCompressionAlgorithms(Index : TSSHCompressionAlgorithm; Value : boolean);
    procedure SetMACAlgorithms(Index : TSSHMACAlgorithm; Value : boolean);
    function GetKexAlgorithms(Index : TSSHKexAlgorithm) : boolean;
    procedure SetKexAlgorithms(Index : TSSHKexAlgorithm; Value : boolean);
    function GetPublicKeyAlgorithms(Index : TSSHPublicKeyAlgorithm) : boolean;
    procedure SetPublicKeyAlgorithms(Index : TSSHPublicKeyAlgorithm; Value : boolean);
    function GetServerSoftwareName : string;
    function GetVersion : TSSHVersion;
    function GetServerCloseReason : string;
    function GetEncryptionAlgorithmSC : TSSHEncryptionAlgorithm;
    function GetEncryptionAlgorithmCS : TSSHEncryptionAlgorithm;
    function GetCompressionAlgorithmSC : TSSHCompressionAlgorithm;
    function GetCompressionAlgorithmCS : TSSHCompressionAlgorithm;
    function GetMacAlgorithmSC : TSSHMacAlgorithm;
    function GetMacAlgorithmCS : TSSHMacAlgorithm;
    function GetKexAlgorithm : TSSHKexAlgorithm;
    function GetPublicKeyAlgorithm : TSSHPublicKeyAlgorithm;
    function GetSoftwareName : string;
    procedure SetSoftwareName(Value : string);
    function GetVersions : TSSHVersions;
    procedure SetVersions(Value : TSSHVersions);
    function GetUserName : string;
    procedure SetUserName(Value : string);
    function GetPassword : string;
    procedure SetPassword(Value : string);
    function GetClientUserName : string;
    procedure SetClientUserName(Value : string);
    function GetClientHostName : string;
    procedure SetClientHostname(Value : string);
    function GetKeyStorage : TElSSHCustomKeyStorage;
    procedure SetKeyStorage(Value : TElSSHCustomKeyStorage);
    function GetRequestCompression : boolean;
    procedure SetRequestCompression(Value : boolean);
    function GetCompressionLevel : integer;
    procedure SetCompressionLevel(Value : integer);
    function GetAuthenticationTypes : cardinal;
    procedure SetAuthenticationTypes(Value : cardinal);
    function GetOnAuthenticationSuccess : TNotifyEvent;
    procedure SetOnAuthenticationSuccess(Value : TNotifyEvent);
    function GetOnAuthenticationFailed : TSSHAuthenticationFailedEvent;
    procedure SetOnAuthenticationFailed(Value : TSSHAuthenticationFailedEvent);
    function GetOnAuthenticationKeyboard : TSSHAuthenticationKeyboardEvent;
    procedure SetOnAuthenticationKeyboard(Value : TSSHAuthenticationKeyboardEvent);
    function GetOnKeyValidate : TSSHKeyValidateEvent;
    procedure SetOnKeyValidate(Value : TSSHKeyValidateEvent);
    procedure HandleClientSend(Sender : TObject; Buffer : pointer; Size : integer);
    procedure HandleClientReceive(Sender : TObject; Buffer : pointer; Size :
      integer; out Written : integer);
    procedure HandleClientOpenConnection(Sender : TObject);
    procedure HandleClientCloseConnection(Sender : TObject);
    procedure HandleClientError(Sender : TObject; Error : integer);
    procedure HandleTunnelOpen(Sender : TObject; Connection : TElSSHTunnelConnection);
    procedure HandleTunnelClose(Sender : TObject; Connection : TElSSHTunnelConnection);
    procedure HandleTunnelError(Sender : TObject; Error : integer; Data : Pointer);
    procedure HandleConnectionData(Sender : TObject; Buffer : pointer; Size :
      integer);
    procedure HandleConnectionExtendedData(Sender : TObject; Buffer : pointer;
      Size : integer);
    procedure HandleConnectionError(Sender : TObject; Error : integer);
    procedure HandleConnectionClose(Sender : TObject; CloseType : TSSHCloseType);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Close; override;
    procedure ConnectClient(const AHost: string; const APort: Integer; const ABoundIP: string;
     const ABoundPort: Integer; const ABoundPortMin: Integer; const ABoundPortMax: Integer;
     const ATimeout: Integer = IdTimeoutDefault); 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;
    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;
    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;
  published
    property SoftwareName : string read GetSoftwareName write SetSoftwareName;
    property Versions : TSSHVersions read GetVersions write SetVersions;
    property UserName : string read GetUserName write SetUserName;
    property Password : string read GetPassword write SetPassword;
    property ClientUserName : string read GetClientUserName write SetClientUserName;
    property ClientHostName : string read GetClientHostName write SetClientHostName;
    property KeyStorage : TElSSHCustomKeyStorage read GetKeyStorage
      write SetKeyStorage;
    property ForceCompression : boolean read GetRequestCompression
      write SetRequestCompression;
    property CompressionLevel : integer read GetCompressionLevel
      write SetCompressionLevel default 9;
    property AuthenticationTypes : cardinal read GetAuthenticationTypes
      write SetAuthenticationTypes default SSH_AUTH_TYPE_PASSWORD;
    property OnAuthenticationSuccess : TNotifyEvent read GetOnAuthenticationSuccess
      write SetOnAuthenticationSuccess;
    property OnAuthenticationFailed : TSSHAuthenticationFailedEvent
      read GetOnAuthenticationFailed write SetOnAuthenticationFailed;
    property OnAuthenticationKeyboard : TSSHAuthenticationKeyboardEvent
      read GetOnAuthenticationKeyboard write SetOnAuthenticationKeyboard;
    property OnKeyValidate : TSSHKeyValidateEvent read GetOnKeyValidate
      write SetOnKeyValidate;
  end;

procedure Register;

implementation

uses
  Sysutils, IdComponent;

const
  CLIENT_STATE_NOT_CONNECTED            = 0;
  CLIENT_STATE_CONNECTING               = 1;
  CLIENT_STATE_ERROR                    = 2;
  CLIENT_STATE_DISCONNECTED             = 3;
  CLIENT_STATE_CONNECTED                = 4;

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

constructor TElIndySSHShellIOHandlerSocket.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FClient := TElSSHClient.Create(Self);
  FClient.OnSend := HandleClientSend;
  FClient.OnReceive := HandleClientReceive;
  FClient.OnOpenConnection := HandleClientOpenConnection;
  FClient.OnCloseConnection := HandleClientCloseConnection;
  FClient.OnError := HandleClientError;
  FClientState := CLIENT_STATE_NOT_CONNECTED;
  FTunnelList := TElSSHTunnelList.Create(Self);
  FTunnel := TElShellSSHTunnel.Create(Self);
  FTunnel.TunnelList := FTunnelList;
  FClient.TunnelList := FTunnelList;
  FTunnel.OnOpen := HandleTunnelOpen;
  FTunnel.OnClose := HandleTunnelClose;
  FTunnel.OnError := HandleTunnelError;
  FConnection := nil;
end;

destructor TElIndySSHShellIOHandlerSocket.Destroy;
begin
  FClient.Free;
  FTunnelList.Free;
  FTunnel.Free;
  inherited;
end;

procedure TElIndySSHShellIOHandlerSocket.Close;
begin
  FClientState := CLIENT_STATE_NOT_CONNECTED;
  if FBinding <> nil then
    FClient.Close;
  inherited Close;
end;

procedure TElIndySSHShellIOHandlerSocket.ConnectClient(const AHost: string; const APort: Integer; const ABoundIP: string;
  const ABoundPort: Integer; const ABoundPortMin: Integer; const ABoundPortMax: Integer;
  const ATimeout: Integer = IdTimeoutDefault);
begin
  FSocksConnected := not (SocksInfo.Version in [svSocks4, svSocks4A, svSocks5]);
  SocksInfo.IOHandler := Self;
  FConnection := nil;
  FDataBuffer := '';
  FExtendedDataBuffer := '';
  inherited ConnectClient(AHost, APort, ABoundIP, ABoundPort, ABoundPortMin,
    ABoundPortMax, ATimeout);
  FSocksConnected := true;
  if FClient.Active then
  begin
    FClient.OnSend := nil;
    FClient.OnReceive := nil;
    FClient.Close;
    FClient.OnSend := HandleClientSend;
    FClient.OnReceive := HandleClientReceive;
  end;
  FClientState := CLIENT_STATE_CONNECTING;
  FClient.Open;
  while FClientState = CLIENT_STATE_CONNECTING do
    FClient.DataAvailable;
  if FClientState = CLIENT_STATE_ERROR then
    DoStatus(hsDisconnected);
end;

function TElIndySSHShellIOHandlerSocket.Connected: Boolean;
begin
  Result := (inherited Connected) and (FClientState = CLIENT_STATE_CONNECTED);
end;

procedure TElIndySSHShellIOHandlerSocket.Open;
begin
  inherited Open;
end;

function TElIndySSHShellIOHandlerSocket.Recv(var ABuf; ALen: integer): integer;
var
  Len : integer;
begin
  if not FSocksConnected then
  begin
    Result := FBinding.Recv(ABuf, ALen, 0);
    Exit;
  end;
  if FClientState <> CLIENT_STATE_CONNECTED then
  begin
    Result := -1;
    Exit;
  end;
  Len := Length(FDataBuffer);
  Result := 0;
  if Len = 0 then
  begin
    FDataReceived := false;
    while (not FDataReceived) and (FBinding.HandleAllocated) and Connected do
      FClient.DataAvailable;
  end;
  Len := Length(FDataBuffer);
  if Len > 0 then
  begin
    if ALen < Len then
    begin
      Move(FDataBuffer[1], ABuf, ALen);
      Delete(FDataBuffer, 1, ALen);
      Result := ALen;
    end
    else
    begin
      Move(FDataBuffer[1], ABuf, Len);
      SetLength(FDataBuffer, 0);
      Result := Len;
    end;
  end;
end;

function TElIndySSHShellIOHandlerSocket.Send(var ABuf; ALen: integer): integer;
begin
  if not FSocksConnected then
  begin
    HandleClientSend(Self, @ABuf, ALen);
    Result := ALen;
    Exit;
  end;
  if Assigned(FConnection) and Connected then
  begin
    FConnection.SendData(@ABuf, ALen);
    Result := ALen;
  end
  else
    Result := -1;
end;

function TElIndySSHShellIOHandlerSocket.GetEncryptionAlgorithms(Index :
  TSSHEncryptionAlgorithm) : boolean;
begin
  Result := FClient.EncryptionAlgorithms[Index];
end;

function TElIndySSHShellIOHandlerSocket.GetCompressionAlgorithms(Index :
  TSSHCompressionAlgorithm) : boolean;
begin
  Result := FClient.CompressionAlgorithms[Index];
end;

function TElIndySSHShellIOHandlerSocket.GetMACAlgorithms(Index :
  TSSHMACAlgorithm) : boolean;
begin
  Result := FClient.MacAlgorithms[Index];
end;

procedure TElIndySSHShellIOHandlerSocket.SetEncryptionAlgorithms(Index :
  TSSHEncryptionAlgorithm; Value : boolean);
begin
  FClient.EncryptionAlgorithms[Index] := Value;
end;

procedure TElIndySSHShellIOHandlerSocket.SetCompressionAlgorithms(Index :
  TSSHCompressionAlgorithm; Value : boolean);
begin
  FClient.CompressionAlgorithms[Index] := Value;
end;

procedure TElIndySSHShellIOHandlerSocket.SetMACAlgorithms(Index :
  TSSHMACAlgorithm; Value : boolean);
begin
  FClient.MacAlgorithms[Index] := Value;
end;

function TElIndySSHShellIOHandlerSocket.GetKexAlgorithms(Index :
  TSSHKexAlgorithm) : boolean;
begin
  Result := FClient.KexAlgorithms[Index];
end;

procedure TElIndySSHShellIOHandlerSocket.SetKexAlgorithms(Index :