sbindysslserveriohandler.pas

著名的SecureBlackBox控件完整源码

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

unit SBIndySSLServerIOHandler;

interface

{$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 IdIOHandlerSocket,
  IdIOHandler,
  IdServerIOHandler,
  IdSSLOpenSSL,
  IdThread,
  IdStack,
  IdSocketHandle,
  IdStackConsts,
  Classes,
  SBServer,
  IdGlobal,
  IdServerIOHandlerSocket,
  {$ifndef LINUX}
  Windows,
  Winsock,
  {$endif}
  SBSSLCommon,
  SBSSLConstants,
  SBCustomCertStorage,
  SBSessionPool,
  SBUtils,
  SBX509,
  SBConstants;

type
  TElIndySSLIOHandlerServerSocket = class;

  TSBIndyIOHandlerCertificateValidateEvent = procedure(Sender: TObject;
    X509Certificate: TElX509Certificate; IOHandler:
      TElIndySSLIOHandlerServerSocket;
    var Validate: boolean) of object;

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

  TElIndySSLServerIOHandler = class(TIdServerIOHandlerSocket)
  private
    FOnCertificateValidate: TSBIndyIOHandlerCertificateValidateEvent;
    FOnSSLEstablished : TSBSSLEstablishedEvent;
    FAuthenticationLevel: TSBAuthenticationLevel;
    FClientAuthentication: boolean;
    FVersions: TSBVersions;
    FEnabledCipherSuites: array[SB_SUITE_FIRST..SB_SUITE_LAST] of boolean;
    FCompressionAlgorithms : array[TSBSSLCompressionAlgorithm] of boolean;
    FCertStorage: TElMemoryCertStorage;
    FClientCertStorage: TElCustomCertStorage;
    FExtensions: TElServerSSLExtensions;
    FSessionPool: TElSessionPool;
    FReadTimeout: Integer;
    FForceCertificateChain : boolean;
    FOnCertificateURLs: TSBCertificateURLsEvent;
    FOnKeyNeeded: TSBServerKeyNeededEvent;
    FPeerExtensions: TElCustomSSLExtensions;
    FOnCiphersNegotiated: TNotifyEvent;
    FOnError: TSBErrorEvent;
    FOnExtensionsReceived: TSBExtensionsReceivedEvent;

    procedure HandleCertificateValidate(Sender: TObject; X509Certificate:
      TElX509Certificate; IOHandler: TElIndySSLIOHandlerServerSocket; var Validate: boolean);
    procedure HandleCiphersNegotiated(Sender : TObject);
    procedure HandleError(Sender : TObject; ErrorCode: integer; Fatal: boolean;
        Remote : boolean);
    procedure HandleSSLEstablished(Sender : TObject; Version : TSBVersion; CipherSuite : TSBCipherSuite);
    procedure HandleKeyNeeded(Sender: TObject; const Identity : string; var Key : ByteArray);
    procedure HandleCertificateURLs(Sender: {$ifndef DELPHI_NET}TObject{$else}System.Object{$endif};
        URLs : TElClientCertURLsSSLExtension; Certificates: TElMemoryCertStorage);
    procedure HandleExtensionsReceived(Sender : TObject);
  protected
    function GetCipherSuites(Index: TSBCipherSuite): boolean;
    function GetCertStorage: TElMemoryCertStorage;
    function GetClientCertStorage: TElCustomCertStorage;
    function GetCompressionAlgorithms(Index: TSBSSLCompressionAlgorithm): boolean;
    function GetSessionPool: TElSessionPool;
    procedure SetCipherSuites(Index: TSBCipherSuite; Value: boolean);
    procedure SetCertStorage(Value: TElMemoryCertStorage);
    procedure SetClientCertStorage(Value: TElCustomCertStorage);
    procedure SetSessionPool(Value: TElSessionPool);
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure SetCompressionAlgorithms(Index: TSBSSLCompressionAlgorithm; Value:
        boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Accept(ASocket: TIdStackSocketHandle; AThread: TIdThread = nil):
      TIdIOHandler; override;
    procedure Init; override;
    property CipherSuites[Index: TSBCipherSuite]: boolean read GetCipherSuites
    write SetCipherSuites;
    property CompressionAlgorithms[Index: TSBSSLCompressionAlgorithm]: boolean read
        GetCompressionAlgorithms write SetCompressionAlgorithms;
  published
    property AuthenticationLevel : TSBAuthenticationLevel read
      FAuthenticationLevel write FAuthenticationLevel;
    property Versions: TSBVersions read FVersions write FVersions;
    property ClientAuthentication: boolean read FClientAuthentication write
      FClientAuthentication;
    property CertStorage: TElMemoryCertStorage read GetCertStorage
    write SetCertStorage;
    property ClientCertStorage: TElCustomCertStorage read GetClientCertStorage
    write SetClientCertStorage;
    property Extensions: TElServerSSLExtensions read FExtensions;
    property SessionPool: TElSessionPool read GetSessionPool write
      SetSessionPool;
    property ReadTimeout : Integer read FReadTimeout write FReadTimeout;
    property ForceCertificateChain : boolean read FForceCertificateChain
      write FForceCertificateChain default false;
    property OnCertificateURLs: TSBCertificateURLsEvent read FOnCertificateURLs
        write FOnCertificateURLs;
    property OnCertificateValidate: TSBIndyIOHandlerCertificateValidateEvent
      read FOnCertificateValidate write FOnCertificateValidate;
    property OnCiphersNegotiated: TNotifyEvent read FOnCiphersNegotiated write
        FOnCiphersNegotiated;
    property OnError: TSBErrorEvent read FOnError write FOnError;
    property OnExtensionsReceived: TSBExtensionsReceivedEvent read
        FOnExtensionsReceived write FOnExtensionsReceived;
    property OnKeyNeeded: TSBServerKeyNeededEvent read FOnKeyNeeded write
        FOnKeyNeeded;
    property OnSSLEstablished : TSBSSLEstablishedEvent read
      FOnSSLEstablished write FOnSSLEstablished;
    property PeerExtensions: TElCustomSSLExtensions read FPeerExtensions;
  end;

  TElIndySSLIOHandlerServerSocket = class(TIdIOHandlerSocket)
  private
    FSecureServer: TElSecureServer;
    FBuffer: string;
    FDataReceived: boolean;
    FRecvBuffer: pointer;
    FRecvMaxSize: integer;
    FRecvWritten: integer;
    FReadTimeout: integer;
    FConnected: boolean;
    FErrorOccured: boolean;
    FOnCertificateURLs: TSBCertificateURLsEvent;
    FOnCertificateValidate: TSBIndyIOHandlerCertificateValidateEvent;
    FOnExtensionsReceived: TSBExtensionsReceivedEvent;
    FOnKeyNeeded: TSBServerKeyNeededEvent;
    FOnSSLEstablished : TSBSSLEstablishedEvent;
    FOnCiphersNegotiated: TNotifyEvent;
    FOnError: TSBErrorEvent;
    procedure HandleSend(Sender: TObject; Buffer: pointer; Size: longint);
    procedure HandleReceive(Sender: TObject; Buffer: pointer; MaxSize: longint;
      {$ifndef BUIlDER_USED}out{$else}var{$endif} Written: longint);
    procedure HandleData(Sender: TObject; Buffer: pointer; Size: longint);
    procedure HandleOpenConnection(Sender: TObject);
    procedure HandleCloseConnection(Sender: TObject; CloseDescription: integer);
    procedure HandleCertificateValidate(Sender: TObject; X509Certificate:
      TElX509Certificate;
      var Validate: boolean);
    procedure HandleCiphersNegotiated(Sender : TObject);
    procedure HandleError(Sender : TObject; ErrorCode: integer; Fatal: boolean;
        Remote : boolean);
  protected
    procedure DoActualSend(Buffer: pointer; Size: integer);
    procedure DoSSLEstablished;
    function GetCipherSuites(Index: TSBCipherSuite): boolean;
    function GetVersions: TSBVersions;
    function GetCipherSuite: TSBCipherSuite;
    function GetVersion: TSBVersion;
    function GetCertStorage: TElMemoryCertStorage;
    function GetClientCertStorage: TElCustomCertStorage;
    function GetSessionPool: TElSessionPool;
    function GetClientAuthentication: boolean;
    function GetAuthenticationLevel: TSBAuthenticationLevel;
    function GetCompressionAlgorithm: TSBSSLCompressionAlgorithm;
    function GetCompressionAlgorithms(Index: TSBSSLCompressionAlgorithm): boolean;
    function GetExtensions: TElServerSSLExtensions;
    function GetForceCertificateChain : boolean;
    function GetPeerExtensions: TElCustomSSLExtensions;
    procedure SetCipherSuites(Index: TSBCipherSuite; Value: boolean);
    procedure SetVersions(Value: TSBVersions);