sbindysslserveriohandler.pas

著名的SecureBlackBox控件完整源码

    procedure SetCertStorage(Value: TElMemoryCertStorage);
    procedure SetClientCertStorage(Value: TElCustomCertStorage);
    procedure SetSessionPool(Value: TElSessionPool);
    procedure SetClientAuthentication(Value: boolean);
    procedure SetAuthenticationLevel(Value: TSBAuthenticationLevel);
    procedure SetCompressionAlgorithms(Index: TSBSSLCompressionAlgorithm; Value:
        boolean);
    procedure SetForceCertificateChain(Value : boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterAccept; override;
    function Recv(var ABuf; ALen: integer): integer; override;
    function Send(var ABuf; ALen: integer): integer; override;
    procedure Open; override;
    procedure Close; override;
    procedure InternalValidate(var Validity: TSBCertificateValidity;
      var Reason: TSBCertificateValidityReason);
    function Readable(AMSec: integer = IdTimeoutDefault): boolean; override;
    procedure RenegotiateCiphers;
    property CipherSuites[Index: TSBCipherSuite]: boolean
    read GetCipherSuites write SetCipherSuites;
    property Version: TSBVersion read GetVersion;
    property CipherSuite: TSBCipherSuite read GetCipherSuite;
    property CompressionAlgorithm: TSBSSLCompressionAlgorithm read
        GetCompressionAlgorithm;
    property CompressionAlgorithms[Index: TSBSSLCompressionAlgorithm]: boolean read
        GetCompressionAlgorithms write SetCompressionAlgorithms;
  published
    property Versions: TSBVersions read GetVersions write SetVersions;
    property CertStorage: TElMemoryCertStorage read GetCertStorage
    write SetCertStorage;
    property ClientCertStorage: TElCustomCertStorage read GetClientCertStorage
    write SetClientCertStorage;
    property SessionPool: TElSessionPool read GetSessionPool write
      SetSessionPool;
    property ReadTimeout: integer read FReadTimeout write FReadTimeout;
    property ClientAuthentication: boolean read GetClientAuthentication
      write SetClientAuthentication;
    property AuthenticationLevel : TSBAuthenticationLevel read
      GetAuthenticationLevel write SetAuthenticationLevel;
    property Extensions: TElServerSSLExtensions read GetExtensions;
    property ForceCertificateChain : boolean read GetForceCertificateChain
      write SetForceCertificateChain;
    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 GetPeerExtensions;
  end;

procedure Register;

implementation

uses
  Sysutils,
  IdAntiFreezeBase,
  IdException,
  IdResourceStrings,
  IdComponent;

////////////////////////////////////////////////////////////////////////////////
// TElIndySSLServerIOHandler

procedure Register;
begin
  RegisterComponents('SSLBlackbox', [TElIndySSLServerIOHandler,
    TElIndySSLIOHandlerServerSocket]);
end;

constructor TElIndySSLServerIOHandler.Create(AOwner: TComponent);
var I : integer;
begin
  inherited;
  FVersions := [sbSSL3, SBTLS1];
  for I := SB_SUITE_RSA_RC4_MD5 to SB_SUITE_LAST do
    FEnabledCipherSuites[I] := True;

  FCompressionAlgorithms[SSL_CA_NONE] := true;
  FCompressionAlgorithms[SSL_CA_ZLIB] := false;

  FReadTimeout := 0;
  FAuthenticationLevel := alRequireCert;
  FForceCertificateChain := false;

  FExtensions := TElServerSSLExtensions.Create;
  FExtensions.StrictCertRequest := false;
  FPeerExtensions := TElCustomSSLExtensions.Create;

end;

destructor TElIndySSLServerIOHandler.Destroy;
begin
  inherited;
  CertStorage := nil;
  ClientCertStorage := nil;
  SessionPool := nil;
  FreeAndNil(FExtensions);
  FreeAndNil(FPeerExtensions);
end;

function TElIndySSLServerIOHandler.Accept(ASocket: TIdStackSocketHandle;
  AThread: TIdThread = nil): TIdIOHandler;
var
  Tmp: TElIndySSLIOHandlerServerSocket;
  I: integer;
begin
  Tmp := TElIndySSLIOHandlerServerSocket.Create(nil);
  Tmp.OnCertificateValidate := HandleCertificateValidate;
  Tmp.CertStorage := FCertStorage;
  Tmp.ClientCertStorage := FClientCertStorage;
  Tmp.SessionPool := FSessionPool;
  Tmp.ClientAuthentication := FClientAuthentication;
  Tmp.AuthenticationLevel := FAuthenticationLevel;
  for I := SB_SUITE_FIRST to SB_SUITE_LAST do
    Tmp.CipherSuites[I] := FEnabledCipherSuites[I];
  for I := SSL_CA_FIRST to SSL_CA_LAST do
    Tmp.CompressionAlgorithms[I] := FCompressionAlgorithms[I];
  Tmp.Versions := FVersions;
  Tmp.ReadTimeout := FReadTimeout;
  Tmp.ForceCertificateChain := FForceCertificateChain;
  Tmp.OnSSLEstablished := HandleSSLEstablished;
  Tmp.OnCiphersNegotiated := HandleCiphersNegotiated;
  Tmp.OnCertificateURLs := HandleCertificateURLs;
  Tmp.OnExtensionsReceived := HandleExtensionsReceived;
  Tmp.OnKeyNeeded := HandleKeyNeeded;

  Tmp.Extensions.Assign(Extensions);
  Tmp.PeerExtensions.Assign(PeerExtensions);
  
  Tmp.OnError := HandleError;
  Tmp.Open;
  Result := nil;
  begin
    if Tmp.Binding.Accept(ASocket) then
    begin
      Result := Tmp;
      Exit;
    end
    else
    begin
      FreeAndNil(Tmp);
    end;
  end;
end;

procedure TElIndySSLServerIOHandler.Init;
begin
  ;
end;

procedure TElIndySSLServerIOHandler.HandleCertificateValidate(Sender: TObject;
  X509Certificate: TElX509Certificate; IOHandler:
    TElIndySSLIOHandlerServerSocket;
  var Validate: boolean);
begin
  if Assigned(FOnCertificateValidate) then
    FOnCertificateValidate(Self, X509Certificate, IOHandler, Validate);
end;

function TElIndySSLServerIOHandler.GetCipherSuites(Index: TSBCipherSuite):
  boolean;
begin
  Result := FEnabledCipherSuites[Index];
end;

function TElIndySSLServerIOHandler.GetCertStorage: TElMemoryCertStorage;
begin
  Result := FCertStorage;
end;

function TElIndySSLServerIOHandler.GetClientCertStorage: TElCustomCertStorage;
begin
  Result := FClientCertStorage;
end;

function TElIndySSLServerIOHandler.GetSessionPool: TElSessionPool;
begin
  Result := FSessionPool;
end;

procedure TElIndySSLServerIOHandler.SetCipherSuites(Index: TSBCipherSuite;
  Value: boolean);
begin
  FEnabledCipherSuites[Index] := Value;
end;

procedure TElIndySSLServerIOHandler.SetCertStorage(Value: TElMemoryCertStorage);
begin
  if Value <> FCertStorage then
  begin
    FCertStorage := Value;
    if Value <> nil then
      Value.FreeNotification(Self);
  end;
end;

procedure TElIndySSLServerIOHandler.SetClientCertStorage(Value:
  TElCustomCertStorage);
begin
  if Value <> FClientCertStorage then
  begin
    FClientCertStorage := Value;
    if Value <> nil then
      Value.FreeNotification(Self)
  end;
end;

procedure TElIndySSLServerIOHandler.SetSessionPool(Value: TElSessionPool);
begin
  if Value <> FSessionPool then
  begin
    FSessionPool := Value;
    if Value <> nil then
      Value.FreeNotification(Self)
  end;
end;

procedure TElIndySSLServerIOHandler.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
  begin
    if (AComponent = CertStorage) then
    begin
      SetCertStorage(nil);
    end
    else
      if (AComponent = SessionPool) then
      SetSessionPool(nil)
    else
      if (AComponent = ClientCertStorage) then
      SetClientCertStorage(nil);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// TElIndySSLIOHandler

constructor TElIndySSLIOHandlerServerSocket.Create(AOwner: TComponent);
begin
  inherited;
  FSecureServer := TElSecureServer.Create(nil);
  FSecureServer.OnSend := HandleSend;
  FSecureServer.OnReceive := HandleReceive;
  FSecureServer.OnData := HandleData;
  FSecureServer.OnOpenConnection := HandleOpenConnection;
  FSecureServer.OnCloseConnection := HandleCloseConnection;
  FSecureServer.OnCertificateValidate := HandleCertificateValidate;
  FSecureServer.OnCiphersNegotiated := HandleCiphersNegotiated;
  FSecureServer.OnError := HandleError;
  FConnected := false;
  FErrorOccured := false;
  FReadTimeout := 0;
end;

destructor TElIndySSLIOHandlerServerSocket.Destroy;
begin
  inherited;
  FreeAndNil(FSecureServer);
end;

procedure TElIndySSLIOHandlerServerSocket.AfterAccept;
begin
  FSecureServer.Open;
  while (not FConnected) and (not FErrorOccured) do
    FSecureServer.DataAvailable;
  if FConnected then
    DoSSLEstablished;
end;

function TElIndySSLIOHandlerServerSocket.Recv(var ABuf; ALen: integer): integer;
begin
  if Length(FBuffer) > 0 then
  begin
    if ALen < Length(FBuffer) then
    begin
      Move(FBuffer[1], ABuf, ALen);
      Delete(FBuffer, 1, ALen);
      Result := ALen;
    end
    else
    begin
      Result := Length(FBuffer);
      Move(FBuffer[1], ABuf, Length(FBuffer));
      SetLength(FBuffer, 0);
    end;
  end
  else
  begin
    FDataReceived := False;
    FRecvBuffer := @ABuf;
    FRecvMaxSize := ALen;
    FRecvWritten := 0;
    while (not FDataReceived) and (FBinding.HandleAllocated) and (not
      FErrorOccured) do FSecureServer.DataAvailable;
    Result := FRecvWritten;
  end;
end;

function TElIndySSLIOHandlerServerSocket.Send(var ABuf; ALen: integer): integer;
begin
  if FSecureServer.Active then
  begin
    FSecureServer.SendData(@ABuf, ALen);
    Result := ALen;
  end
  else
    Result := 0;
end;

procedure TElIndySSLIOHandlerServerSocket.Open;
begin
  inherited;
end;

procedure TElIndySSLIOHandlerServerSocket.Close;
var b : boolean;
begin
  b := FSecureServer.Enabled;
  FSecureServer.Enabled := false;
  FSecureServer.Close;
  FSecureServer.Enabled := b;
  inherited;
end;

procedure TElIndySSLIOHandlerServerSocket.DoActualSend(Buffer: pointer;
  Size: integer);
var
  Sent, JustSent: integer;
begin