paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 20:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Introduce route options to select case sensitivity or not. (default not case sensitive)

Browse Source 
git-svn-id: trunk@38956 -
This commit is contained in:
michael 2018-05-09 07:25:01 +00:00
parent c2181a302d
commit 9d2e5308fb
1 changed files with 45 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
packages/fcl-web/src/base/httproute.pp
View File

@ -37,6 +37,8 @@ Type
// Some common HTTP methods.
TRouteMethod = (rmUnknown,rmAll,rmGet,rmPost,rmPut,rmDelete,rmOptions,rmHead, rmTrace);
TRouteOption = (roCaseSensitive,roEmptyMatchesAll);
TRouteOptions = Set of TRouteOption;
{ THTTPRoute }
@ -51,11 +53,13 @@ Type
Public
Destructor Destroy; override;
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse);
Function Matches(Const APattern : String; AMethod : TRouteMethod) : Boolean;
Function MatchPattern(Const Path : String; L : TStrings) : Boolean;
Function Matches(Const APattern : String; AMethod : TRouteMethod; Options : TRouteOptions) : Boolean;
Function MatchPattern(Const Path : String; L : TStrings; Options : TRouteOptions) : Boolean;
Function MatchMethod(Const AMethod : TRouteMethod) : Boolean;
Published
// Default route is per method. This means you can register
Property Default : Boolean Read FDefault Write FDefault;
// Depending on options, an empty URLPattern matches all, and acts as default.
Property URLPattern : String Read FURLPattern Write SetURLPattern;
Property Method : TRouteMethod Read FMethod Write FMethod;
end;
@ -154,6 +158,7 @@ Type
private
FAfterRequest: THTTPRouteRequestEvent;
FBeforeRequest: THTTPRouteRequestEvent;
FRouteOptions: TRouteOptions;
FRoutes : THTTPRouteList;
function GetR(AIndex : Integer): THTTPRoute;
Class Procedure DoneService;
@ -219,6 +224,8 @@ Type
Property BeforeRequest : THTTPRouteRequestEvent Read FBeforeRequest Write FBeforeRequest;
// Called after the request is routed, if no exception was raised during or before the request.
Property AfterRequest : THTTPRouteRequestEvent Read FAfterRequest Write FAfterRequest;
// Global options used when routing a request.
Property RouteOptions : TRouteOptions Read FRouteOptions Write FRouteOptions;
end;
Function RouteMethodToString (R : TRouteMethod) : String;
@ -318,7 +325,7 @@ begin
R:=FRoutes[I];
if R.Default then
DI:=I;
if R.Matches(APattern,AMethod) then
if R.Matches(APattern,AMethod,FRouteOptions) then
Raise EHTTPRoute.CreateFmt(EDuplicateRoute,[APattern,RouteMethodToString(AMethod)]);
end;
if isDefault and (DI<>-1) then
@ -526,7 +533,7 @@ begin
While (Result=Nil) and (I<FRoutes.Count) do
begin
Result:=FRoutes[i];
If Not Result.MatchPattern(APathInfo,Params) then
If Not Result.MatchPattern(APathInfo,Params,FRouteOptions) then
Result:=Nil
else if Not Result.MatchMethod(AMethod) then
begin
@ -536,6 +543,18 @@ begin
end;
Inc(I);
end;
// Find default route.
if (Result=Nil) then
begin
I:=0;
While (Result=Nil) and (I<FRoutes.Count) do
begin
Result:=FRoutes[i];
if Not (Result.Default and Result.MatchMethod(AMethod)) then
Result:=Nil;
Inc(I);
end;
end;
end;
function THTTPRouter.GetHTTPRoute(const Path: String; AMethod: TRouteMethod; Params : TStrings): THTTPRoute;
@ -605,7 +624,7 @@ Var
begin
V:=IncludeHTTPPathDelimiter(AValue);
if (V<>'/') and (V[1]='/') then
if (V<>'') and (V<>'/') and (V[1]='/') then
Delete(V,1,1);
if FURLPattern=V then Exit;
FURLPattern:=V;
@ -627,22 +646,24 @@ begin
DoHandleRequest(ARequest,AResponse);
end;
function THTTPRoute.Matches(const APattern: String; AMethod: TRouteMethod
): Boolean;
function THTTPRoute.Matches(const APattern: String; AMethod: TRouteMethod; Options: TRouteOptions): Boolean;
begin
Result:=(CompareText(URLPattern,APattern)=0)
and ((Method=rmAll) or (AMethod=Method))
Result:=((Method=rmAll) or (AMethod=Method));
if Result then
Result:=SameText(URLPattern,APattern) or ((URLPattern='') and (roEmptyMatchesAll in Options))
end;
Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings; Options: TRouteOptions) : Boolean;
// This is used only with special chars, so we do not check case sensitivity
Function StartsWith(C : Char; S : String): Boolean;
begin
Result:=(Length(S)>0) and (S[1]=C);
end;
Function EndsWith(C : Char; S : String): Boolean;
// This is used only with special chars, so we do not check case sensitivity
Function EndsWith(C : Char; S : String): Boolean;
Var
L : Integer;
@ -651,6 +672,15 @@ Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
L:=Length(S);
Result:=(L>0) and (S[L]=C);
end;
Function SameString(A,B : String) : Boolean;
begin
if roCaseSensitive in Options then
Result:=(A=B)
else
Result:=SameText(A,B);
end;
procedure ExtractNextPathLevel(var ALeft: string;
@ -700,9 +730,9 @@ var
VLeftPat, VRightPat, VLeftVal, VRightVal, VVal, VPat, VName: string;
begin
Result:= False;
Result:=False;
if (URLPattern='') then
Exit; // Maybe empty pattern should match any path?
Exit(roEmptyMatchesAll in Options);
APathInfo:=Path;
APattern:=URLPattern;
Delete(APattern, Pos('?', APattern), MaxInt);
@ -750,7 +780,7 @@ begin
end
else
// *path/const
if not ((VPat='') and (VLeftPat='')) and Not SameText(VPat,VVal) then
if not ((VPat='') and (VLeftPat='')) and Not SameString(VPat,VVal) then
Exit;
// Check if we already done
if (VLeftPat='') or (VLeftVal='') then
@ -767,7 +797,7 @@ begin
end
else
// const
if Not SameText(VPat,VVal) then
if Not SameString(VPat,VVal) then
Exit;
// Check if we already done
if (VRightPat='') or (VRightVal='') then