sbserverindyintercept.pas

著名的SecureBlackBox控件完整源码

begin
  FEnabledCipherSuites[Index] := Value;
end;

procedure TElIndyServerSSLIntercept.SetVersions(Value: TSBVersions);
begin
  FEnabledVersions := Value;
end;

procedure TElIndyServerSSLIntercept.HandleCertificateValidate(Sender: TObject;
  X509Certificate: TElX509Certificate; Intercept:
    TElIndyConnectionSSLServerIntercept;
  var Validate: boolean);
begin
  DoCertificateValidate(X509Certificate, Intercept, Validate);
end;

procedure TElIndyServerSSLIntercept.DoCertificateValidate(X509Certificate:
  TElX509Certificate;
  Intercept: TElIndyConnectionSSLServerIntercept; var Validate: boolean);
begin
  if Assigned(FOnCertificateValidate) then
    FOnCertificateValidate(Self, X509Certificate, Intercept, Validate);
end;

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

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

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

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

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

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

procedure TElIndyServerSSLIntercept.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if Operation = opRemove then
  begin
    if (AComponent = FCertStorage) then
      SetCertStorage(nil)
    else
      if (AComponent = FSessionPool) then
      SetSessionPool(nil)
    else
      if (AComponent = FClientCertStorage) then
      SetClientCertStorage(nil);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// TElIndyConnectionSSLServerIntercept

constructor TElIndyConnectionSSLServerIntercept.Create(AOwner: TComponent);
begin
  inherited;
  FSecureServer := TElSecureServer.Create(Self);
end;

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

procedure TElIndyConnectionSSLServerIntercept.Disconnect;
var
  A: boolean;
begin
  a := FSecureServer.Enabled;
  FSecureServer.Enabled := false;
  FSecureServer.Close;
  FSecureServer.Enabled := a;
  inherited;
end;

procedure TElIndyConnectionSSLServerIntercept.DoActualSend(Buffer: pointer;
  Size: integer);
var
  Sent, JustSent: integer;
begin
  Sent := 0;
  if FBinding = nil then
  begin
    Exit;
  end;
  while (Sent < Size) and (not FErrorOccured) do
  begin
    JustSent := FBinding.Send(PByteArray(Buffer)[Sent], Size - Sent, 0);
    TIdAntiFreezeBase.DoProcess(False);
    if JustSent <= 0 then
    begin
      if FBinding.HandleAllocated then
      begin
        FBinding.CloseSocket;
        raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
      end;
      if GStack.CheckForSocketError(JustSent, [ID_WSAESHUTDOWN]) then
      begin
        if FBinding.HandleAllocated then
          FBinding.CloseSocket;
        GStack.RaiseSocketError(ID_WSAESHUTDOWN);
      end;
    end;
    Inc(Sent, JustSent);
  end;
end;

procedure TElIndyConnectionSSLServerIntercept.HandleSend(Sender: TObject;
  Buffer: pointer; Size: longint);
begin
  DoActualSend(Buffer, Size);
end;

procedure TElIndyConnectionSSLServerIntercept.HandleReceive(Sender: TObject;
  Buffer: pointer; MaxSize: longint; {$ifndef BUIlDER_USED}out{$else}var{$endif} Written: longint);
begin
  Written := FBinding.Recv(Buffer^, MaxSize, 0);
  if Written <= 0 then
  begin
    FErrorOccured := true;
    Written := 0;
  end;
//  if (Written <= 0) and FBinding.HandleAllocated then
//    FDataReceived := True;
end;

procedure TElIndyConnectionSSLServerIntercept.HandleData(Sender: TObject;
  Buffer: pointer; Size: longint);
begin
  if Size <= FRecvMaxSize then
  begin
    Move(Buffer^, FRecvBuffer^, Size);
    FRecvWritten := Size;
  end
  else
  begin
    Move(Buffer^, FRecvBuffer^, FRecvMaxSize);
    FRecvWritten := FRecvMaxSize;
    SetLength(FBuffer, Size - FRecvMaxSize);
    Move(PByteArray(Buffer)[FRecvMaxSize], FBuffer[1], Size - FRecvMaxSize);
  end;
  FDataReceived := True;
end;

procedure TElIndyConnectionSSLServerIntercept.HandleOpenConnection(Sender:
  TObject);
begin
  FConnected := true;
end;

procedure TElIndyConnectionSSLServerIntercept.HandleCloseConnection(Sender:
  TObject;
  CloseDescription: integer);
begin
  if CloseDescription = cdCLOSED_BY_ERROR then
  begin
    raise
      EIdConnClosedGracefully.Create('Error while receiving. Connection closed.');
    Disconnect;
  end;
  FConnected := false;
  FErrorOccured := true;
end;

procedure TElIndyConnectionSSLServerIntercept.HandleCertificateValidate(Sender:
  TObject;
  X509Certificate: TElX509Certificate; var Validate: boolean);
begin
  DoCertificateValidate(X509Certificate, Validate);
end;

procedure TElIndyConnectionSSLServerIntercept.StartServer;
begin
  FSecureServer.OnSend := HandleSend;
  FSecureServer.OnReceive := HandleReceive;
  FSecureServer.OnData := HandleData;
  FSecureServer.OnOpenConnection := HandleOpenConnection;
  FSecureServer.OnCloseConnection := HandleCloseConnection;
  FSecureServer.OnCertificateValidate := HandleCertificateValidate;
  FConnected := false;
  FErrorOccured := false;
  FSecureServer.Open;
  while (not FConnected) and (not FErrorOccured) do
    FSecureServer.DataAvailable;
end;

function TElIndyConnectionSSLServerIntercept.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 TElIndyConnectionSSLServerIntercept.Send(var ABuf; ALen: integer):
  integer;
begin
  if (FSecureServer <> nil) and FSecureServer.Active then
  begin
    FSecureServer.SendData(@ABuf, ALen);
    Result := ALen;
  end
  else
    Result := 0;
end;

function TElIndyConnectionSSLServerIntercept.GetCipherSuite(Index:
  TSBCipherSuite): boolean;
begin
  Result := FSecureServer.CipherSuites[Index];
end;

procedure TElIndyConnectionSSLServerIntercept.SetCipherSuite(Index:
  TSBCipherSuite; Value: boolean);
begin
  FSecureServer.CipherSuites[Index] := Value;
end;

function TElIndyConnectionSSLServerIntercept.GetCurrentCipherSuite:
  TSBCipherSuite;
begin
  Result := FSecureServer.CipherSuite;
end;

function TElIndyConnectionSSLServerIntercept.GetVersions: TSBVersions;
begin
  Result := FSecureServer.Versions;
end;

function TElIndyConnectionSSLServerIntercept.GetVersion: TSBVersion;
begin
  Result := FSecureServer.CurrentVersion;
end;

procedure TElIndyConnectionSSLServerIntercept.SetVersions(Value: TSBVersions);
begin
  FSecureServer.Versions := Value;
end;

function TElIndyConnectionSSLServerIntercept.GetCertStorage:
  TElMemoryCertStorage;
begin
  Result := FSecureServer.CertStorage;
end;

function TElIndyConnectionSSLServerIntercept.GetClientCertStorage:
  TElCustomCertStorage;
begin
  Result := FSecureServer.ClientCertStorage;
end;

function TElIndyConnectionSSLServerIntercept.GetSessionPool: TElSessionPool;
begin
  Result := FSecureServer.SessionPool;
end;

procedure TElIndyConnectionSSLServerIntercept.SetCertStorage(Value:
  TElMemoryCertStorage);
begin
  FSecureServer.CertStorage := Value;
end;

procedure TElIndyConnectionSSLServerIntercept.SetClientCertStorage(Value:
  TElCustomCertStorage);
begin
  FSecureServer.ClientCertStorage := Value;
end;

procedure TElIndyConnectionSSLServerIntercept.SetSessionPool(Value:
  TElSessionPool);
begin
  FSecureServer.SessionPool := Value;
end;

function TElIndyConnectionSSLServerIntercept.GetClientAuthentication: boolean;
begin
  Result := FSecureServer.ClientAuthentication;
end;

procedure TElIndyConnectionSSLServerIntercept.SetClientAuthentication(Value:
  boolean);
begin
  FSecureServer.ClientAuthentication := Value;
end;

procedure
  TElIndyConnectionSSLServerIntercept.DoCertificateValidate(X509Certificate:
  TElX509Certificate;
  var Validate: boolean);
begin
  if Assigned(FOnCertificateValidate) then
    FOnCertificateValidate(Self, X509Certificate, Self, Validate);
end;

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

end.