• 0
Евгений Корепов

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 и код работал бы правильно.

 

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

5 ответов на этот вопрос

  • 0

Оказывается эта проблема была обнаружена еще  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. Но как понимаю этого апдейта еще не было?

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0

5a52782a90878_1.PNG.b98816ae45c988ba5a15fd4b6300f686.PNG

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

5a527855c1c47_.PNG.ee9264d60e973f76ccea374942bee22c.PNG

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0
13 часа назад, GoldenEalge сказал:

5a527855c1c47_.PNG.ee9264d60e973f76ccea374942bee22c.PNG

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

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0
2 часа назад, Евгений Корепов сказал:

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

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

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

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

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

Для публикации сообщений создайте учётную запись или авторизуйтесь

Вы должны быть пользователем, чтобы оставить комментарий

Создать учетную запись

Зарегистрируйте новую учётную запись в нашем сообществе. Это очень просто!

Регистрация нового пользователя

Войти

Уже есть аккаунт? Войти в систему.

Войти


  • Похожий контент

    • От kiz35196
      перевожу проект с инди на System.Net.HttpClient, никак не могу заставить его скачать файл,с инди всё как-то проще было
      подскажите пожалуйста
    • От GoldenEalge
      Подскажите как сохранить ,а потом загрузить куки в THTTPClient , как понимаю нужно работать с TCookieManager
      Сохранять пытаюсь так :
      cookies := aResponse.cookies.AsJSON(false); В cookies получаю 
      {\"Capacity\":4,\"Count\":3,\"List\":[{\"Name\":\"csrftoken\",\"Value\":\"Jljq2Sx5n9lXek4u4rri9L1zGBIExSzT\",\"Expires\":\"2019-01-06T18:41:36.854\",\"Domain\":\".i.instagram.com\",\"Path\":\"/\",\"Secure\":true,\"HttpOnly\":false},{\"Name\":\"rur\",\"Value\":\"PRN\",\"Expires\":\"1899-12-30T00:00:00.000\",\"Domain\":\".i.instagram.com\",\"Path\":\"/\",\"Secure\":false,\"HttpOnly\":false},{\"Name\":\"mid\",\"Value\":\"WlIjkQABAAF-JTqtAx_AdVdFxepj\",\"Expires\":\"2038-01-02T18:41:36.854\",\"Domain\":\".i.instagram.com\",\"Path\":\"/\",\"Secure\":false,\"HttpOnly\":false},{\"Name\":\"\",\"Value\":\"\",\"Expires\":\"1899-12-30T00:00:00.000\",\"Domain\":\"\",\"Path\":\"\",\"Secure\":false,\"HttpOnly\":false}],\"OnNotify\":null} Но как потом загрузить это обратно?
       
    • От Alex7wrt
      Добрый день
      В мобильном приложении используется следующая функция для чтения содержимого https страницы
      function geturlstring(url: string): string; var HTTP: THTTPClient; stream: tstringstream; begin try HTTP:=THTTPClient.Create; Stream:= TStringStream.Create('',TEncoding.UTF7); HTTP.Get(url, stream); Stream.Position:=0; Result:=stream.DataString; HTTP.Free; Stream.Free; except result:='error'; end; end; Почему-то в некоторых случаях, при подключении через WiFi, функция выдает 'error'. Хотя при проверке сам сайт с этим url открывается. Это вообще ссылка на гугловский сервис. Ошибку замечал например в WiFi сети метрополитена. Там подключение к WiFi двухэтапное - сначала открывается сервисная веб страница, нажимаешь ОК или что-то типа того, и WiFi подключается. 
      В этом случае функция выдает ошибку, хотя браузер работает, и другие и приложения типа мессенджера и вайбера видят сеть.В мобильных сетях вроде работает нормально, там ошибок не замечал.
      В чем может быть проблема? Может ли это быть потому, что url относится к https протоколу? 
       
    • От RubenKamp
      Добрый день господа.
      Уже несколько часов не могу разобраться с медиаплеером, не могу воспроизвести mp3 файл, прошу помощи.
      В Deployment файл добавлен.
      uses System.IOUtils;
      MediaPlayer1.FileName := TPath.Combine(TPath.GetDocumentsPath, 'Correct.mp3');
      MediaPlayer1.Play;
      Ошибка: Не поддерживаемый медиа файл.
      Делал так MediaPlayer1.FileName:=System.IOUtils.TPath.Combine(System.IOUtils.TPath.GetDocumentsPath(),'Correct.mp3'); и та же ошибка.
      А так работает: MediaPlayer1.FileName := 'D:\PRG\app\Slide #11\Sound\Correct.mp3';
      Что изменилось в Berlin-е?
    • От Rustam Bikeev
      Доброго времени суток уважаемые форумчане, назрел вопрос по компоненту ThttpClient. Я сам слеп в области Http что такое Post, Get  и прочие аббревиатуры для меня страшные и дикие звери которых никогда не видел. Потому и приходится спрашивать у вас. Как отправить на веб сервер запрос для получения текстового файла или картинки. Куда и как принять этот файл. Я нечерта не пойму если вы напишите сделай это сделай то, прошу вас опишите как пользоваться этими 3 функциями 
      THTTPClient.GetRequest
      THTTPClient.Post
      THTTPClient.Get
       
    • От Евгений Корепов
      Господа и товарищи, помогите тупому мне! Столкнулся с странным. Под windows все отлично работает, а под android не могу добиться загрузки картинок. Мозг уже сломал.
      Собрал тестовый проект - в ListView (DynamicAppearance) добавляем 4 ListViewItem, в ListViewUpdatingObjects все создаем и грузим картинки из инета (потоки и прочее убрал для упрощения). Картанка слева, текст (URL) справа, проще некуда. Прилагаю к сообщению архив проекта и код.
      unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.ListView, System.Net.HTTPClient, FMX.Objects; type TFormMain = class(TForm) ListView: TListView; procedure ListViewUpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } ListViewUpdate : Boolean; procedure MyListViewUpdateObjects(const AListView: TListView; const AItem: TListViewItem); procedure InitListView(AListView : TListView); function LoadImageFromURL(AURL : String) : TBitmap; end; var FormMain: TFormMain; implementation {$R *.fmx} procedure TFormMain.FormCreate(Sender: TObject); begin ListViewUpdate:=False; end; procedure TFormMain.FormShow(Sender: TObject); begin InitListView(ListView); end; procedure TFormMain.InitListView(AListView : TListView); Var AListViewItem : TListViewItem; AImageURL : String; begin AImageURL:='http://kayfolom.ru/images/test/'; ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + 'logo.png'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + '000487806d3a2ab98aeb2c47b810fc8b.jpg'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + '0012ef6cb42e95268a4cd1d832a2b93a.jpg'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + '0022454ccb4f81a701cb3a3c89d52d2f.jpg'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); end; procedure TFormMain.ListViewUpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); begin if Not ListViewUpdate then begin MyListViewUpdateObjects(Sender as TListView, AItem); AHandled:=True; end; end; procedure TFormMain.MyListViewUpdateObjects(const AListView: TListView; const AItem: TListViewItem); Var AName : TListItemText; AImage : TListItemImage; AvailableWidth, ImageWidth, ImageHeight : single; function SetupTextObject(const AName, AText : String; AFontSize : Single; AFontStyles : TFontStyles; AWidth, AHeight, X , Y : Single; AAlign, AVertAlign: TListItemAlign; ATextAlign, ATextVertAlign: TTextAlign) : TListItemText; begin Result:=TListItemText(AItem.View.FindDrawable(AName)); if Result=Nil then Result:=TListItemText.Create(AItem); Result.Name:=AName; Result.Width:=AWidth; Result.WordWrap:=True; Result.Font.Size:=AFontSize; Result.Font.Style:=Result.Font.Style + AFontStyles; Result.Trimming:=TTextTrimming.None; Result.Text:=AText; Result.PlaceOffset.X:=X; Result.PlaceOffset.Y:=Y; Result.Align:=AAlign; Result.VertAlign:=AVertAlign; Result.TextAlign:=ATextAlign; Result.TextVertAlign:=ATextVertAlign; Result.Height:=AHeight; end; function SetupImageObject(const AName : String; AWidth, AHeight, X , Y : Single; AAlign, AVertAlign: TListItemAlign) : TListItemImage; Var AImageURL : String; begin Result:=TListItemImage(AItem.View.FindDrawable(AName)); if Result=Nil then begin Result:=TListItemImage.Create(AItem); AImageURL:=AItem.Data['ImageURL'].AsString; Result.Bitmap:=LoadImageFromURL(AImageURL); end; Result.Name:=AName; Result.Width:=AWidth; Result.Height:=AHeight; Result.PlaceOffset.X:=X; Result.PlaceOffset.Y:=Y; Result.Align:=AAlign; Result.VertAlign:=AVertAlign; Result.ScalingMode:=TImageScalingMode.StretchWithAspect; end; begin AvailableWidth:=AListView.Width - AListView.ItemSpaces.Left - AListView.ItemSpaces.Right; // Изображение размещаем слева ImageWidth:=AvailableWidth / 3; ImageHeight:=AvailableWidth / 3; AImage:=SetupImageObject('Image', ImageWidth, ImageHeight, 0, 0, TListItemAlign.Leading, TListItemAlign.Leading); // Текст справа AName:=SetupTextObject('Name', AItem.Data['ImageURL'].AsString, 14, [], AvailableWidth - ImageWidth, ImageHeight, ImageWidth, 0, TListItemAlign.Leading, TListItemAlign.Leading, TTextAlign.Center, TTextAlign.Center); AItem.Height:=Round(ImageHeight + AListView.ItemSpaces.Top + AListView.ItemSpaces.Bottom); end; function TFormMain.LoadImageFromURL(AURL : String) : TBitmap; Var AHTTPClient : THTTPClient; AStream : TMemoryStream; HTTPResponse : IHTTPResponse; begin Result:=Nil; AHTTPClient:=THTTPClient.Create; AStream:=TMemoryStream.Create; try HTTPResponse:=AHTTPClient.Get(AURL, AStream); finally if HTTPResponse.StatusCode=200 then Result:=TBitmap.CreateFromStream(AStream); end; end; end.  
      test092 ListView with Image.7z
    • От rakhmet
      Оказался в крайне идиотской ситуации: единственный iPhone 5s был обновлён до 10.2. Даже не спрашивайте как - рассказать всё равно не смогу, один глаз уже и так дёргается 
       
      В общем, Xcode 8.0 не работает с iOS 10.2. Обновить старенький Xcode 8.0 я не могу, потому что с обновлённым Xcode 8.2, в свою очередь, не работает Delphi Berlin Update 2. При этом откатить iOS могу максимум до 10.1, но мне нужна минимум iOS 10.0 - просто чтобы хотя бы заткнуть Xcode 8.0 
       
      Что можно сделать?
    • От Рагим
      Доброго времени суток. Пишу мобильное приложение на Delphi Berlin. Добавил вибрацию при нажатии на кнопку. На Андроид 4.4.2 все работает нормально, на Андроид 6 при нажатии на кнопку приложение вылетает. Проблема точно в вибрации, так как при отсутствии вибрации все работает нормально. В качестве процедуры вибрации использую следующий код:
      procedure Vibr; //Процедура вибрации var   VibratorObj: JObject;   Vibrator: JVibrator; begin   VibratorObj := SharedActivity.getSystemService(TJActivity.JavaClass.VIBRATOR_SERVICE);   Vibrator := TJVibrator.Wrap((VibratorObj as ILocalObject).GetObjectID);   if Vibrator.hasVibrator() then     Vibrator.vibrate(200); end;  
      Как по Вашему, в чем может быть причина?
    • От gresaggr
      Как избежать повторных нажатий/ закликиваний на кнопку?
      Имеется следующий код:
      procedure Tfm.ButtonPrevCardClick(Sender: TObject);
      begin
        ButtonPrevCard.Enabled := false;
        Application.ProcessMessages;

       // здесь код по смене карты + пауза в 2 секунды

        ButtonPrevCard.Enabled := true;
        Application.ProcessMessages;
      end;
      Под Windows повторных нажатий/закликиваний при этом не происходит.
      А под Андроид, если пользователь быстро подряд нажал несколько раз, то сработает также несколько раз.
       
  • Последние посетители   0 пользователей онлайн

    Ни одного зарегистрированного пользователя не просматривает данную страницу