sbidftpiohandler.pas

著名的SecureBlackBox控件完整源码

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

unit SBIdFTPIOHandler;

interface
{
  Uncomment the following line if you are using Indy Library,
  version 9.0.13 or higher.
}
{$define INDY9013}

{$ifdef CLR}
    {$DEFINE DELPHI_NET}
    {$DEFINE NET_registered}
{$endif}

{$ifndef CLR}
{$ifndef FPC}
{$define DELPHI_WIN}
{$endif}
{$endif}

{$IFDEF VER120}
  {$DEFINE D_3_UP}
  {$DEFINE D_4_UP}
  {$DEFINE VCL40}
{$ENDIF}

{$IFDEF VER125}
  {$DEFINE B_3_UP}
  {$DEFINE B_4_UP}
  {$DEFINE B_4}
  {$DEFINE VCL40}
  {$DEFINE BUILDER_USED}
{$ENDIF}

{$IFDEF VER130}
	{$IFDEF BCB}
		{$DEFINE B_3_UP}
		{$DEFINE B_4_UP}
		{$DEFINE B_5_UP}
		{$DEFINE B_5}
		{$DEFINE VCL40}
		{$DEFINE VCL50}
		{$DEFINE BUILDER_USED}
    {$ELSE}
		{$DEFINE D_3_UP}
		{$DEFINE D_4_UP}
		{$DEFINE D_5_UP}
		{$DEFINE VCL40}
		{$DEFINE VCL50}
    {$ENDIF}
{$ENDIF}

{$IFDEF VER140}
	{$IFDEF BCB}
		{$DEFINE B_3_UP}
		{$DEFINE B_4_UP}
		{$DEFINE B_5_UP}
		{$DEFINE B_6_UP}
		{$DEFINE B_6}
		{$DEFINE VCL40}
		{$DEFINE VCL50}
		{$DEFINE VCL60}
		{$DEFINE BUILDER_USED}
    {$ELSE}
		{$DEFINE D_3_UP}
		{$DEFINE D_4_UP}
		{$DEFINE D_5_UP}
		{$DEFINE D_6_UP}
		{$DEFINE D_6}
		{$DEFINE VCL40}
		{$DEFINE VCL50}
		{$DEFINE VCL60}
		{.DEFINE USEADO}
    {$ENDIF}
{$ENDIF}


{$IFDEF VER150}
	{$IFNDEF BCB}
		{$DEFINE D_3_UP}
		{$DEFINE D_4_UP}
		{$DEFINE D_5_UP}
		{$DEFINE D_6_UP}
		{$DEFINE D_7_UP}
		{$DEFINE D_7}
		{$DEFINE VCL40}
		{$DEFINE VCL50}
		{$DEFINE VCL60}
		{$DEFINE VCL70}
		{.DEFINE USEADO}
    {$ENDIF}
{$ENDIF}

{$IFDEF VER160}
    {$DEFINE D_3_UP}
    {$DEFINE D_4_UP}
    {$DEFINE D_5_UP}
    {$DEFINE D_6_UP}
    {$DEFINE D_7_UP}
    {$DEFINE D_8_UP}
    {$DEFINE D_8}
    {$DEFINE VCL40}
    {$DEFINE VCL50}
    {$DEFINE VCL60}
    {$DEFINE VCL70}
    {$DEFINE VCL80}
    {.$DEFINE USE_NAME_SPACE} // Optional !!!
{$ENDIF}

{$IFDEF VER170}
    {$DEFINE D_3_UP}
    {$DEFINE D_4_UP}
    {$DEFINE D_5_UP}
    {$DEFINE D_6_UP}
    {$DEFINE D_7_UP}
    {$DEFINE D_8_UP}
    {$DEFINE D_9_UP}
    {$DEFINE D_9}
    {$DEFINE VCL40}
    {$DEFINE VCL50}
    {$DEFINE VCL60}
    {$DEFINE VCL70}
    {$DEFINE VCL80}
    {$DEFINE VCL90}
    {.$DEFINE USE_NAME_SPACE} // Optional !!!
{$ENDIF}

{$IFDEF VER180}
    {$DEFINE D_3_UP}
    {$DEFINE D_4_UP}
    {$DEFINE D_5_UP}
    {$DEFINE D_6_UP}
    {$DEFINE D_7_UP}
    {$DEFINE D_8_UP}
    {$DEFINE D_9_UP}
    {$DEFINE D_X_UP}
    {$DEFINE D_X}
    {$DEFINE VCL40}
    {$DEFINE VCL50}
    {$DEFINE VCL60}
    {$DEFINE VCL70}
    {$DEFINE VCL80}
    {$DEFINE VCL90}
    {$DEFINE VCL100}

    {$DEFINE B_3_UP}
    {$DEFINE B_4_UP}
    {$DEFINE B_5_UP}
    {$DEFINE B_6_UP}
    {$DEFINE B_X_UP}
    {$DEFINE B_X}
    {$ifndef DELPHI_NET}	    
    {$DEFINE BUILDER_USED}
    {$endif}
{$ENDIF}
    
{$ifndef CHROME}
{$ifndef DELPHI_NET}
{$IFDEF D_7_UP}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
{$ENDIF}
{$ENDIF}
{$ENDIF}

uses
  {$ifndef LINUX}Windows,{$else}libc, {$endif}Classes, Sysutils, IdIOHandlerSocket, IdGlobal,
  IdAntiFreeze, IdFTP, SBClient, SBX509, SBUtils, SBIndyIOHandler, SBConstants,
  SBSSLCommon, SBCustomCertStorage;

type
  TFTPState = (fsPlain, fsEncrypted);
  TSSLMode = (smImplicit, smExplicit);

type

  TSBSSLEstablishedEvent = procedure(Sender : TObject; Version : TSBVersion; CipherSuite : TSBCipherSuite) of object;

  TElIdFTPIOHandlerSocket = class(TIdIOHandlerSocket)
  private
    FSecureClient : TElSecureClient;
    FValidity : TSBCertificateValidity;
    FReason : TSBCertificateValidityReason;
    FErrorOccured : boolean;
    FUseSSL : boolean;
    FEncryptDataChannel : boolean;
    FServerHelloReceived : boolean;
    FState : TFTPState;
    FBuffer : string;
    FDataReceived: boolean;
    FRecvBuffer: pointer;
    FRecvMaxSize: integer;
    FRecvWritten: integer;
    FDataIOHandler : TElIndySSLIOHandlerSocket;
    FOnCertificateValidate : TSBCertificateValidateEvent;
    FOnCertificateNeeded : TSBCertificateNeededEvent;
    FOnCertificateNeededEx : TSBCertificateNeededExEvent;
    FOnSSLEstablished: TSBSSLEstablishedEvent;
    FSSLMode : TSSLMode;
    FReadTimeout : integer;
    procedure HandleSecureClientSend(Sender : TObject; Buffer : pointer; Size : longint);
    procedure HandleSecureClientReceive(Sender : TObject; Buffer : pointer;
      MaxSize : longint; {$ifndef BUILDER_USED}out{$else}var{$endif} Written : longint);
    procedure HandleSecureClientData(Sender : TObject; Buffer : pointer; Size : longint);
    procedure HandleSecureClientOpenConnection(Sender : TObject);
    procedure HandleSecureClientCloseConnection(Sender : TObject; CloseReason : TSBCloseReason);
    procedure HandleSecureClientCertificateValidate(Sender : TObject;
      Certificate : TElX509Certificate; var Validate : boolean);
    procedure HandleSecureClientCertificateNeeded(Sender : TObject; CertificateBuffer: pointer;
      var CertificateSize: LongInt; PrivateKeyBuffer: pointer; var PrivateKeySize: LongInt;
      CertificateType: TClientCertificateType);
    procedure HandleSecureClientCertificateNeededEx(Sender : TObject; var Certificate :
      TElX509Certificate);
    procedure HandleIOHandlerCertificateValidate(Sender : TObject;
      Certificate : TElX509Certificate; var Validate : boolean);
    procedure HandleIOHandlerCertificateNeeded(Sender : TObject; CertificateBuffer: pointer;
      var CertificateSize: LongInt; PrivateKeyBuffer: pointer; var PrivateKeySize: LongInt;
      CertificateType: TClientCertificateType);
    procedure HandleIOHandlerCertificateNeededEx(Sender: TObject; var Certificate:
      TElX509Certificate);
  protected
    procedure DoActualSend(Buffer: pointer; Size: integer);
    procedure DoSSLEstablished;
    function RecvEnc(var ABuf; ALen: integer): integer;
    function ParseServerHello(const ABuf; ALen : integer) : boolean;
    function EstablishSSLSession : string;
    function EstablishImplicitSession: boolean;
    function GetFTPCode(const ABuf; ALen : integer) : integer;
    function GetNextCommand(const S : string; var Code : integer) : string;
    function GetCertStorage : TElCustomCertStorage;
    procedure SetCertStorage(Value : TElCustomCertStorage);
    function GetCipherSuites(Index : TSBCipherSuite) : boolean;
    procedure SetCipherSuites(Index : TSBCipherSuite; Value : boolean);
    function GetVersions : TSBVersions;
    procedure SetVersions(Value : TSBVersions);
    function GetCipherSuite : TSBCipherSuite;
    function GetOnCiphersNegotiated: TNotifyEvent;
    function GetOnError: TSBErrorEvent;
    function GetVersion : TSBVersion;
    procedure SetOnCiphersNegotiated(Value: TNotifyEvent);
    procedure SetOnError(Value: TSBErrorEvent);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; 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 Recv(var ABuf; ALen: integer): integer; override;
    function Send(var ABuf; ALen: integer): integer; override;
    procedure Close; override;
    procedure Open; override;
    procedure InternalValidate(var Validity : TSBCertificateValidity;
      var Reason : TSBCertificateValidityReason);
    procedure RenegotiateCiphers;

    property CipherSuites[Index : TSBCipherSuite] : boolean read GetCipherSuites
      write SetCipherSuites;
    property CipherSuite : TSBCipherSuite read GetCipherSuite;
    property Version : TSBVersion read GetVersion;
  published
    property UseSSL : boolean read FUseSSL write FUseSSL;
    property ReadTimeout: integer read FReadTimeout write FReadTimeout;
    property SSLMode : TSSLMode read FSSLMode write FSSLMode default smExplicit;
    property Versions : TSBVersions read GetVersions write SetVersions;
    property EncryptDataChannel : boolean read FEncryptDataChannel write FEncryptDataChannel;
    property CertStorage : TElCustomCertStorage read GetCertStorage write SetCertStorage;
    property OnCertificateValidate : TSBCertificateValidateEvent read FOnCertificateValidate
      write FOnCertificateValidate;
    property OnCertificateNeeded : TSBCertificateNeededEvent read FOnCertificateNeeded
      write FOnCertificateNeeded;
    property OnCertificateNeededEx : TSBCertificateNeededExEvent read FOnCertificateNeededEx
      write FOnCertificateNeededEx;
    property OnCiphersNegotiated: TNotifyEvent read GetOnCiphersNegotiated write
        SetOnCiphersNegotiated;
    property OnError: TSBErrorEvent read GetOnError write SetOnError;
    property OnSSLEstablished: TSBSSLEstablishedEvent read FOnSSLEstablished write
        FOnSSLEstablished;
  end;
  
  TElIdFTP = class(TIdFTP)
  protected
    procedure IntGet(const ACommand: string; ADest: TStream; AResume: Boolean = false);
    {$ifdef INDY9013}
    procedure IntPut(const ACommand: string; ASource: TStream; AFromBeginning: Boolean = true);
    {$else}
    procedure IntPut(const ACommand: string; ASource: TStream);
    {$endif}
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  end;

procedure Register;

implementation

uses
  IdAntiFreezeBase, IdException, IdResourceStrings, IdStack, IdStackConsts,
  IdComponent, IdTCPClient, IdSimpleServer;

procedure Register;
begin
  RegisterComponents('SSLBlackbox', [TElIdFTP, TElIdFtpIOHandlerSocket]);
end;

constructor TElIdFTPIOHandlerSocket.Create(AOwner : TComponent);
begin
  inherited;
  FSecureClient := TElSecureClient.Create(nil);
  FSecureClient.OnSend := HandleSecureClientSend;
  FSecureClient.OnReceive := HandleSecureClientReceive;
  FSecureClient.OnData := HandleSecureClientData;
  FSecureClient.OnOpenConnection := HandleSecureClientOpenConnection;
  FSecureClient.OnCloseConnection := HandleSecureClientCloseConnection;
  FSecureClient.OnCertificateValidate := HandleSecureClientCertificateValidate;
  FSecureClient.OnCertificateNeeded := HandleSecureClientCertificateNeeded;
  FSecureClient.OnCertificateNeededEx := HandleSecureClientCertificateNeededEx;
  FState := fsPlain;
  FServerHelloReceived := false;
  FDataIOHandler := TElIndySSLIOHandlerSocket.Create(nil);
  FDataIOHandler.OnCertificateValidate := HandleIOHandlerCertificateValidate;
  FDataIOHandler.OnCertificateNeeded := HandleIOHandlerCertificateNeeded;
  FDataIOHandler.OnCertificateNeededEx := HandleIOHandlerCertificateNeededEx;
  FValidity := cvStorageError;
  FSSLMode := smExplicit;
  FReason := [];
  FReadTimeout := 0;
end;

destructor TElIdFTPIOHandlerSocket.Destroy;
begin
  inherited;
  FreeAndNil(FSecureClient);
  FreeAndNil(FDataIOHandler);
end;

procedure TElIdFTPIOHandlerSocket.ConnectClient(const AHost: string; const APort: Integer;
  const ABoundIP: string; const ABoundPort: Integer;
  const ABoundPortMin: Integer; const ABoundPortMax: Integer;
  const ATimeout: Integer = IdTimeoutDefault);
begin
  inherited;