Berlin HTTPClient: сломаны Cookies - ошибка в исходном коде

[Евгений Корепов]

Начал переносить проекты из XE8 в Berlin, столкнулся с странным затыком в простеньком коде - делаем запрос на сайт, получаем куки, делаем post авторизацию, получаем редирект, если все хорошо, то октрываем страницу из header Location. Выяснилось что не смотря на HTTPClient.AllowCookies:=True, в HTTPResponse.Cookies всегда пустота. Пришлось копать исходники. Вот что обнаружилось в source\rtl\net\System.Net.HttpClient.pas:

procedure THTTPClient.ExecuteHTTPInternal(const ARequest: IHTTPRequest; const AContentStream: TStream; const AResponse: IHTTPResponse);
var
  LRequest: THTTPRequest;
  LResponse: THTTPResponse;
  State: THTTPState;
  LExecResult: TExecutionResult;
  LClientCertificateList: TCertificateList;
  OrigSourceStreamPosition: Int64;
  OrigContentStreamPosition: Int64;
  OrigContentStreamSize: Int64;
  Status: Integer;
  LCookieHeader: string;
begin
  LResponse := AResponse as THTTPResponse;
  LRequest := ARequest as THTTPRequest;
  OrigSourceStreamPosition := 0;
  if LRequest.FSourceStream <> nil then
    OrigSourceStreamPosition := LRequest.FSourceStream.Position;

  if AContentStream <> nil then
  begin
    OrigContentStreamPosition := AContentStream.Position;
    OrigContentStreamSize := AContentStream.Size;
  end
  else
  begin
    OrigContentStreamPosition := 0;
    OrigContentStreamSize := 0;
  end;

  State := Default(THTTPState);
  LClientCertificateList := TCertificateList.Create;
  try
    while True do
    begin
      LRequest.DoPrepare;

      // Add Cookies
      if FCookieManager <> nil then
      begin
        LCookieHeader := FCookieManager.CookieHeaders(LRequest.FURL);
        if LCookieHeader <> '' then
          LRequest.AddHeader('Cookie', LCookieHeader);  // do not localize
      end;

      if not SetServerCredential(LRequest, LResponse, State) then
        Break;
      if not SetProxyCredential(LRequest, LResponse, State) then
        Break;

      if LRequest.FSourceStream <> nil then
        LRequest.FSourceStream.Position := OrigSourceStreamPosition;

      if LResponse <> nil then
      begin
        LResponse.FStream.Position := OrigContentStreamPosition;
        LResponse.FStream.Size := OrigContentStreamSize;
      end;

      LExecResult := DoExecuteRequest(LRequest, LResponse, AContentStream);
      case LExecResult of
        TExecutionResult.Success:
          begin
            if not SameText(LRequest.FMethodString, sHTTPMethodHead) then
              LResponse.DoReadData(LResponse.FStream);
            Status := LResponse.GetStatusCode;
            case Status of
              200:
                begin
                  Break;  // Если запрос удачен, то выходим из цикла
                end;
              401:
                begin
                  State.Status := InternalState.ServerAuthRequired;
                end;
              407:
                begin
                  State.Status := InternalState.ProxyAuthRequired;
                end;
              else
                begin
                  case Status of
                    301..304, 307:
                      if FHandleRedirects and (LRequest.FMethodString <> sHTTPMethodHead) then
                      begin
                        Inc(State.Redirections);
                        if State.Redirections > FMaxRedirects then
                          raise ENetHTTPRequestException.CreateResFmt(@SNetHttpMaxRedirections, [FMaxRedirects]);
                      end
                      else
                        Break;
                  else
                  end;
                  State.Status := InternalState.Other;
                  if DoProcessStatus(LRequest, LResponse) then
                    Break;
                end;
            end;
          end;
        TExecutionResult.ServerCertificateInvalid:
          begin
            DoValidateServerCertificate(LRequest);
          end;
        TExecutionResult.ClientCertificateNeeded:
          begin
            DoNeedClientCertificate(LRequest, LClientCertificateList);
          end
        else
          raise ENetHTTPClientException.CreateRes(@SNetHttpClientUnknownError);
      end;

      if AllowCookies then  
        UpdateCookiesFromResponse(LResponse); // Вот эта, критически важная процедура, при Status=200 никогда не выполняется
    end;
 // После выхода из цикла попадаем сюда
    if LRequest.FSourceStream <> nil then
      LRequest.FSourceStream.Seek(0, TSeekOrigin.soEnd);
    LResponse.FStream.Position := OrigContentStreamPosition;
  finally
    LClientCertificateList.Free;
  end;
end;

Т.е. разработчики исключили выполнение UpdateCookiesFromResponse(LResponse), которая помещает куки из ответа в HTTPClient.

А вот код из XE8 который нормально работает с Cookies:

function THTTPClient.ExecuteHTTPInternal(const ARequest: IHTTPRequest; const AContentStream: TStream): IHTTPResponse;
var
  LRequest: THTTPRequest;
  LResponse: THTTPResponse;
  State: THTTPState;
  LExecResult: TExecutionResult;
  LClientCertificateList: TCertificateList;
  OrigSourceStreamPosition: Int64;
  OrigContentStreamPosition: Int64;
  OrigContentStreamSize: Int64;
  Status: Integer;
  LCookieHeader: string;
begin
  Result := nil;
  LResponse := nil;
  LRequest := ARequest as THTTPRequest;
  OrigSourceStreamPosition := 0;
  if LRequest.FSourceStream <> nil then
    OrigSourceStreamPosition := LRequest.FSourceStream.Position;

  if AContentStream <> nil then
  begin
    OrigContentStreamPosition := AContentStream.Position;
    OrigContentStreamSize := AContentStream.Size;
  end
  else
  begin
    OrigContentStreamPosition := 0;
    OrigContentStreamSize := 0;
  end;

  State := Default(THTTPState);
  LClientCertificateList := TCertificateList.Create;
  try
    while True do
    begin
      LRequest.DoPrepare;

      // Add Cookies
      if FCookieManager <> nil then
      begin
        LCookieHeader := FCookieManager.CookieHeaders(LRequest.FURL);
        if LCookieHeader <> '' then
          LRequest.AddHeader('Cookie', LCookieHeader);  // do not localize
      end;

      if not SetServerCredential(LRequest, LResponse, State) then
        Break;
      if not SetProxyCredential(LRequest, LResponse, State) then
        Break;

      if LRequest.FSourceStream <> nil then
        LRequest.FSourceStream.Position := OrigSourceStreamPosition;

      if LResponse <> nil then
      begin
        LResponse.FStream.Position := OrigContentStreamPosition;
        LResponse.FStream.Size := OrigContentStreamSize;
      end;

      LExecResult := DoExecuteRequest(LRequest, LResponse, AContentStream);
      case LExecResult of
        TExecutionResult.Success:
          begin
            if not SameText(LRequest.FMethodString, sHTTPMethodHead) then
              LResponse.DoReadData(LResponse.FStream);
            Status := LResponse.GetStatusCode;
            case Status of
              200:
                begin
                  Break;
                end;
              401:
                begin
                  State.Status := InternalState.ServerAuthRequired;
                end;
              407:
                begin
                  State.Status := InternalState.ProxyAuthRequired;
                end;
              else
                begin
                  case Status of
                    301..304, 307:
                      if FHandleRedirects and (LRequest.FMethodString <> sHTTPMethodHead) then
                      begin
                        Inc(State.Redirections);
                        if State.Redirections > FMaxRedirects then
                          raise ENetHTTPRequestException.CreateResFmt(@SNetHttpMaxRedirections, [FMaxRedirects]);
                      end
                      else
                        Break;
                  else
                  end;
                  State.Status := InternalState.Other;
                  if DoProcessStatus(LRequest, LResponse) then
                    Break;
                end;
            end;
          end;
        TExecutionResult.ServerCertificateInvalid:
          begin
            DoValidateServerCertificate(LRequest);
          end;
        TExecutionResult.ClientCertificateNeeded:
          begin
            DoNeedClientCertificate(LRequest, LClientCertificateList);
          end
        else
          raise ENetHTTPClientException.CreateRes(@SNetHttpClientUnknownError);
      end;

    end;
    if LRequest.FSourceStream <> nil then
      LRequest.FSourceStream.Seek(0, TSeekOrigin.soEnd);
    if AllowCookies then
      UpdateCookiesFromResponse(LResponse);  // Здесь все верно, процедура за пределами цикла и выполняется всегда когда нужно.
  finally
    LClientCertificateList.Free;
    Result := IHTTPResponse(LResponse);
  end;
end;

А теперь вопрос: ну как так то? В продукте за 54 тысячи рублей сильно обидно исправлять такие косяки. Такое ощущение что разраб подрабатывал на стороне в проектах на php и забыл переключится на другой язык, там break прерывает работу аналога case и код работал бы правильно.

 

[Евгений Корепов]

Оказывается эта проблема была обнаружена еще  26/Apr/16 12:29 AM  https://quality.embarcadero.com/browse/RSP-14307 . И пока доступен только патч с хелперами https://quality.embarcadero.com/secure/attachment/17147/RSP14307.patch.zip

Написана что проблема решена в Berlin Update 1. Но как понимаю этого апдейта еще не было?

[Евгений Корепов]

Проверил патч - не помогает, проще в исходниках поправить строчку

[GoldenEalge]

в 10.2.2 поправили , но появилась или была проблема с перезаписью кук

одни куки по несколько раз

[Евгений Корепов]

13 часа назад, GoldenEalge сказал:

одни куки по несколько раз

Вот блин. А можно кусок кода при котором проблема воспроизводится? При повторном запросе к сайту или как? А то сейчас как раз буду писать кусок модуль и использованием куки для текущего проекта...

[GoldenEalge]

2 часа назад, Евгений Корепов сказал:

Вот блин. А можно кусок кода при котором проблема воспроизводится? При повторном запросе к сайту или как? А то сейчас как раз буду писать кусок модуль и использованием куки для текущего проекта...

да вроде не чего не обычного на форме создал thttpclient , tcookiemanager.

на кнопках были запросы на 1 гет ,на 2 пост.

пример уже удалил , делал для теста клиента , тесты он не прошел.

запросы были к инстаграм.