* Manually apply merge request !570

packages/fcl-web/src/base/fphttpclient.pp

@@ -92,6 +92,7 @@ Type
     FConnectTimeout: Integer;
     FSentCookies,
     FCookies: TStrings;
+    FCookieList: TCookies;
     FHTTPVersion: String;
     FRequestBody: TStream;
     FRequestHeaders: TStrings;
@@ -113,10 +114,12 @@ Type
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
     function GetCookies: TStrings;
+    function GetCookieList: TCookies;
     function GetProxy: TProxyData;
     Procedure ResetResponse;
     procedure SetConnectTimeout(AValue: Integer);
     Procedure SetCookies(const AValue: TStrings);
+    Procedure SetCookieList(const AValue: TCookies);
     procedure SetHTTPVersion(const AValue: String);
     procedure SetKeepConnection(AValue: Boolean);
     procedure SetProxy(AValue: TProxyData);
@@ -323,7 +326,9 @@ Type
     Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders;
     // Cookies. Set before request to send cookies to server.
     // After request the property is filled with the cookies sent by the server.
-    Property Cookies : TStrings Read GetCookies Write SetCookies;
+    Property CookieList : TCookies Read GetCookieList Write SetCookieList;
+    // the implementation was buggy, use CookieList above instead
+    Property Cookies : TStrings Read GetCookies Write SetCookies; deprecated 'use CookieList';
     // Optional body to send (mainly in POST request)
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
     // used HTTP version when constructing the request.
@@ -848,9 +853,9 @@ begin
       If (I>0) then
         L:=L+'; ';
       L:=L+FCookies[i];
+      if AllowHeader(L) then
+        S:=S+L+CRLF;
       end;
-    if AllowHeader(L) then
-      S:=S+L+CRLF;
     end;
   FreeAndNil(FSentCookies);
   FSentCookies:=FCookies;
@@ -1078,7 +1083,10 @@ begin
       begin
       ResponseHeaders.Add(S);
       If StartsText(SetCookie,S) then
+        begin
         DoCookies(S);
+        CookieList.AddFromString(S);
+        end;
       end
   Until (S='') or Terminated;
 end;
@@ -1170,6 +1178,13 @@ begin
   Result:=FCookies;
 end;
 
+function TFPCustomHTTPClient.GetCookieList: TCookies;
+begin
+  If (FCookieList=Nil) then
+    FCookieList:=TCookies.Create(TCookie);
+  Result:=FCookieList;
+end;
+
 function TFPCustomHTTPClient.GetProxy: TProxyData;
 begin
   If not Assigned(FProxy) then
@@ -1186,6 +1201,12 @@ begin
   GetCookies.Assign(AValue);
 end;
 
+procedure TFPCustomHTTPClient.SetCookieList(const AValue: TCookies);
+begin
+  if GetCookieList=AValue then exit;
+  GetCookieList.Assign(AValue);
+end;
+
 procedure TFPCustomHTTPClient.SetHTTPVersion(const AValue: String);
 begin
   if FHTTPVersion = AValue then Exit;

packages/fcl-web/src/base/httpdefs.pp

@@ -199,6 +199,7 @@ type
     procedure SetCookie(Index: Integer; Value: TCookie);
   public
     function  Add: TCookie;
+    function AddFromString(S: String): TCookie;
     Function CookieByName(const AName : String) : TCookie;
     Function FindCookie(const AName : String): TCookie;
     Function IndexOfCookie(const AName : String) : Integer;
@@ -3207,6 +3208,69 @@ begin
   Result:=TCookie(Inherited Add);
 end;
 
+function TCookies.AddFromString(S: String): TCookie;
+var
+  P, Q: Integer;
+  CookieLine, AttributeLine, AttributeName, AttributeValue: String;
+  C: TCookie;
+begin
+  Result := Add;
+
+  // Remove 'Set-Cookie:'
+  P := Pos(':',S);
+  System.Delete(S, 1, P);
+
+  // Get cookie name by getting either the position of attribute start/separator (;) or the end of string
+  P := Pos(';',S);
+  if P = 0 then
+    P := Length(S) + 1;
+  CookieLine := Trim(Copy(S, 1, P - 1));
+  System.Delete(S, 1, P);
+
+  // Split the cookie name and value
+  Q := Pos('=', CookieLine);
+  if Q = 0 then
+    Q := Length(CookieLine) + 1;
+  Result.Name := Trim(Copy(CookieLine, 1, Q - 1));
+  if Q > 0 then
+    Result.Value := Trim(Copy(CookieLine, Q + 1, Length(CookieLine) - Q));
+
+  // Get cookie attributes, if any
+  while P > 0 do begin
+    Q := Pos(';',S);
+    if Q = 0 then begin
+      P := 0;
+      Q := Length(S) + 1;
+    end;
+    AttributeLine := Trim(Copy(S, 1, Q - 1));
+    System.Delete(S, 1, Q);
+
+    // Split the attribute name and value, assign to each corresponding field
+    Q := Pos('=', AttributeLine);
+    if Q = 0 then
+      Q := Length(AttributeLine) + 1;
+    AttributeName := LowerCase(Trim(Copy(AttributeLine, 1, Q - 1)));
+    AttributeValue := '';
+    if Q > 0 then
+      AttributeValue := Trim(Copy(AttributeLine, Q + 1, Length(AttributeLine) - Q));
+
+    case AttributeName of
+      'domain'  : Result.Domain   := AttributeValue;
+      'path'    : Result.Path     := AttributeValue;
+      // I'm not sure with these 3 below
+      'expires' : Result.Expires  := StrToDateTime(AttributeValue);
+      'secure'  : Result.Secure   := StrToBoolDef(AttributeValue, true);
+      'httponly': Result.HttpOnly := StrToBoolDef(AttributeValue, true);
+      'samesite': case LowerCase(AttributeValue) of
+        ''      : Result.SameSite := ssEmpty;
+        'none'  : Result.SameSite := ssNone;
+        'strict': Result.SameSite := ssStrict;
+        'lax'   : Result.SameSite := ssLax;
+      end;
+    end;
+  end;
+end;
+
 function TCookies.CookieByName(const AName: String): TCookie;
 begin
   Result:=FindCookie(AName);

packages/fcl-web/tests/tccookies.pp

@@ -0,0 +1,133 @@
+unit tccookies;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry,
+  httpdefs;
+
+type
+
+  TTestTCookies = class(TTestCase)
+  published
+    procedure TestParseWriteRead;
+  end;
+
+
+implementation
+
+procedure TTestTCookies.TestParseWriteRead;
+const
+  Cookies: array of String = (
+    'Set-Cookie: cookie1',
+    'Set-Cookie: cookie2;',
+    'Set-Cookie: cookie3=1507337',
+    'Set-Cookie: cookie4=1507337;',
+    'Set-Cookie: cookie5=1507337; path',
+    'Set-Cookie: cookie6=1507337; path=',
+    'Set-Cookie: cookie7=1507337; path=/',
+    'Set-Cookie: cookie8=1507337; secure',
+    'Set-Cookie: cookie9=1507337; secure=',
+    'Set-Cookie: cookie10=1507337; secure=false',
+    'Set-Cookie: cookie11=1507337; secure; httponly',
+    'Set-Cookie: cookie12=1507337; SameSite=None',
+    'Set-Cookie: cookie13=1507337; SameSite=none',
+    'Set-Cookie: cookie14=1507337; path=/; secure; httponly; SameSite=None'
+  );
+var
+  Cookie: String;
+  C: TCookie;
+begin
+  with TCookies.Create(TCookie) do
+    try
+      for Cookie in Cookies do
+        AddFromString(Cookie);
+
+      AssertEquals(Count, Length(Cookies));
+
+      C := FindCookie('cookie0');
+      AssertNull(C);
+
+      C := FindCookie('cookie1');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '');
+
+      C := FindCookie('cookie2');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '');
+
+      C := FindCookie('cookie3');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+
+      C := FindCookie('cookie4');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+
+      C := FindCookie('cookie5');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertEquals(C.Path, '');
+
+      C := FindCookie('cookie6');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertEquals(C.Path, '');
+
+      C := FindCookie('cookie7');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertEquals(C.Path, '/');
+
+      C := FindCookie('cookie8');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertTrue(C.Secure);
+
+      C := FindCookie('cookie9');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertTrue(C.Secure);
+
+      C := FindCookie('cookie10');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertFalse(C.Secure);
+
+      C := FindCookie('cookie11');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertTrue(C.Secure);
+      AssertTrue(C.HttpOnly);
+
+      C := FindCookie('cookie12');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertTrue(C.SameSite = ssNone);
+
+      C := FindCookie('cookie13');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertTrue(C.SameSite = ssNone);
+
+      C := FindCookie('cookie14');
+      AssertNotNull(C);
+      AssertEquals(C.Value, '1507337');
+      AssertEquals(C.Path, '/');
+      AssertTrue(C.Secure);
+      AssertTrue(C.HttpOnly);
+      AssertTrue(C.SameSite = ssNone);
+    finally
+      Free;
+    end;
+end;
+
+
+
+initialization
+
+  RegisterTest(TTestTCookies);
+end.
+

packages/fcl-web/tests/testfpweb.lpr

@@ -3,7 +3,7 @@ program testfpweb;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tchttproute, tcjwt, jsonparser,
+  Classes, consoletestrunner, tchttproute, tcjwt,  tccookies, jsonparser,
   fpjwasha256, fpjwasha512, fpjwasha384, fpjwaes256, fpjwarsa, testsqldbopenapi, sqldbrestopenapi;
 
 type