Утечка памяти при использовании TIdHTTP и TIdSSLIOHandlerSocketOpenSSL - PullRequest
Новая
       22

Утечка памяти при использовании TIdHTTP и TIdSSLIOHandlerSocketOpenSSL

0 голосов
/ 11 июня 2018

У меня есть следующий класс 

type
  TMyDownload = class
  private
    FHttp: TIdHttp;
    function VerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
  public
    constructor Create(const ARootCertFile: string);
    destructor Destroy; override;
    function Get(const URL: string; Stream: TStream): Integer;
  end;

constructor TMyDownload.Create(const ARootCertFile: string);
begin
  inherited Create;

  FHttp := TIdHTTP.Create;
  FHttp.Compressor := TIdCompressorZLib.Create(FHttp);
  FHttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(FHttp);
  FHttp.HandleRedirects := True;
  FHttp.ProtocolVersion := pv1_1;
  FHttp.ConnectTimeout := 10000;
  FHttp.ReadTimeout := 10000;
  FHttp.AllowCookies := True;

  with TIdSSLIOHandlerSocketOpenSSL(FHttp.IOHandler) do
  begin
    OnVerifyPeer := VerifyPeer;
    SSLOptions.Mode := sslmClient;
    SSLOptions.Method := sslvTLSv1_2;
    SSLOptions.RootCertFile := ARootCertFile;
    SSLOptions.SSLVersions := [sslvTLSv1_2];
    SSLOptions.VerifyMode := [sslvrfPeer, sslvrfFailIfNoPeerCert, sslvrfClientOnce];
    SSLOptions.VerifyDepth := 5;
  end;
end;

destructor TMyDownload.Destroy;
begin
  FreeAndNil(FHttp);
  inherited;
end;

function TMyDownload.Get(const URL: string; Stream: TStream): Integer;
begin
  try
    FHttp.Get(URL, Stream, [304]);
    Exit(FHttp.ResponseCode);
  except
    LogException(ClassName, False, True);
    Result := 500;
  end;
end;

function TMyDownload.VerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
var
  CurrentTime: TDateTime;
begin
  if (ADepth = 0) then
  begin
    if AOk and (AError = 0) then
    begin
      CurrentTime := Now;
      Result := (Pos('/CN=' + UpperCase(FHttp.URL.Host) + '/', '/' + UpperCase(Certificate.Subject.OneLine) + '/') <> 0)
                and (CurrentTime >= Certificate.notBefore)
                and (CurrentTime <= Certificate.notAfter);
    end
    else
      Result := False;
  end
  else
    Result := AOk and (AError = 0);
end;

, который многократно используется (каждую минуту) следующим образом: 

// cacert.pem obtained from https://curl.haxx.se/docs/caextract.html
MyDownload := TMyDownload.Create('cacert.pem');
try
  Stream := TMemoryStream.Create;
  try
    MyDownload.Get('https://www.google.com/', Stream);
  finally
    Stream.Free;
  end;
finally
  MyDownload.Free;
end;

Приведенный выше код составляет всю программу.Если он работает от 3 до 5 дней, программе не хватает памяти (на Win32 потребляет 2 + ГБ).Если я отключу 

SSLOptions.RootCertFile := ARootCertFile;

Программа будет работать нормально, но с недостатком необходимости принимать незащищенные цепные сертификаты.

Есть ли что-то, чего мне не хватает, может кто-нибудь указать мне направильное направление

...