feat: capacidade de autenticação via cookie e melhoria de tratamento de cookies

Author: mobius1qwe

src/base/RALConsts.pas

@@ -13,10 +13,10 @@ interface
 
 const
   // Versionamento
-  RALVERSION = '1.0.1-2';
+  RALVERSION = '1.1.0-1';
   RALVERSION_MAJOR = 1;
-  RALVERSION_MINOR = 0;
-  RALVERSION_PATCH = 1;
+  RALVERSION_MINOR = 1;
+  RALVERSION_PATCH = 0;
   RALVERSION_FULL  = RALVERSION_MAJOR * 10000
                    + RALVERSION_MINOR * 100
                    + RALVERSION_PATCH;
@@ -74,11 +74,11 @@ interface
 
 resourcestring
   {$IF DEFINED(LANG_PTBR)}
-    {$I ..\base\ralconsts_ptbr.inc}
+    {$I ..\languages\ralconsts_ptbr.inc}
   {$ELSEIF DEFINED(LANG_ESES)}
-    {$I ..\base\ralconsts_eses.inc}
+    {$I ..\languages\ralconsts_eses.inc}
   {$ELSE}
-    {$I ..\base\ralconsts_enus.inc}
+    {$I ..\languages\ralconsts_enus.inc}
   {$IFEND}
 
 implementation

src/base/RALParams.pas

@@ -11,6 +11,20 @@ interface
   RALCripto, RALCriptoAES, RALStream, RALCompress, RALConsts;
 
 type
+  TRALCookieSiteScope = (cssLax, cssNone, cssStrict);
+
+  TRALCookie = record
+    Name: StringRAL;
+    Value: StringRAL;
+    Domain: StringRAL;
+    Path: StringRAL;
+    Expires: TDateTime;
+    MaxAge: Int64;
+    HttpOnly: Boolean;
+    SessionOnly: Boolean;
+    Secure: Boolean;
+    SameSite: TRALCookieSiteScope;
+  end;
 
   { TRALParam }
 
@@ -234,13 +248,155 @@     TEnumerator = class
       write FContentDispositionInline;
   end;
 
+function GetCookieText(ACookie: TRALCookie): StringRAL;
+function GetRALCookieFromText(ACookieString: StringRAL): TRALCookie;
+function GetRALCookieFromParam(AParamName: StringRAL; AParams: TRALParams): TRALCookie;
+
 implementation
 
 { TRALParam }
 
 uses
   RALJson;
 
+function DateTimeToCookieExpireDate(ADateTime: TDateTime): StringRAL;
+const
+  HTTPMonths: array[1..12] of string[3] = (
+    'Jan', 'Feb', 'Mar', 'Apr',
+    'May', 'Jun', 'Jul', 'Aug',
+    'Sep', 'Oct', 'Nov', 'Dec');
+  HTTPDays: array[1..7] of string[3] = (
+    'Sun', 'Mon', 'Tue', 'Wed',
+    'Thu', 'Fri', 'Sat');
+
+  DateFormat = '"%s", dd "%s" yyyy hh:nn:ss';
+  Expire     = '%s GMT';
+var
+  vInt: integer;
+  vYear, vMonth, vDay: Word;
+  vExpire, vValue : StringRAL;
+  test: String;
+begin
+  // Dia da semana e nome do mês precisam ter a 1a letra maiúscula
+  ADateTime := RALDateTimeToGMT(ADateTime);
+  DecodeDate(ADateTime, vYear, vMonth, vDay);
+
+  vExpire := FormatDateTime(DateFormat, ADateTime);
+  vExpire := Format(vExpire, [HTTPDays[DayOfWeek(ADateTime)], HTTPMonths[vMonth]]);
+  vExpire := Format(Expire, [vExpire]);
+  Result := vExpire;
+  //Result := 'Mon, 27 Jul 2026 14:00:00 GMT'
+end;
+
+function GetCookieText(ACookie: TRALCookie): StringRAL;
+begin
+  Result := ACookie.Name + '=' + ACookie.Value;
+
+  if ACookie.Domain <> '' then
+    Result := Result + '; Domain=' + ACookie.Domain;
+
+  if ACookie.Path <> '' then
+    Result := Result + '; Path=' + ACookie.Path;
+
+  if (not ACookie.SessionOnly) and (ACookie.Expires <> 0) then
+    Result := Result + '; Expires=' + DateTimeToCookieExpireDate(ACookie.Expires);
+
+  if ACookie.Secure then
+    Result := Result + '; Secure';
+
+  if ACookie.HttpOnly then
+    Result := Result + '; HttpOnly';
+
+  case ACookie.SameSite of
+    cssNone:
+      if ACookie.Secure then
+        Result := Result + '; SameSite=None';
+    cssStrict:
+      Result := Result + '; SameSite=Strict';
+  end;
+end;
+
+function GetRALCookieFromText(ACookieString: StringRAL): TRALCookie;
+var
+  Start, P, EqPos, Len: Integer;
+  S, Part, Name, Value: StringRAL;
+begin
+  FillChar(Result, SizeOf(Result), 0);
+
+  S := StringReplace(ACookieString, '; ', ';', [rfReplaceAll]);
+  Len := Length(S);
+  if Len = 0 then
+    Exit;
+
+  Start := 1;
+  while Start <= Len do
+  begin
+    // Encontra o próximo ';'
+    P := Start;
+    while (P <= Len) and (S[P] <> ';') do
+      Inc(P);
+
+    // Extrai o trecho atual (já sem espaço extra por causa do Replace)
+    Part := Copy(S, Start, P - Start);
+
+    // Avança para o próximo
+    Start := P + 1;
+
+    if Part = '' then
+      Continue;
+
+    EqPos := Pos('=', Part);
+    if EqPos > 0 then
+    begin
+      Name  := Copy(Part, 1, EqPos - 1);
+      Value := Copy(Part, EqPos + 1, MaxInt);
+    end
+    else
+    begin
+      Name  := Part;
+      Value := '';
+    end;
+
+    // Comparações case-sensitive como no original (pode trocar por SameText se quiser case-insensitive)
+    if SameText(Name, 'HttpOnly') then
+      Result.HttpOnly := True
+    else if SameText(Name, 'Secure') then
+      Result.Secure := True
+    else if SameText(Name, 'Path') then
+      Result.Path := Value
+    else if SameText(Name, 'Domain') then
+      Result.Domain := Value
+    else if SameText(Name, 'SameSite') then
+    begin
+      if SameText(Value, 'None') then
+        Result.SameSite := cssNone
+      else if SameText(Value, 'Lax') then
+        Result.SameSite := cssLax
+      else if SameText(Value, 'Strict') then
+        Result.SameSite := cssStrict;
+    end
+    else if SameText(Name, 'Expires') then
+      Result.Expires := HTTPDateTimeToDateTime(Value)
+    else if SameText(Name, 'Max-Age') then
+      Result.MaxAge := StrToInt64Def(Value, 0)
+    else
+    begin
+      // Primeiro (e único) name=value que sobra é o cookie propriamente dito
+      Result.Name  := Name;
+      Result.Value := Value;
+    end;
+  end;
+end;
+
+function GetRALCookieFromParam(AParamName: StringRAL; AParams: TRALParams
+  ): TRALCookie;
+var
+  vCookieStr: StringRAL;
+begin
+  vCookieStr := AParams.GetKind[AParamName, rpkCOOKIE].AsString;
+  Result := GetRALCookieFromText(vCookieStr);
+end;
+
 procedure TRALParam.Clone(ASource: TRALParam);
 begin
   ASource.ContentDispositionInline := Self.ContentDispositionInline;

src/base/RALRequest.pas

@@ -86,6 +86,8 @@   TRALRequest = class(TRALHTTPHeaderInfo)
     function AddBody(const AText: StringRAL; const AContextType: StringRAL = rctTEXTPLAIN): TRALRequest; reintroduce;
     /// Adds a string cookie to the body of the request.
     function AddCookie(const AName: StringRAL; const AValue: StringRAL): TRALRequest; reintroduce;
+    /// Adds a RALcookie to the header of the request.
+    function AddCookie(const ACookie: TRALCookie): TRALRequest; reintroduce;
     /// Adds a string param with the "Field" kind to the request.
     function AddField(const AName: StringRAL; const AValue: StringRAL): TRALRequest; reintroduce;
     /// Adds a file to the body of the request based on the given AFileName.
@@ -250,6 +252,12 @@ function TRALRequest.AddCookie(const AName: StringRAL; const AValue: StringRAL
   Result := Self;
 end;
 
+function TRALRequest.AddCookie(const ACookie: TRALCookie): TRALRequest;
+begin
+  inherited AddCookie(ACookie);
+  Result := Self;
+end;
+
 function TRALRequest.AddFile(const AFileName: StringRAL): TRALRequest;
 begin
   inherited AddFile(AFileName);

src/base/RALResponse.pas

@@ -11,6 +11,7 @@ interface
 type
 
   { TRALResponse }
+
   /// Base class for everything related to data response
   TRALResponse = class(TRALHTTPHeaderInfo)
   private
@@ -31,7 +32,9 @@   TRALResponse = class(TRALHTTPHeaderInfo)
     /// Append an UTF8 String to the response
     function AddBody(const AText: StringRAL; const AContextType: StringRAL = rctTEXTPLAIN): TRALResponse; reintroduce;
     /// Append a name:value cookie to the response
-    function AddCookie(const AName: StringRAL; const AValue: StringRAL): TRALResponse; reintroduce;
+    function AddCookie(const AName: StringRAL; const AValue: StringRAL): TRALResponse; reintroduce; overload; deprecated 'use AddCookie(ACookie: TRALCookie) instead';
+    /// Append a TRALCookie to the response
+    function AddCookie(const ACookie: TRALCookie): TRALResponse; reintroduce; overload;
     /// Append a custom param of type "Field" to the response
     function AddField(const AName: StringRAL; const AValue: StringRAL): TRALResponse; reintroduce;
     /// Loads and append a file to the response from given AFileName
@@ -157,7 +160,8 @@ procedure TRALResponse.GetParamsCookies(ADest: TStringList; ADateTime: TDateTime
     if (vParam <> nil) and (vParam.Kind = rpkCOOKIE) then
     begin
       vValue := vParam.ParamName + '=' + vParam.AsString + ';';
-      vValue := vValue + vExpire + '; path=/';
+      vValue := vValue + vExpire //+ '; path=/'
+      ;
       ADest.Add(vValue);
     end;
   end;
@@ -232,6 +236,12 @@ function TRALResponse.AddCookie(const AName: StringRAL; const AValue: StringRAL
   Result := Self;
 end;
 
+function TRALResponse.AddCookie(const ACookie: TRALCookie): TRALResponse;
+begin
+  inherited AddCookie(ACookie);
+  Result := Self;
+end;
+
 function TRALResponse.AddFile(const AFileName: StringRAL): TRALResponse;
 begin
   inherited AddFile(AFileName);

src/base/RALServer.pas

@@ -198,22 +198,24 @@   TRALServer = class(TRALComponent)
     FOnResponse: TRALOnReply;    
     FOnServerError: TRALOnServerError;
   protected
-    // Adds a fixed subroute from other components into server routes
+    /// Adds a fixed subroute from other components into server routes
     procedure AddSubRoute(ASubRoute: TRALModuleRoutes);
-    // Processes CORS headers
+    /// Processes CORS headers
     procedure CheckCORS(AAllowOptions: boolean; AAllowMethods: StringRAL;
                         ARequest: TRALRequest; AResponse: TRALResponse);
-    // Used by inherited members to set SSL settings
+    /// Used by inherited members to set SSL settings
     function CreateRALSSL: TRALSSL; virtual;
-    // Removes a fixed subroute used by other components
+    /// Decode the authentication header of the request
+    procedure DecodeAuth(AResult: TRALRequest);
+    /// Removes a fixed subroute used by other components
     procedure DelSubRoute(ASubRoute: TRALModuleRoutes);
-    // Used by inherited members to return the SSL definitions
+    /// Used by inherited members to return the SSL definitions
     function GetDefaultSSL: TRALSSL;
-    // Checks if the current server component allows IPv6
+    /// Checks if the current server component allows IPv6
     function IPv6IsImplemented: boolean; virtual;
-    // Internal function to properly dispose the component attached to the server
+    /// Internal function to properly dispose the component attached to the server
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-    // Function that will call Validate from the current authentication component
+    /// Function that will call Validate from the current authentication component
     function ValidateAuth(ARequest: TRALRequest; var AResponse: TRALResponse): boolean;
     procedure SetActive(const AValue: boolean); virtual;
     procedure SetAuthentication(const AValue: TRALAuthServer);
@@ -455,6 +457,43 @@ function TRALServer.CreateRALSSL: TRALSSL;
   Result := nil;
 end;
 
+procedure TRALServer.DecodeAuth(AResult: TRALRequest);
+var
+  vStr, vAux: StringRAL;
+  vInt: IntegerRAL;
+  vParam: TRALParam;
+  tempCookie: TRALCookie;
+begin
+  if Authentication = nil then
+    Exit;
+
+  AResult.Authorization.AuthType := ratNone;
+  AResult.Authorization.AuthString := '';
+
+  vParam := AResult.Params.GetKind['Authorization', rpkHEADER];
+  if not vParam.IsNilOrEmpty then
+  begin
+    vStr := vParam.AsString;
+    if vStr <> EmptyStr then
+    begin
+      vInt := Pos(' ', vStr);
+      vAux := Trim(Copy(vStr, 1, vInt - 1));
+      if SameText(vAux, 'Basic') then
+        AResult.Authorization.AuthType := ratBasic
+      else if SameText(vAux, 'Bearer') then
+        AResult.Authorization.AuthType := ratBearer;
+      AResult.Authorization.AuthString := Copy(vStr, vInt + 1, Length(vStr));
+    end;
+  end
+  else if (Authentication is TRALServerJWTAuth)
+      And not AResult.ParamByName('Cookie').IsNilOrEmpty then
+  begin
+    tempCookie := GetRALCookieFromText(AResult.ParamByName('Cookie').AsString);
+    AResult.Authorization.AuthType := ratBearer;
+    AResult.Authorization.AuthString := tempCookie.Value;
+  end;
+end;
+
 function TRALServer.CreateRoute(const ARoute: StringRAL; AReplyProc: TRALOnReply;
   const ADescription: StringRAL): TRALRoute;
 begin