sbindyserveriohandler10.pas

著名的SecureBlackBox控件完整源码

  if FIsPeer then
  begin
    if (FSecured) and (FBinding <> nil) and (not FPassThrough) then
    try
      FSecureServer.Close(ForceClose or (not FBinding.HandleAllocated));
    except
      on E : EIdSocketError do ;
    end;
  end;
  inherited Close;
end;

function TElClientServerIndySSLIOHandlerSocket.Connected: Boolean;
begin
  if (FSecured) and (not FPassThrough) and FIsPeer then
    Result := FSecureServer.Active
  else if (FSecured) and (not FPassThrough) and (not FIsPeer) then
    Result := FSecureClient.Active
  else
    Result := inherited Connected;
end;

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

(*
procedure TElClientServerIndySSLIOHandlerSocket.HandleCiphersNegotiated(Sender
    : TObject);
begin
  if Assigned(FOnCiphersNegotiated) then
    FOnCiphersNegotiated(Self);
end;

procedure TElClientServerIndySSLIOHandlerSocket.HandleError(Sender : TObject;
    ErrorCode: integer; Fatal: boolean; Remote : boolean);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorCode, Fatal, Remote);
end;
*)

procedure TElClientServerIndySSLIOHandlerSocket.InternalValidate(var Validity:
    TSBCertificateValidity; var Reason: TSBCertificateValidityReason);
begin
  FSecureServer.InternalValidate(Validity, Reason);
end;

procedure TElClientServerIndySSLIOHandlerSocket.RenegotiateCiphers;
begin
  FSecureServer.RenegotiateCiphers;
end;

procedure TElClientServerIndySSLIOHandlerSocket.StartSSL;
begin
  if FPassThrough then
    Exit;
  FErrorOccured := false;
  ForceClose := false;
 
  if FIsPeer then
  begin
    if FSecureServer.Active then
    begin
      FSecureServer.OnSend := nil;
      FSecureServer.Close;
    end;
    FSecureServer.OnSend := OnSecureClientSend;
    FSecureServer.OnReceive := OnSecureClientReceive;
    FSecureServer.OnData := OnSecureClientData;
    FSecureServer.Open;
    while (not FSecureServer.Active) and (not FErrorOccured) do
    begin
      if Assigned(FBinding) and FBinding.Select then
        FSecureServer.DataAvailable;
    end;
    if FSecureServer.Active then
    begin
      FSecured := true;
      DoSSLEstablished;
    end
    else
    begin
      ForceClose := true;
      raise EIdSSLProtocolReplyError.Create(RSSSLConnectError);
    end;
  end
  else
    inherited StartSSL;
end;

{ if you got an error here, please see the comment at the top of the unit }
{$ifndef INDY1011}
procedure TElClientServerIndySSLIOHandlerSocket.WriteDirect(ABuffer: TIdBytes);
{$else}
procedure TElClientServerIndySSLIOHandlerSocket.WriteDirect(var ABuffer: TIdBytes);
{$endif}
begin
  if Intercept <> nil then
    Intercept.Send(ABuffer);
  if FSecured and (not FPassThrough) and (FIsPeer) then
  begin
    {$ifndef DELPHI_NET}
    FSecureServer.SendData(@ABuffer[0], Length(ABuffer))
    {$else}
    FSecureServer.SendData(ABuffer)
    {$endif}
  end
  else if FSecured and (not FPassThrough) and (not FIsPeer) then
  begin
    {$ifndef DELPHI_NET}
    FSecureClient.SendData(@ABuffer[0], Length(ABuffer))
    {$else}
    FSecureClient.SendData(ABuffer)
    {$endif}
  end
  else
  begin
    {$ifndef DELPHI_NET}
    OnSecureClientSend(Self, @ABuffer[0], Length(ABuffer));
    {$else}
    OnSecureClientSend(Self, ABuffer);
    {$endif}
  end;
end;

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

procedure TElIndySSLServerIOHandler.HandleSSLEstablished(Sender: TObject;
    Version: TSBVersion; CipherSuite: TSBCipherSuite);
begin
  if assigned(FOnSSLEstablished) then
    FOnSSLEstablished(Self, Version, CipherSuite);
end;

procedure TElIndySSLServerIOHandler.CopySSLParams(IOHandler : TElClientServerIndySSLIOHandlerSocket);
var
  I : integer;
begin
  if not Assigned(IOHandler) then
    Exit;
  for I := SB_SUITE_FIRST to SB_SUITE_LAST do
    IOHandler.CipherSuites[I] := FCipherSuites[I];
  for I := SSL_CA_FIRST to SSL_CA_LAST do
    IOHandler.CompressionAlgorithms[I] := FCompressionAlgorithms[I];
  IOHandler.Versions := FVersions;
  IOHandler.ServerCertStorage := FServerCertStorage;
  IOHandler.CertStorage := FCertStorage;
  IOHandler.SessionPool := FSessionPool;
  IOHandler.ClientAuthentication := FClientAuthentication;
  IOHandler.OnCertificateValidate := Self.HandleCertificateValidate;
  IOHandler.OnSSLEstablished := HandleSSLEstablished;
  IOHandler.Passthrough := Passthrough;
  IOHandler.AuthenticationLevel := FAuthenticationLevel;
  IOHandler.ForceCertificateChain := FForceCertificateChain;
end;

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

procedure TElIndySSLServerIOHandler.Notification(AComponent : TComponent; AOperation :
  TOperation);
begin
  inherited;
  if (AComponent = FServerCertStorage) and (AOperation = opRemove) then
    ServerCertStorage := nil;
  if (AComponent = FCertStorage) and (AOperation = opRemove) then
    CertStorage := nil;
  if (AComponent = FSessionPool) and (AOperation = opRemove) then
    SessionPool := nil;
end;

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

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

procedure TElIndySSLServerIOHandler.SetServerCertStorage(Value : TElMemoryCertStorage);
begin
  if Value <> FServerCertStorage then
  begin
    if Assigned(Value) then
      Value.FreeNotification(Self);
    FServerCertStorage := Value;
  end;
end;

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

function TElIndySSLServerIOHandler.Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread;
  AYarn: TIdYarn): TIdIOHandler; 
var
  IOHandler : TElClientServerIndySSLIOHandlerSocket;
  i : integer;
begin
  IOHandler := TElClientServerIndySSLIOHandlerSocket.Create(nil);
  IOHandler.OnCertificateValidate := FOnCertificateValidate;
  IOHandler.OnCertificateNeeded := FOnCertificateNeeded;
  IOHandler.OnCertificateNeededEx := FOnCertificateNeededEx;
  IOHandler.OnError := FOnError;
  IOHandler.OnCiphersNegotiated := FOnCiphersNegotiated;
  IOHandler.IsPeer := true;
  IOHandler.Open;
  IOHandler.Passthrough := Passthrough;

  for i := SSL_CA_FIRST to SSL_CA_LAST do
    IOHandler.CompressionAlgorithms[i] := FCompressionAlgorithms[i];

  if IOHandler.Binding.Accept(ASocket.Handle) then
  begin
    CopySSLParams(IOHandler);
    IOHandler.AfterAccept;
    Result := IOHandler;
  end
  else
  begin
    Result := nil;
    IOHandler.Free;
  end;
end;

function TElIndySSLServerIOHandler.GetCompressionAlgorithms(Index:
    TSBSSLCompressionAlgorithm): boolean;
begin
  Result := FCompressionAlgorithms[Index];
end;

procedure TElIndySSLServerIOHandler.HandleCiphersNegotiated(Sender : TObject);
begin
  if Assigned(FOnCiphersNegotiated) then
    FOnCiphersNegotiated(Self);
end;

procedure TElIndySSLServerIOHandler.HandleError(Sender : TObject; ErrorCode:
    integer; Fatal: boolean; Remote : boolean);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorCode, Fatal, Remote);
end;

procedure TElIndySSLServerIOHandler.Init;
//var
//  I : integer;
begin
  (*
  {$ifndef DELPHI_NET}
  FVersions := [sbSSL2, sbSSL3, sbTLS1];
  {$else}
  FVersions := sbSSL2 or sbSSL3 or sbTLS1;
  {$endif}
  FOnCertificateNeeded := nil;
  FOnCertificateValidate := nil;
  FOnCertificateNeededEx := nil;
  FOnError := nil;
  FOnCiphersNegotiated := nil;

  for I := SB_SUITE_FIRST to SB_SUITE_LAST do
    FCipherSuites[I] := true;
  FCompressionAlgorithms[SSL_CA_NONE] := true;
  FCompressionAlgorithms[SSL_CA_ZLIB] := false;

  FClientAuthentication := false;
  FAuthenticationLevel := alRequireCert;
  FForceCertificateChain := false;
  *)
end;

procedure TElIndySSLServerIOHandler.InitComponent;
var
  I : integer;
begin
  inherited;
  FPassthrough := true;
  // added by II 20061220
  {$ifndef DELPHI_NET}
  FVersions := [sbSSL2, sbSSL3, sbTLS1];
  {$else}
  FVersions := sbSSL2 or sbSSL3 or sbTLS1;
  {$endif}
  FOnCertificateNeeded := nil;
  FOnCertificateValidate := nil;
  FOnCertificateNeededEx := nil;
  FOnError := nil;
  FOnCiphersNegotiated := nil;

  for I := SB_SUITE_FIRST to SB_SUITE_LAST do
    FCipherSuites[I] := true;
  FCompressionAlgorithms[SSL_CA_NONE] := true;
  FCompressionAlgorithms[SSL_CA_ZLIB] := false;

  FClientAuthentication := false;
  FAuthenticationLevel := alRequireCert;
  FForceCertificateChain := false;
end;

function TElIndySSLServerIOHandler.MakeClientIOHandler : TIdSSLIOHandlerSocketBase;
var
  IOHandler : TElClientServerIndySSLIOHandlerSocket;
begin
  IOHandler := TElClientServerIndySSLIOHandlerSocket.Create(nil);
  IOHandler.OnCertificateValidate := FOnCertificateValidate;
  IOHandler.OnCertificateNeeded := FOnCertificateNeeded;
  IOHandler.OnCertificateNeededEx := FOnCertificateNeededEx;
  CopySSLParams(IOHandler);
  Result := IOHandler;
end;

////////////////////////////////////////////////////////////////////////////////
// TElIndySSLServerIOHandler class

function TElIndySSLServerIOHandler.MakeClientIOHandler(ATheThread:TIdYarn): TIdIOHandler;
begin
  Result := nil;
end;

function TElIndySSLServerIOHandler.MakeFTPSvrPasv : TIdSSLIOHandlerSocketBase;
var
  IOHandler : TElClientServerIndySSLIOHandlerSocket;
begin
  IOHandler := TElClientServerIndySSLIOHandlerSocket.Create(nil);
  IOHandler.OnCertificateValidate := FOnCertificateValidate;
  IOHandler.OnCertificateNeeded := FOnCertificateNeeded;
  IOHandler.OnCertificateNeededEx := FOnCertificateNeededEx;
  CopySSLParams(IOHandler);
  IOHandler.IsPeer := true;
  Result := IOHandler;
end;

function TElIndySSLServerIOHandler.MakeFTPSvrPort : TIdSSLIOHandlerSocketBase;
var
  IOHandler : TElClientServerIndySSLIOHandlerSocket;
begin
  IOHandler := TElClientServerIndySSLIOHandlerSocket.Create(nil);
  IOHandler.OnCertificateValidate := FOnCertificateValidate;
  IOHandler.OnCertificateNeeded := FOnCertificateNeeded;
  IOHandler.OnCertificateNeededEx := FOnCertificateNeededEx;
  CopySSLParams(IOHandler);
  IOHandler.IsPeer := true;
  Result := IOHandler;
end;

procedure TElIndySSLServerIOHandler.SetCompressionAlgorithms(Index:
    TSBSSLCompressionAlgorithm; Value: boolean);
begin
  FCompressionAlgorithms[Index] := Value;
end;

procedure TElIndySSLServerIOHandler.SetScheduler(AScheduler:TIdScheduler); 
begin
  inherited SetScheduler(AScheduler);
end;

function TElClientServerIndySSLIOHandlerSocket.GetCompressionAlgorithm:
    TSBSSLCompressionAlgorithm;
begin
  if FIsPeer then
    Result := FSecureServer.CompressionAlgorithm
  else
    Result := FSecureClient.CompressionAlgorithm;
end;

procedure TElClientServerIndySSLIOHandlerSocket.SetCompressionAlgorithms(Index:
    TSBSSLCompressionAlgorithm; Value: boolean);
begin
  inherited SetCompressionAlgorithms(Index, Value);
  FSecureServer.CompressionAlgorithms[Index] := Value;
end;

procedure TElClientServerIndySSLIOHandlerSocket.SetOnCiphersNegotiated(
  Value: TNotifyEvent);
begin
  inherited;
  FSecureServer.OnCiphersNegotiated := Value;
end;

procedure TElClientServerIndySSLIOHandlerSocket.SetOnError(
  Value: TSBErrorEvent);
begin
  inherited;
  FSecureServer.OnError := Value;
end;

initialization
  RegisterSSL('SecureBlackbox', 'EldoS Corp.', '(c) 2002-2007 EldoS Corporation',
    'EldoS SecureBlackbox - your way to secure Internet connections',
    'http://www.secureblackbox.com', TElClientServerIndySSLIOHandlerSocket,
    TElIndySSLServerIOHandler);

end.