?? sbindyserveriohandler10.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -