Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 15:55:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Removed old code; renamed TProtocolFilter to TCustomProtocolFilter and TControllerFilter to TCustomControllerFilter

Browse Source
This commit is contained in:
Daniele Teti 2023-07-01 00:23:19 +02:00
parent 6b5af9e88c
commit ed0c5ee942
34 changed files with 992 additions and 4075 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
samples/CustomAuth/AuthHandlerU.pas
View File

@ -1,135 +0,0 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit AuthHandlerU;
interface
uses
MVCFramework.Commons, MVCFramework, System.Generics.Collections;
type
TCustomAuth = class(TInterfacedObject, IMVCAuthenticationHandler)
public
// called at each request to know if the request requires an authentication
procedure OnRequest(const AContext: TWebContext; const ControllerQualifiedClassName: string;
const ActionName: string; var AuthenticationRequired: Boolean);
// if authentication is required, this method must execute the user authentication
procedure OnAuthentication(const AContext: TWebContext; const UserName: string; const Password: string;
UserRoles: TList<System.string>;
var IsValid: Boolean;
const SessionData: System.Generics.Collections.TDictionary<System.string, System.string>);
// if authenticated, this method defines the user roles
procedure OnAuthorization(const AContext: TWebContext; UserRoles: System.Generics.Collections.TList<System.string>;
const ControllerQualifiedClassName: string; const ActionName: string;
var IsAuthorized: Boolean);
end;
implementation
uses
System.SysUtils;
{ TCustomAuth }
procedure TCustomAuth.OnAuthentication(const AContext: TWebContext; const UserName: string; const Password: string;
UserRoles: TList<System.string>;
var IsValid: Boolean;
const SessionData: System.Generics.Collections.TDictionary<System.string, System.string>);
begin
{
Here you should do the actual query on database or other "users store" to
check if the user identified by UserName and Password is a valid user.
You have to fill also the UserRoles list with the roles of the user.
Moreover additional user properties can be added in the SessionData dictionary
}
// We defined 3 statc users here: admin, user1, user2
IsValid := False;
if (UserName = 'admin') and (Password = 'adminpass') then
begin
IsValid := True;
UserRoles.Add('admin');
end
else if (UserName = 'user1') and (Password = 'user1pass') then
begin
IsValid := True;
UserRoles.Add('role1');
end
else if (UserName = 'user2') and (Password = 'user2pass') then
begin
IsValid := True;
UserRoles.Add('role2');
end;
// if you dont have "roles" concept in your system, you can also avoid to use them and
// sets only IsValid := True;
end;
procedure TCustomAuth.OnAuthorization(const AContext: TWebContext; UserRoles: System.Generics.Collections.TList<System.string>;
const ControllerQualifiedClassName: string; const ActionName: string;
var IsAuthorized: Boolean);
begin
if ControllerQualifiedClassName = 'PrivateControllerU.TPrivateController' then
begin
IsAuthorized := UserRoles.Contains('admin');
if not IsAuthorized then
IsAuthorized := (UserRoles.Contains('role1')) and (ActionName = 'OnlyRole1');
if not IsAuthorized then
IsAuthorized := (UserRoles.Contains('role2')) and (ActionName = 'OnlyRole2');
end
else
begin
// You can always navigate in the public section of API
IsAuthorized := True;
end;
end;
procedure TCustomAuth.OnRequest(const AContext: TWebContext; const ControllerQualifiedClassName: string;
const ActionName: string; var AuthenticationRequired: Boolean);
begin
{
This is the the auth schema implemented: All the actions present in the
'PrivateControllerU.TPrivateController' requires authentication but
the action 'PublicAction'. In other words, 'PublicAction' can be called also
without authentication.
}
AuthenticationRequired :=
ControllerQualifiedClassName = 'PrivateControllerU.TPrivateController';
if AuthenticationRequired then
begin
if ActionName = 'PublicAction' then
begin
AuthenticationRequired := False;
end;
end;
end;
end.

14
samples/CustomAuth/CustomAuthClient.dpr
View File

@ -1,14 +0,0 @@
program CustomAuthClient;
uses
Vcl.Forms,
MainClientFormU in 'MainClientFormU.pas' {Form7};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm7, Form7);
Application.Run;
end.

1234
samples/CustomAuth/CustomAuthClient.dproj
View File

File diff suppressed because it is too large Load Diff

48
samples/CustomAuth/CustomAuthGroup.groupproj
View File

@ -1,48 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{CF5DB084-7815-4A94-85E3-F9FC0074C8AC}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="CustomAuthServer.dproj">
<Dependencies/>
</Projects>
<Projects Include="CustomAuthClient.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="CustomAuthServer">
<MSBuild Projects="CustomAuthServer.dproj"/>
</Target>
<Target Name="CustomAuthServer:Clean">
<MSBuild Projects="CustomAuthServer.dproj" Targets="Clean"/>
</Target>
<Target Name="CustomAuthServer:Make">
<MSBuild Projects="CustomAuthServer.dproj" Targets="Make"/>
</Target>
<Target Name="CustomAuthClient">
<MSBuild Projects="CustomAuthClient.dproj"/>
</Target>
<Target Name="CustomAuthClient:Clean">
<MSBuild Projects="CustomAuthClient.dproj" Targets="Clean"/>
</Target>
<Target Name="CustomAuthClient:Make">
<MSBuild Projects="CustomAuthClient.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="CustomAuthServer;CustomAuthClient"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="CustomAuthServer:Clean;CustomAuthClient:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="CustomAuthServer:Make;CustomAuthClient:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

47
samples/CustomAuth/CustomAuthServer.dpr
View File

@ -1,47 +0,0 @@
program CustomAuthServer;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
Web.WebReq,
Web.WebBroker,
IdHTTPWebBrokerBridge,
PublicControllerU in 'PublicControllerU.pas',
MyWebModuleU in 'MyWebModuleU.pas' {MyWebModule: TWebModule} ,
PrivateControllerU in 'PrivateControllerU.pas',
AuthHandlerU in 'AuthHandlerU.pas';
{$R *.res}
procedure RunServer(APort: Integer);
var
LServer: TIdHTTPWebBrokerBridge;
begin
Writeln('** DMVCFramework Server **');
Writeln(Format('Starting HTTP Server on port %d', [APort]));
LServer := TIdHTTPWebBrokerBridge.Create(nil);
try
LServer.DefaultPort := APort;
LServer.Active := True;
// ShellExecute(0, 'open', pChar('http://localhost:' + inttostr(APort)), nil, nil, SW_SHOWMAXIMIZED);
Writeln('Press RETURN to stop the server');
ReadLn;
finally
LServer.Free;
end;
end;
begin
ReportMemoryLeaksOnShutdown := True;
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
WebRequestHandlerProc.MaxConnections := 1024;
RunServer(8080);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

196
samples/CustomAuth/MainClientFormU.dfm
View File

@ -1,196 +0,0 @@
object Form7: TForm7
Left = 0
Top = 0
Caption = 'Form7'
ClientHeight = 353
ClientWidth = 602
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize = (
602
353)
PixelsPerInch = 96
TextHeight = 13
object Label3: TLabel
Left = 8
Top = 31
Width = 89
Height = 13
Caption = 'Available accounts'
end
object Label4: TLabel
Left = 8
Top = 8
Width = 42
Height = 14
Caption = 'STEP 1'
Color = clWindowText
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = 14
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
end
object Label5: TLabel
Left = 145
Top = 8
Width = 42
Height = 14
Caption = 'STEP 2'
Color = clWindowText
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = 14
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
end
object Label6: TLabel
Left = 312
Top = 8
Width = 42
Height = 14
Caption = 'STEP 3'
Color = clWindowText
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = 14
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
end
object Label7: TLabel
Left = 8
Top = 116
Width = 123
Height = 39
Caption = 'user1 has "role1", user2 has "role2", admin has all the roles'
WordWrap = True
end
object GroupBox1: TGroupBox
Left = 145
Top = 31
Width = 161
Height = 147
Caption = 'Login/Logout'
TabOrder = 2
object Label1: TLabel
Left = 16
Top = 20
Width = 48
Height = 13
Caption = 'Username'
end
object Label2: TLabel
Left = 16
Top = 66
Width = 46
Height = 13
Caption = 'Password'
end
object edtUsername: TEdit
Left = 16
Top = 39
Width = 121
Height = 21
TabOrder = 0
Text = 'user1'
end
object edtPassword: TEdit
Left = 16
Top = 85
Width = 121
Height = 21
TabOrder = 1
Text = 'user1pass'
end
object btnLogInLogOut: TButton
Left = 16
Top = 112
Width = 121
Height = 25
Caption = 'btnLogInLogOut'
TabOrder = 2
OnClick = btnLogInLogOutClick
end
end
object Panel1: TPanel
Left = 0
Top = 326
Width = 602
Height = 27
Align = alBottom
TabOrder = 6
end
object Button1: TButton
Left = 311
Top = 31
Width = 283
Height = 45
Anchors = [akLeft, akTop, akRight]
Caption = 'Call Public Action (no login required)'
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 8
Top = 184
Width = 586
Height = 136
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'Memo1')
TabOrder = 5
end
object Button2: TButton
Left = 311
Top = 82
Width = 283
Height = 45
Anchors = [akLeft, akTop, akRight]
Caption = 'Call action allowed only for "role1"'
TabOrder = 3
OnClick = Button2Click
end
object Button3: TButton
Left = 312
Top = 133
Width = 283
Height = 45
Anchors = [akLeft, akTop, akRight]
Caption = 'Call action allowed only for "role2"'
TabOrder = 4
OnClick = Button3Click
end
object ListBox1: TListBox
Left = 8
Top = 51
Width = 131
Height = 59
ItemHeight = 13
Items.Strings = (
'user1:user1pass'
'user2:user2pass'
'admin:adminpass')
TabOrder = 1
OnClick = ListBox1Click
end
object ApplicationEvents1: TApplicationEvents
OnIdle = ApplicationEvents1Idle
Left = 16
Top = 184
end
end

188
samples/CustomAuth/MainClientFormU.pas
View File

@ -1,188 +0,0 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit MainClientFormU;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.AppEvnts, MVCFramework.RESTClient.Intf, MVCFramework.RESTClient,
Vcl.ExtCtrls;
type
TForm7 = class(TForm)
GroupBox1: TGroupBox;
edtUsername: TEdit;
edtPassword: TEdit;
btnLogInLogOut: TButton;
ApplicationEvents1: TApplicationEvents;
Panel1: TPanel;
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
procedure btnLogInLogOutClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private
FRESTClient: IMVCRESTClient;
FLogoutUrl: string;
FLogoutMethod: string;
procedure FillMemo(Response: IMVCRESTResponse);
{ Private declarations }
public
{ Public declarations }
end;
var
Form7: TForm7;
implementation
uses
System.JSON,
MVCFramework.SystemJSONUtils;
{$R *.dfm}
procedure TForm7.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
if FRESTClient.SessionID.IsEmpty then
begin
btnLogInLogOut.Caption := 'LOGIN';
Panel1.Caption := 'Not Logged';
edtUsername.Enabled := True;
edtPassword.Enabled := True;
end
else
begin
btnLogInLogOut.Caption := 'LOGOUT';
Panel1.Caption := 'SessionID = ' + FRESTClient.SessionID;
edtUsername.Enabled := False;
edtPassword.Enabled := False;
end;
end;
procedure TForm7.btnLogInLogOutClick(Sender: TObject);
var
lJObj: TJSONObject;
lRes: IMVCRESTResponse;
begin
if btnLogInLogOut.Caption = 'LOGIN' then
begin
lJObj := TJSONObject.Create;
try
lJObj.AddPair('username', edtUsername.Text);
lJObj.AddPair('password', edtPassword.Text);
lRes := FRESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJObj, False));
if not lRes.Success then
begin
ShowMessage(lRes.Content);
end;
FLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL');
FLogoutMethod := lRes.HeaderValue('X-LOGOUT-METHOD');
finally
lJObj.Free;
end;
end
else
begin
Assert(FLogoutMethod = 'DELETE');
lRes := FRESTClient.Delete(FLogoutUrl);
if not lRes.Success then
begin
ShowMessage(lRes.Content);
end;
end;
end;
procedure TForm7.Button1Click(Sender: TObject);
var
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.Get('/private/public/action');
FillMemo(lRes);
end;
procedure TForm7.Button2Click(Sender: TObject);
var
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.Get('/private/role1');
FillMemo(lRes);
end;
procedure TForm7.Button3Click(Sender: TObject);
var
lRes: IMVCRESTResponse;
begin
lRes := FRESTClient.Get('/private/role2');
FillMemo(lRes);
end;
procedure TForm7.FillMemo(Response: IMVCRESTResponse);
begin
Memo1.Lines.Add(
Format('[%s] [%s] %s',
[TimeToStr(Time),
Response.StatusText,
Response.Content]));
end;
procedure TForm7.FormCreate(Sender: TObject);
begin
FRESTClient := TMVCRESTClient.New.BaseURL('localhost', 8080);
end;
procedure TForm7.ListBox1Click(Sender: TObject);
var
lText: string;
lPieces: TArray<string>;
begin
if ListBox1.ItemIndex > -1 then
begin
lText := ListBox1.Items[ListBox1.ItemIndex];
lPieces := lText.Split([':']);
edtUsername.Text := lPieces[0];
edtPassword.Text := lPieces[1];
ShowMessage('Now you can log in using the login/logout button');
end;
end;
end.

8
samples/CustomAuth/MyWebModuleU.dfm
View File

@ -1,8 +0,0 @@
object MyWebModule: TMyWebModule
OldCreateOrder = False
OnCreate = WebModuleCreate
OnDestroy = WebModuleDestroy
Actions = <>
Height = 230
Width = 415
end

94
samples/CustomAuth/MyWebModuleU.pas
View File

@ -1,94 +0,0 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit MyWebModuleU;
interface
uses System.SysUtils,
System.Classes,
Web.HTTPApp,
MVCFramework;
type
TMyWebModule = class(TWebModule)
procedure WebModuleCreate(Sender: TObject);
procedure WebModuleDestroy(Sender: TObject);
private
FMVC: TMVCEngine;
public
{ Public declarations }
end;
var
WebModuleClass: TComponentClass = TMyWebModule;
implementation
{$R *.dfm}
uses
MVCFramework.Commons,
PublicControllerU,
PrivateControllerU,
MVCFramework.Middleware.Authentication,
MVCFramework.Middleware.StaticFiles,
AuthHandlerU;
procedure TMyWebModule.WebModuleCreate(Sender: TObject);
begin
FMVC := TMVCEngine.Create(Self,
procedure(Config: TMVCConfig)
begin
// session timeout (0 means session cookie)
Config[TMVCConfigKey.SessionTimeout] := '0';
// default content-type
Config[TMVCConfigKey.DefaultContentType] := TMVCConstants.DEFAULT_CONTENT_TYPE;
// default content charset
Config[TMVCConfigKey.DefaultContentCharset] := TMVCConstants.DEFAULT_CONTENT_CHARSET;
// unhandled actions are permitted?
Config[TMVCConfigKey.AllowUnhandledAction] := 'false';
// default view file extension
Config[TMVCConfigKey.DefaultViewFileExtension] := 'html';
// view path
Config[TMVCConfigKey.ViewPath] := 'templates';
// Enable Server Signature in response
Config[TMVCConfigKey.ExposeServerSignature] := 'true';
end);
FMVC.AddController(TPublicController);
FMVC.AddController(TPrivateController);
FMVC.AddMiddleware(
TMVCCustomAuthenticationMiddleware.Create(
TCustomAuth.Create,
'/system/users/logged'
));
end;
procedure TMyWebModule.WebModuleDestroy(Sender: TObject);
begin
FMVC.Free;
end;
end.

78
samples/CustomAuth/PrivateControllerU.pas
View File

@ -1,78 +0,0 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit PrivateControllerU;
interface
uses
MVCFramework, MVCFramework.Commons;
type
[MVCPath('/private')]
TPrivateController = class(TMVCController)
public
[MVCPath('/')]
[MVCHTTPMethod([httpGET])]
procedure Index;
[MVCPath('/public/action')]
[MVCHTTPMethod([httpGET])]
procedure PublicAction;
[MVCPath('/role1')]
[MVCHTTPMethod([httpGET])]
procedure OnlyRole1;
[MVCPath('/role2')]
[MVCHTTPMethod([httpGET])]
procedure OnlyRole2;
end;
implementation
procedure TPrivateController.Index;
begin
// use Context property to access to the HTTP request and response
Render('Hello World');
end;
procedure TPrivateController.OnlyRole1;
begin
Render('OK from a "role1" action');
end;
procedure TPrivateController.OnlyRole2;
begin
Render('OK from a "role2" action');
end;
procedure TPrivateController.PublicAction;
begin
Render('OK from a public action (no login required)');
end;
end.

52
samples/CustomAuth/PublicControllerU.pas
View File

@ -1,52 +0,0 @@
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }
unit PublicControllerU;
interface
uses
MVCFramework, MVCFramework.Commons;
type
[MVCPath('/')]
TPublicController = class(TMVCController)
public
[MVCPath('/')]
[MVCHTTPMethod([httpGET])]
procedure Index;
end;
implementation
procedure TPublicController.Index;
begin
// use Context property to access to the HTTP request and response
Render('Hello World');
end;
end.

66
samples/middleware/AppControllerU.pas → samples/custom_filters/AppControllerU.pas
View File

@ -1,33 +1,33 @@
unit AppControllerU;
interface
uses MVCFramework,
MVCFramework.Commons,
MVCFramework.Logger,
Web.HTTPApp;
type
[MVCPath('/')]
TApp1MainController = class(TMVCController)
public
[MVCPath('/')]
[MVCHTTPMethod([httpGET])]
procedure Index;
end;
implementation
uses
System.SysUtils;
{ TApp1MainController }
procedure TApp1MainController.Index;
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(StringOfChar('*', 1024));
end;
end.
unit AppControllerU;
interface
uses MVCFramework,
MVCFramework.Commons,
MVCFramework.Logger,
Web.HTTPApp;
type
[MVCPath('/')]
TApp1MainController = class(TMVCController)
public
[MVCPath('/')]
[MVCHTTPMethod([httpGET])]
procedure Index;
end;
implementation
uses
System.SysUtils;
{ TApp1MainController }
procedure TApp1MainController.Index;
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(StringOfChar('*', 1024));
end;
end.

92
samples/middleware/MiddlewareSamples.dpr → samples/custom_filters/FiltersSamples.dpr
View File

@ -1,46 +1,46 @@
program MiddlewareSamples;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
Web.WebReq,
Web.WebBroker,
IdHTTPWebBrokerBridge,
WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule} ,
AppControllerU in 'AppControllerU.pas',
MiddlewareSample1 in 'MiddlewareSample1.pas';
{$R *.res}
procedure RunServer(APort: Integer);
var
LServer: TIdHTTPWebBrokerBridge;
begin
Writeln(Format('Starting HTTP Server or port %d', [APort]));
LServer := TIdHTTPWebBrokerBridge.Create(nil);
try
LServer.DefaultPort := APort;
LServer.Active := True;
Writeln('Press RETURN to stop the server');
ReadLn;
finally
LServer.Free;
end;
end;
begin
ReportMemoryLeaksOnShutdown := True;
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
WebRequestHandlerProc.MaxConnections := 1024;
RunServer(8080);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end
end.
program FiltersSamples;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
Web.WebReq,
Web.WebBroker,
IdHTTPWebBrokerBridge,
WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule} ,
AppControllerU in 'AppControllerU.pas',
MiddlewareSample1 in 'MiddlewareSample1.pas';
{$R *.res}
procedure RunServer(APort: Integer);
var
LServer: TIdHTTPWebBrokerBridge;
begin
Writeln(Format('Starting HTTP Server or port %d', [APort]));
LServer := TIdHTTPWebBrokerBridge.Create(nil);
try
LServer.DefaultPort := APort;
LServer.Active := True;
Writeln('Press RETURN to stop the server');
ReadLn;
finally
LServer.Free;
end;
end;
begin
ReportMemoryLeaksOnShutdown := True;
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
WebRequestHandlerProc.MaxConnections := 1024;
RunServer(8080);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end
end.

918
samples/CustomAuth/CustomAuthServer.dproj → samples/custom_filters/FiltersSamples.dproj
View File

File diff suppressed because it is too large Load Diff

48
samples/custom_filters/MiddlewareSample1.pas Normal file
View File

@ -0,0 +1,48 @@
unit MiddlewareSample1;
interface
uses
MVCFramework, MVCFramework.Logger;
type
TMVCSalutationControllerFilter = class(TCustomControllerFilter)
protected
procedure DoFilter(const Context: TWebContext; const Router: IMVCRouter); override;
end;
TMVCRedirectAndroidToPlayStoreProtocolFilter = class(TCustomProtocolFilter)
protected
procedure DoFilter(Context: TWebContext); override;
end;
implementation
uses
System.SysUtils, MVCFramework.Commons;
{ TMVCSalutationControllerFilter }
procedure TMVCSalutationControllerFilter.DoFilter(const Context: TWebContext;
const Router: IMVCRouter);
begin
DoNext(Context, Router);
Context.Response.CustomHeaders.Values['X-PROUD-HEADER'] :=
'Proudly served by DelphiMVCFramework (https://github.com/danieleteti/delphimvcframework)';
end;
procedure TMVCRedirectAndroidToPlayStoreProtocolFilter.DoFilter(Context: TWebContext);
begin
Log(Context.Request.Headers['User-Agent']);
if Context.Request.Headers['User-Agent'].Contains('Android') then
begin
Context.Response.Location := 'http://play.google.com';
Context.Response.StatusCode := HTTP_STATUS.TemporaryRedirect; // 307 - temporary redirect
end
else
begin
DoNext(Context);
end;
end;
end.

23
samples/middleware/WebModuleUnit1.dfm → samples/custom_filters/WebModuleUnit1.dfm
View File

@ -1,12 +1,11 @@
object WebModule1: TWebModule1
OldCreateOrder = False
OnCreate = WebModuleCreate
Actions = <
item
Default = True
Name = 'DefaultHandler'
PathInfo = '/'
end>
Height = 230
Width = 415
end
object WebModule1: TWebModule1
OnCreate = WebModuleCreate
Actions = <
item
Default = True
Name = 'DefaultHandler'
PathInfo = '/'
end>
Height = 230
Width = 415
end

92
samples/middleware/WebModuleUnit1.pas → samples/custom_filters/WebModuleUnit1.pas
View File

@ -1,46 +1,46 @@
unit WebModuleUnit1;
interface
uses System.SysUtils,
System.Classes,
Web.HTTPApp,
MVCFramework,
MVCFramework.Commons;
type
TWebModule1 = class(TWebModule)
procedure WebModuleCreate(Sender: TObject);
private
MVC: TMVCEngine;
public
{ Public declarations }
end;
var
WebModuleClass: TComponentClass = TWebModule1;
implementation
{$R *.dfm}
uses AppControllerU, MiddlewareSample1;
procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
MVC := TMVCEngine.Create(Self,
procedure(Config: TMVCConfig)
begin
Config[TMVCConfigKey.SessionTimeout] := '30';
Config[TMVCConfigKey.DefaultContentType] := 'text/plain';
end);
MVC
.AddController(TApp1MainController)
.AddMiddleware(TMVCSalutationMiddleware.Create)
.AddMiddleware(TMVCRedirectAndroidDeviceOnPlayStore.Create);
end;
end.
unit WebModuleUnit1;
interface
uses System.SysUtils,
System.Classes,
Web.HTTPApp,
MVCFramework,
MVCFramework.Commons;
type
TWebModule1 = class(TWebModule)
procedure WebModuleCreate(Sender: TObject);
private
MVC: TMVCEngine;
public
{ Public declarations }
end;
var
WebModuleClass: TComponentClass = TWebModule1;
implementation
{$R *.dfm}
uses AppControllerU, MiddlewareSample1;
procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
MVC := TMVCEngine.Create(Self,
procedure(Config: TMVCConfig)
begin
Config[TMVCConfigKey.SessionTimeout] := '30';
Config[TMVCConfigKey.DefaultContentType] := 'text/plain';
end);
MVC
.AddController(TApp1MainController)
.UseFilter(TMVCSalutationControllerFilter.Create)
.UseFilter(TMVCRedirectAndroidToPlayStoreProtocolFilter.Create);
end;
end.

1
samples/jsonwriterrenders/WebModuleU.dfm
View File

@ -1,5 +1,4 @@
object MyWebModule: TMyWebModule
OldCreateOrder = False
OnCreate = WebModuleCreate
OnDestroy = WebModuleDestroy
Actions = <>

4
samples/jsonwriterrenders/WebModuleU.pas
View File

@ -27,7 +27,7 @@ implementation
uses
MVCFramework.Commons,
JSONSampleController,
MVCFramework.Middleware.StaticFiles;
MVCFramework.Filters.StaticFiles;
procedure TMyWebModule.WebModuleCreate(Sender: TObject);
begin
@ -50,7 +50,7 @@ begin
Config[TMVCConfigKey.ExposeServerSignature] := 'true';
end);
FMVC.AddController(TMyController);
FMVC.AddMiddleware(TMVCStaticFilesMiddleware.Create(
FMVC.UseFilter(TMVCStaticFilesProtocolFilter.Create(
'/', { StaticFilesPath }
ExtractFilePath(GetModuleName(HInstance)) + '\www', { DocumentRoot }
'index.html' {IndexDocument - Before it was named fallbackresource}

18
samples/jsonwriterrenders/jsonwriterrenders.dpr
View File

@ -3,6 +3,8 @@ program jsonwriterrenders;
{$APPTYPE CONSOLE}
uses
MVCFramework,
MVCFramework.Signal,
System.SysUtils,
Winapi.Windows,
Winapi.ShellAPI,
@ -16,9 +18,6 @@ uses
procedure RunServer(APort: Integer);
var
LInputRecord: TInputRecord;
LEvent: DWord;
LHandle: THandle;
LServer: TIdHTTPWebBrokerBridge;
begin
Writeln('** DMVCFramework Server **');
@ -28,16 +27,9 @@ begin
LServer.DefaultPort := APort;
LServer.Active := True;
ShellExecute(0, 'open', pChar('http://localhost:' + inttostr(APort)), nil, nil, SW_SHOWMAXIMIZED);
Writeln('Press ESC to stop the server');
LHandle := GetStdHandle(STD_INPUT_HANDLE);
while True do
begin
Win32Check(ReadConsoleInput(LHandle, LInputRecord, 1, LEvent));
if (LInputRecord.EventType = KEY_EVENT) and
LInputRecord.Event.KeyEvent.bKeyDown and
(LInputRecord.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE) then
break;
end;
Writeln('CTRL+C to stop the server');
WaitForTerminationSignal;
EnterInShutdownState;
finally
LServer.Free;
end;

642
samples/jsonwriterrenders/jsonwriterrenders.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7C5074B2-1E72-4389-9D91-79D38F8551E7}</ProjectGuid>
<ProjectVersion>18.8</ProjectVersion>
<ProjectVersion>19.5</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>jsonwriterrenders.dpr</MainSource>
<Base>True</Base>
@ -93,13 +93,8 @@
<DCCReference Include="JSONSampleController.pas"/>
<DCCReference Include="WebModuleU.pas">
<Form>MyWebModule</Form>
<FormType>dfm</FormType>
<DesignClass>TWebModule</DesignClass>
</DCCReference>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@ -107,6 +102,10 @@
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
@ -123,13 +122,8 @@
<Excluded_Packages Name="$(BDSBIN)\dclofficexp240.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="Win32\Debug\jsonwriterrenders.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>jsonwriterrenders.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<Deployment Version="4">
<DeployFile LocalName="Win32\Debug\jsonwriterrenders.exe" Configuration="Debug" Class="ProjectOutput"/>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">
<Operation>1</Operation>
@ -138,14 +132,14 @@
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<DeployClass Name="AndroidClasses">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
<Operation>64</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
<Operation>64</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
@ -266,6 +260,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
@ -426,6 +430,10 @@
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -439,6 +447,10 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
@ -453,7 +465,7 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Platform Name="iOSSimARM64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
@ -465,6 +477,10 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
@ -483,7 +499,7 @@
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Platform Name="iOSSimARM64">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
@ -492,316 +508,11 @@
<Platform Name="OSX64">
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Platform Name="OSXARM64">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024x768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1668x2388">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048x2732">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2224">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2388x1668">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2732x2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768x1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1125">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1136x640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1242x2688">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1334">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1792">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2208">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2436">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2688x1242">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640x1136">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch750">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch828">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
@ -812,30 +523,6 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
<DeployClass Name="ProjectiOSEntitlements"/>
<DeployClass Name="ProjectiOSInfoPList"/>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug"/>
<DeployClass Name="ProjectOSXEntitlements"/>
<DeployClass Name="ProjectOSXInfoPList"/>
@ -848,6 +535,10 @@
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
@ -864,7 +555,7 @@
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Platform Name="iOSSimARM64">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
@ -876,6 +567,9 @@
<Platform Name="OSX64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -894,6 +588,34 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements"/>
<DeployClass Name="ProjectiOSInfoPList"/>
<DeployClass Name="ProjectiOSLaunchScreen"/>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
@ -914,16 +636,218 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon167">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification60">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting87">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimARM64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>

89
samples/middleware/MiddlewareSample1.pas
View File

@ -1,89 +0,0 @@
unit MiddlewareSample1;
interface
uses
MVCFramework, MVCFramework.Logger;
type
TMVCSalutationMiddleware = class(TInterfacedObject, IMVCMiddleware)
protected
procedure OnBeforeRouting(Context: TWebContext; var Handled: Boolean);
procedure OnBeforeControllerAction(Context: TWebContext;
const AControllerQualifiedClassName: string; const AActionNAme: string; var Handled: Boolean);
procedure OnAfterRouting(Context: TWebContext; const AHandled: Boolean);
procedure OnAfterControllerAction(Context: TWebContext; const AControllerQualifiedClassName: string; const AActionName: string; const AHandled: Boolean);
end;
TMVCRedirectAndroidDeviceOnPlayStore = class(TInterfacedObject, IMVCMiddleware)
protected
procedure OnBeforeRouting(Context: TWebContext; var Handled: Boolean);
procedure OnBeforeControllerAction(Context: TWebContext;
const AControllerQualifiedClassName: string; const AActionNAme: string; var Handled: Boolean);
procedure OnAfterRouting(AContext: TWebContext; const AHandled: Boolean);
procedure OnAfterControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string; const AActionName: string; const AHandled: Boolean);
end;
implementation
uses
System.SysUtils, MVCFramework.Commons;
{ TMVCSalutationMiddleware }
procedure TMVCSalutationMiddleware.OnAfterControllerAction(
Context: TWebContext; const AControllerQualifiedClassName: string;
const AActionName: string; const AHandled: Boolean);
begin
Context.Response.CustomHeaders.Values['X-PROUD-HEADER'] :=
'Proudly served by DelphiMVCFramework (https://github.com/danieleteti/delphimvcframework)';
end;
procedure TMVCRedirectAndroidDeviceOnPlayStore.OnAfterControllerAction(
AContext: TWebContext; const AControllerQualifiedClassName: string;
const AActionName: string; const AHandled: Boolean);
begin
// do nothing
end;
procedure TMVCRedirectAndroidDeviceOnPlayStore.OnAfterRouting(AContext: TWebContext; const AHandled: Boolean);
begin
// do nothing
end;
procedure TMVCRedirectAndroidDeviceOnPlayStore.OnBeforeControllerAction(
Context: TWebContext; const AControllerQualifiedClassName,
AActionNAme: string; var Handled: Boolean);
begin
// do nothing
end;
procedure TMVCRedirectAndroidDeviceOnPlayStore.OnBeforeRouting(Context: TWebContext;
var Handled: Boolean);
begin
Log(Context.Request.Headers['User-Agent']);
if Context.Request.Headers['User-Agent'].Contains('Android') then
begin
Context.Response.Location := 'http://play.google.com';
Context.Response.StatusCode := HTTP_STATUS.TemporaryRedirect; // 307 - temporary redirect
Handled := True;
end;
end;
procedure TMVCSalutationMiddleware.OnAfterRouting(Context: TWebContext; const AHandled: Boolean);
begin
// do nothing
end;
procedure TMVCSalutationMiddleware.OnBeforeControllerAction(Context: TWebContext;
const AControllerQualifiedClassName, AActionNAme: string; var Handled: Boolean);
begin
// do nothing
end;
procedure TMVCSalutationMiddleware.OnBeforeRouting(Context: TWebContext; var Handled: Boolean);
begin
// do nothing
end;
end.

171
samples/middleware/MiddlewareSamples.dproj
View File

@ -1,171 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{0388D146-2B8B-427B-AEDD-EFD5F51D3139}</ProjectGuid>
<ProjectVersion>19.5</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>MiddlewareSamples.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Console</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
<SanitizedProjectName>MiddlewareSamples</SanitizedProjectName>
<DCC_UnitSearchPath>..\..\sources;..\..\lib\delphistompclient;..\..\lib\loggerpro;..\..\lib\dmustache;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<Manifest_File>None</Manifest_File>
<VerInfo_Locale>1040</VerInfo_Locale>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_UsePackage>cxPivotGridChartRS17;JvMM;dxSkinSevenRS17;dxSkinBlueprintRS17;dxSkinHighContrastRS17;dxSkinOffice2007BlackRS17;dxCoreRS17;cxPageControldxBarPopupMenuRS17;dxSkinXmas2008BlueRS17;dxPSDBTeeChartRS17;JvCrypt;dxPSTeeChartRS17;dxSkinSummer2008RS17;dxPScxSchedulerLnkRS17;dxSkinBlueRS17;dxSkinDarkRoomRS17;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;dxPScxTLLnkRS17;JvNet;JvDotNetCtrls;dxRibbonRS17;DbxCommonDriver;cxDataRS17;vclimg;dxSkinsdxBarPainterRS17;dxPSdxDBTVLnkRS17;dbxcds;DatasnapConnectorsFreePascal;NxDBGridDsgn_dxe3;JvXPCtrls;dxSkinMoneyTwinsRS17;vcldb;cxExportRS17;dxPSCoreRS17;dxBarExtItemsRS17;dxGDIPlusRS17;FMXfrx17;dxNavBarRS17;CustomIPTransport;cxLibraryRS17;cxGridRS17;dxSkinOffice2010BlackRS17;dsnap;IndyIPServer;IndyCore;dxSkinMcSkinRS17;CloudService;dxPScxCommonRS17;FmxTeeUI;frxDB17;AnyDAC_PhysDb2_D17;dxSkinsdxDLPainterRS17;dxSkiniMaginaryRS17;JvDB;JvRuntimeDesign;dxPScxVGridLnkRS17;JclDeveloperTools;dxSkinSevenClassicRS17;dxPScxExtCommonRS17;MyFrameTestPackage;dxPScxSSLnkRS17;NxGridRun_dxe3;dxSkinLilianRS17;fs17;dxPSdxLCLnkRS17;dxSkinOffice2010BlueRS17;NxCommonRun_dxe3;bindcompfmx;DataBindingsVCL170;dxSkinOffice2010SilverRS17;vcldbx;cxSchedulerGridRS17;dbrtl;bindcomp;inetdb;JvPluginSystem;dxBarRS17;DataBindings;DBXOdbcDriver;IcsCommonDXE3Run;JvCmp;dxBarDBNavRS17;dxSkinWhiteprintRS17;JvTimeFramework;xmlrtl;dxSkinsdxRibbonPainterRS17;ibxpress;dxDockingRS17;vclactnband;bindengine;soaprtl;FMXTee;dxADOServerModeRS17;bindcompvcl;dxBarExtDBItemsRS17;dxPSPrVwRibbonRS17;Jcl;vclie;dxSkinOffice2007PinkRS17;cxPageControlRS17;dxSkinscxPCPainterRS17;AnyDAC_PhysADS_D17;AnyDAC_PhysIB_D17;dxmdsRS17;dxSkinTheAsphaltWorldRS17;DBXInformixDriver;Intraweb;dxPsPrVwAdvRS17;NxInspectorRun_dxe3;dxSkinSilverRS17;dxdborRS17;dsnapcon;DBXFirebirdDriver;fsDB17;inet;dorm_runtime_xe3;JvPascalInterpreter;vclx;dxSkinStardustRS17;cxEditorsRS17;DBXSybaseASADriver;NxInspectorDsgn_dxe3;dbexpress;IndyIPClient;AnyDAC_PhysMySQL_D17;cxTreeListdxBarPopupMenuRS17;dxSkinVS2010RS17;NxGridDsgn_dxe3;dxThemeRS17;DBXSqliteDriver;dxPScxGridLnkRS17;fmx;JvDlgs;IndySystem;TeeDB;dxSkinValentineRS17;vclib;inetdbbde;DataSnapClient;dxSkinDevExpressStyleRS17;DataSnapProviderClient;DBXSybaseASEDriver;cxBarEditItemRS17;AnyDAC_PhysMSAcc_D17;dxServerModeRS17;cxPivotGridOLAPRS17;cxSchedulerRS17;MetropolisUILiveTile;AnyDAC_PhysSQLITE_D17;dxPSLnksRS17;dxSkinPumpkinRS17;dxPSdxDBOCLnkRS17;cxVerticalGridRS17;dxSkinSpringTimeRS17;vcldsnap;dxSkinDevExpressDarkStyleRS17;DBXDb2Driver;AnyDAC_ComI_D17;DBXOracleDriver;AnyDAC_PhysMSSQL_D17;JvCore;NxDBGridRun_dxe3;vclribbon;AnyDAC_Comp_D17;cxSpreadSheetRS17;dxSkinLiquidSkyRS17;AnyDAC_PhysODBC_D17;fmxase;vcl;dxSkinOffice2007SilverRS17;AnyDAC_PhysPg_D17;IndyIPCommon;DBXMSSQLDriver;CodeSiteExpressPkg;dxPSdxOCLnkRS17;dcldxSkinsCoreRS17;JvAppFrm;AnyDAC_PhysASA_D17;inetdbxpress;webdsnap;NxCollectionRun_dxe3;AnyDAC_PhysOracle_D17;dxSkinCoffeeRS17;JvDocking;adortl;dxSkinscxSchedulerPainterRS17;JvWizards;NxCollectionDsgn_dxe3;frx17;NxCommonDsgn_dxe3;dxtrmdRS17;dxPScxPCProdRS17;AnyDAC_GUIxForms_D17;JvBands;rtl;DbxClientDriver;AnyDAC_PhysTDBX_D17;dxTabbedMDIRS17;dxComnRS17;dxSkinSharpPlusRS17;dxSkinsCoreRS17;dxSkinLondonLiquidSkyRS17;dxdbtrRS17;Tee;JclContainers;NxAddonsRun_dxe3;CPortLibDXE;JvSystem;dxorgcRS17;svnui;dxSkinBlackRS17;JvControls;NxSheetRun_dxe3;IndyProtocols;DBXMySQLDriver;dxLayoutControlRS17;bindcompdbx;TeeUI;JvJans;JvPrintPreview;JvPageComps;JvStdCtrls;JvCustom;dxSkinOffice2007BlueRS17;dxPScxPivotGridLnkRS17;dxSpellCheckerRS17;vcltouch;dxSkinOffice2007GreenRS17;dxSkinSharpRS17;websnap;dxSkinFoggyRS17;dxTileControlRS17;VclSmp;FMXfrxDB17;dxSkinDarkSideRS17;cxPivotGridRS17;DataSnapConnectors;AnyDAC_Phys_D17;fmxobj;SynEdit_RXE3;JclVcl;cxTreeListRS17;dxPSdxFCLnkRS17;dxSkinGlassOceansRS17;frxe17;svn;dxFlowChartRS17;fmxdae;dxSkinsdxNavBarPainterRS17;bdertl;VirtualTreesR;DataSnapIndy10ServerTransport;dxDBXServerModeRS17;dxSkinCaramelRS17;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_ExeOutput>.\bin</DCC_ExeOutput>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>cxPivotGridChartRS17;JvMM;dxSkinSevenRS17;dxSkinBlueprintRS17;dxSkinHighContrastRS17;dxSkinOffice2007BlackRS17;dxCoreRS17;cxPageControldxBarPopupMenuRS17;dxSkinXmas2008BlueRS17;dxPSDBTeeChartRS17;JvCrypt;dxPSTeeChartRS17;dxSkinSummer2008RS17;dxPScxSchedulerLnkRS17;dxSkinBlueRS17;dxSkinDarkRoomRS17;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;dxPScxTLLnkRS17;JvNet;dxRibbonRS17;DbxCommonDriver;cxDataRS17;vclimg;dxSkinsdxBarPainterRS17;dxPSdxDBTVLnkRS17;dbxcds;DatasnapConnectorsFreePascal;NxDBGridDsgn_dxe3;dxSkinMoneyTwinsRS17;vcldb;cxExportRS17;dxPSCoreRS17;dxBarExtItemsRS17;dxGDIPlusRS17;dxNavBarRS17;CustomIPTransport;cxLibraryRS17;cxGridRS17;dxSkinOffice2010BlackRS17;dsnap;IndyIPServer;IndyCore;dxSkinMcSkinRS17;dxPScxCommonRS17;AnyDAC_PhysDb2_D17;dxSkinsdxDLPainterRS17;dxSkiniMaginaryRS17;JvDB;dxPScxVGridLnkRS17;dxSkinSevenClassicRS17;dxPScxExtCommonRS17;dxPScxSSLnkRS17;NxGridRun_dxe3;dxSkinLilianRS17;dxPSdxLCLnkRS17;dxSkinOffice2010BlueRS17;NxCommonRun_dxe3;bindcompfmx;dxSkinOffice2010SilverRS17;cxSchedulerGridRS17;dbrtl;bindcomp;inetdb;JvPluginSystem;dxBarRS17;DBXOdbcDriver;JvCmp;dxBarDBNavRS17;dxSkinWhiteprintRS17;JvTimeFramework;xmlrtl;dxSkinsdxRibbonPainterRS17;ibxpress;dxDockingRS17;vclactnband;bindengine;soaprtl;dxADOServerModeRS17;bindcompvcl;dxBarExtDBItemsRS17;dxPSPrVwRibbonRS17;vclie;dxSkinOffice2007PinkRS17;cxPageControlRS17;dxSkinscxPCPainterRS17;AnyDAC_PhysADS_D17;AnyDAC_PhysIB_D17;dxmdsRS17;dxSkinTheAsphaltWorldRS17;DBXInformixDriver;dxPsPrVwAdvRS17;NxInspectorRun_dxe3;dxSkinSilverRS17;dxdborRS17;dsnapcon;DBXFirebirdDriver;inet;JvPascalInterpreter;vclx;dxSkinStardustRS17;cxEditorsRS17;DBXSybaseASADriver;NxInspectorDsgn_dxe3;dbexpress;IndyIPClient;AnyDAC_PhysMySQL_D17;cxTreeListdxBarPopupMenuRS17;dxSkinVS2010RS17;NxGridDsgn_dxe3;dxThemeRS17;DBXSqliteDriver;dxPScxGridLnkRS17;fmx;JvDlgs;IndySystem;TeeDB;dxSkinValentineRS17;vclib;DataSnapClient;dxSkinDevExpressStyleRS17;DataSnapProviderClient;DBXSybaseASEDriver;cxBarEditItemRS17;AnyDAC_PhysMSAcc_D17;dxServerModeRS17;cxPivotGridOLAPRS17;cxSchedulerRS17;AnyDAC_PhysSQLITE_D17;dxPSLnksRS17;dxSkinPumpkinRS17;dxPSdxDBOCLnkRS17;cxVerticalGridRS17;dxSkinSpringTimeRS17;vcldsnap;dxSkinDevExpressDarkStyleRS17;DBXDb2Driver;AnyDAC_ComI_D17;DBXOracleDriver;AnyDAC_PhysMSSQL_D17;JvCore;NxDBGridRun_dxe3;AnyDAC_Comp_D17;cxSpreadSheetRS17;dxSkinLiquidSkyRS17;AnyDAC_PhysODBC_D17;fmxase;vcl;dxSkinOffice2007SilverRS17;AnyDAC_PhysPg_D17;IndyIPCommon;DBXMSSQLDriver;dxPSdxOCLnkRS17;dcldxSkinsCoreRS17;JvAppFrm;AnyDAC_PhysASA_D17;inetdbxpress;webdsnap;NxCollectionRun_dxe3;AnyDAC_PhysOracle_D17;dxSkinCoffeeRS17;adortl;dxSkinscxSchedulerPainterRS17;JvWizards;NxCollectionDsgn_dxe3;NxCommonDsgn_dxe3;dxtrmdRS17;dxPScxPCProdRS17;AnyDAC_GUIxForms_D17;JvBands;rtl;DbxClientDriver;AnyDAC_PhysTDBX_D17;dxTabbedMDIRS17;dxComnRS17;dxSkinSharpPlusRS17;dxSkinsCoreRS17;dxSkinLondonLiquidSkyRS17;dxdbtrRS17;Tee;NxAddonsRun_dxe3;JvSystem;dxorgcRS17;dxSkinBlackRS17;JvControls;NxSheetRun_dxe3;IndyProtocols;DBXMySQLDriver;dxLayoutControlRS17;bindcompdbx;TeeUI;JvJans;JvPrintPreview;JvPageComps;JvStdCtrls;JvCustom;dxSkinOffice2007BlueRS17;dxPScxPivotGridLnkRS17;dxSpellCheckerRS17;vcltouch;dxSkinOffice2007GreenRS17;dxSkinSharpRS17;websnap;dxSkinFoggyRS17;dxTileControlRS17;VclSmp;dxSkinDarkSideRS17;cxPivotGridRS17;DataSnapConnectors;AnyDAC_Phys_D17;fmxobj;SynEdit_RXE3;cxTreeListRS17;dxPSdxFCLnkRS17;dxSkinGlassOceansRS17;dxFlowChartRS17;fmxdae;dxSkinsdxNavBarPainterRS17;DataSnapIndy10ServerTransport;dxDBXServerModeRS17;dxSkinCaramelRS17;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_MapFile>3</DCC_MapFile>
<DCC_ConsoleTarget>true</DCC_ConsoleTarget>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_RemoteDebug>false</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="WebModuleUnit1.pas">
<Form>WebModule1</Form>
<DesignClass>TWebModule</DesignClass>
</DCCReference>
<DCCReference Include="AppControllerU.pas"/>
<DCCReference Include="MiddlewareSample1.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1040</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
<VersionInfoKeys Name="CFBundleName"/>
<VersionInfoKeys Name="CFBundleDisplayName"/>
<VersionInfoKeys Name="CFBundleIdentifier"/>
<VersionInfoKeys Name="CFBundleVersion"/>
<VersionInfoKeys Name="CFBundlePackageType"/>
<VersionInfoKeys Name="CFBundleSignature"/>
<VersionInfoKeys Name="CFBundleAllowMixedLocalizations"/>
<VersionInfoKeys Name="CFBundleExecutable"/>
</VersionInfoKeys>
<Source>
<Source Name="MainSource">MiddlewareSamples.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k250.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp250.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k250.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp250.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="4"/>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

2
sources/MVCFramework.Filters.Action.pas
View File

@ -6,7 +6,7 @@ uses
MVCFramework, MVCFramework.Router, MVCFramework.Commons, System.RTTI;
type
TMVCActionControllerFilter = class(TControllerFilter)
TMVCActionControllerFilter = class(TCustomControllerFilter)
private const
ALLOWED_TYPED_ACTION_PARAMETERS_TYPES =
'Integer, Int64, Single, Double, Extended, Boolean, TDate, TTime, TDateTime, String and TGUID';

90
sources/MVCFramework.Filters.Authentication.RoleBasedAuthHandler.pas
View File

@ -86,20 +86,6 @@ type
destructor Destroy; override;
end;
// TMVCRoleBasedAuthMiddleware = class(TMVCCustomAuthenticationMiddleware, IMVCMiddleware)
// private
// fAuthenticationHandler: IMVCRoleBasedAuthenticationHandler;
// procedure DoRoleBasedBeforeControllerAction(const AContext: TWebContext;
// const aHandler: IMVCRoleBasedAuthenticationHandler; const AControllerQualifiedClassName: string;
// const AActionName: string; var AHandled: Boolean);
// protected
// procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string;
// const AActionName: string; var AHandled: Boolean); override;
// public
// constructor Create(const AAuthenticationHandler: IMVCAuthenticationHandler;
// const ALoginUrl: string = '/system/users/logged'); override;
// end;
implementation
uses
@ -306,80 +292,4 @@ begin
end;
end;
{ TMVCRoleBasedAuthMiddleware }
//constructor TMVCRoleBasedAuthMiddleware.Create(const AAuthenticationHandler: IMVCAuthenticationHandler;
// const ALoginUrl: string);
//begin
// inherited Create(AAuthenticationHandler, ALoginUrl);
// Supports(AAuthenticationHandler, IMVCRoleBasedAuthenticationHandler, fAuthenticationHandler);
//end;
//procedure TMVCRoleBasedAuthMiddleware.DoRoleBasedBeforeControllerAction(const AContext: TWebContext;
// const aHandler: IMVCRoleBasedAuthenticationHandler; const AControllerQualifiedClassName: string;
// const AActionName: string; var AHandled: Boolean);
//var
// IsValid: Boolean;
// IsAuthorized: Boolean;
// AuthRequired: Boolean;
//begin
// // This procedure is a basic copy of the inherited OnBeforeControllerAction procedure.
// // Extention is by enabling the Authorization based on the context the call is being performed.
// aHandler.OnRequest(nil, AControllerQualifiedClassName, AActionName, AuthRequired);
// if not AuthRequired then
// begin
// AHandled := False;
// Exit;
// end;
//
// AContext.LoggedUser.LoadFromSession(AContext.Session);
// IsValid := AContext.LoggedUser.IsValid;
// if not IsValid then
// begin
// AContext.SessionStop(False);
// SendResponse(AContext, AHandled);
// Exit;
// end;
//
// IsAuthorized := False;
//
// // Modification here from:
// // FAuthenticationHandler.OnAuthorization(AContext.LoggedUser.Roles, AControllerQualifiedClassName, AActionName, IsAuthorized);
// // to:
// aHandler.OnAuthorization(AContext, AContext.LoggedUser.Roles, AControllerQualifiedClassName, AActionName,
// IsAuthorized);
// // Modification end
//
// if IsAuthorized then
// begin
// AHandled := False;
// end
// else
// begin
// if IsValid then
// begin
// SendResponse(AContext, AHandled, HTTP_STATUS.Forbidden)
// end
// else
// begin
// SendResponse(AContext, AHandled, HTTP_STATUS.Unauthorized);
// end;
// end;
//end;
//procedure TMVCRoleBasedAuthMiddleware.OnBeforeControllerAction(AContext: TWebContext;
// const AControllerQualifiedClassName, AActionName: string; var AHandled: Boolean);
//begin
// if Assigned(fAuthenticationHandler) then
// begin
// DoRoleBasedBeforeControllerAction(AContext, fAuthenticationHandler, AControllerQualifiedClassName,
// AActionName, AHandled)
// end
// else
// begin
// inherited OnBeforeControllerAction(AContext, AControllerQualifiedClassName, AActionName, AHandled);
// end;
//end;
end.

366
sources/MVCFramework.Filters.Authentication.pas
View File

@ -39,7 +39,7 @@ uses
type
TMVCBasicAuthenticationControllerFilter = class(TControllerFilter)
TMVCBasicAuthenticationControllerFilter = class(TCustomControllerFilter)
private
FAuthenticationHandler: IMVCAuthenticationHandler;
FRealm: string;
@ -52,43 +52,6 @@ type
); virtual;
end;
TMVCCustomAuthenticationMiddleware = class(TInterfacedObject, IMVCMiddleware)
private
FAuthenticationHandler: IMVCAuthenticationHandler;
FLoginUrl: string;
protected
procedure OnBeforeRouting(
AContext: TWebContext;
var AHandled: Boolean
);
procedure OnBeforeControllerAction(
AContext: TWebContext;
const AControllerQualifiedClassName: string;
const AActionName: string;
var AHandled: Boolean
); virtual;
procedure OnAfterControllerAction(
AContext: TWebContext;
const AControllerQualifiedClassName: string; const AActionName: string;
const AHandled: Boolean);
procedure OnAfterRouting(
AContext: TWebContext;
const AHandled: Boolean
);
procedure SendResponse(AContext: TWebContext; var AHandled: Boolean; AHttpStatus: Word = HTTP_STATUS.Unauthorized);
procedure DoLogin(AContext: TWebContext; var AHandled: Boolean);
procedure DoLogout(AContext: TWebContext; var AHandled: Boolean);
public
constructor Create(
const AAuthenticationHandler: IMVCAuthenticationHandler;
const ALoginUrl: string = '/system/users/logged'
); virtual;
end;
implementation
const
@ -252,331 +215,4 @@ begin
end;
end;
//procedure TMVCBasicAuthenticationControllerFilter.OnBeforeControllerAction(
// AContext: TWebContext;
// const AControllerQualifiedClassName, AActionName: string;
// var AHandled: Boolean);
//
// procedure SendWWWAuthenticate;
// begin
// AContext.LoggedUser.Clear;
// if AContext.Request.ClientAcceptHTML then
// begin
// AContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
// AContext.Response.RawWebResponse.Content :=
// Format(CONTENT_HTML_FORMAT, [CONTENT_401_NOT_AUTHORIZED, AContext.Config[TMVCConfigKey.ServerName]]);
// end
// else
// begin
// AContext.Response.ContentType := TMVCMediaType.TEXT_PLAIN;
// AContext.Response.RawWebResponse.Content := CONTENT_401_NOT_AUTHORIZED + sLineBreak + AContext.Config
// [TMVCConfigKey.ServerName];
// end;
// AContext.Response.StatusCode := HTTP_STATUS.Unauthorized;
// AContext.Response.SetCustomHeader('WWW-Authenticate', 'Basic realm=' + QuotedStr(FRealm));
// AContext.SessionStop(False);
// AHandled := True;
// end;
//
// procedure Send403Forbidden;
// begin
// AContext.LoggedUser.Clear;
// if AContext.Request.ClientAcceptHTML then
// begin
// AContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
// AContext.Response.RawWebResponse.Content :=
// Format(CONTENT_HTML_FORMAT, [CONTENT_403_FORBIDDEN, AContext.Config[TMVCConfigKey.ServerName]]);
// end
// else if AContext.Request.ContentMediaType.StartsWith(TMVCMediaType.APPLICATION_JSON) then
// begin
// AContext.Response.ContentType := TMVCMediaType.APPLICATION_JSON;
// AContext.Response.RawWebResponse.Content :=
// '{"status":"error", "message":"' + CONTENT_403_FORBIDDEN.Replace('"', '\"') + '"}';
// end
// else
// begin
// AContext.Response.ContentType := TMVCMediaType.TEXT_PLAIN;
// AContext.Response.RawWebResponse.Content := CONTENT_403_FORBIDDEN + sLineBreak + AContext.Config
// [TMVCConfigKey.ServerName];
// end;
// AContext.Response.StatusCode := HTTP_STATUS.Forbidden;
// AContext.Response.ReasonString := AContext.Config[TMVCConfigKey.ServerName];
// AHandled := True;
// end;
//
//var
// AuthRequired: Boolean;
// IsValid, IsAuthorized: Boolean;
// AuthHeader, Token: string;
// AuthPieces: TArray<string>;
// RolesList: TList<string>;
// SessionData: TSessionData;
// SessionPair: TPair<string, string>;
//begin
// FAuthenticationHandler.OnRequest(AContext, AControllerQualifiedClassName, AActionName, AuthRequired);
// if not AuthRequired then
// begin
// AHandled := False;
// Exit;
// end;
//
// AContext.LoggedUser.LoadFromSession(AContext.Session);
// IsValid := AContext.LoggedUser.IsValid;
// if not IsValid then
// begin
// AuthHeader := AContext.Request.Headers['Authorization'];
// if AuthHeader.IsEmpty or (not AuthHeader.StartsWith('Basic ', True)) then
// begin
// SendWWWAuthenticate;
// Exit;
// end;
// Token := AuthHeader.Remove(0, 'Basic '.Length).Trim;
// AuthHeader := TMVCSerializerHelper.DecodeString(Token);
// AuthPieces := AuthHeader.Split([':']);
// if Length(AuthPieces) <> 2 then
// begin
// SendWWWAuthenticate;
// Exit;
// end;
//
// RolesList := TList<string>.Create;
// try
// SessionData := TSessionData.Create;
// try
// FAuthenticationHandler.OnAuthentication(AContext, AuthPieces[0], AuthPieces[1], RolesList, IsValid,
// SessionData);
// if IsValid then
// begin
// AContext.LoggedUser.Roles.AddRange(RolesList);
// AContext.LoggedUser.UserName := AuthPieces[0];
// AContext.LoggedUser.LoggedSince := Now;
// AContext.LoggedUser.Realm := FRealm;
// AContext.LoggedUser.SaveToSession(AContext.Session);
// for SessionPair in SessionData do
// AContext.Session[SessionPair.Key] := SessionPair.Value;
// end;
// finally
// SessionData.Free;
// end;
// finally
// RolesList.Free;
// end;
// end;
//
// IsAuthorized := False;
// if IsValid then
// FAuthenticationHandler.OnAuthorization(AContext, AContext.LoggedUser.Roles, AControllerQualifiedClassName,
// AActionName, IsAuthorized);
//
// if IsAuthorized then
// AHandled := False
// else
// begin
// if IsValid then
// Send403Forbidden
// else
// begin
// SendWWWAuthenticate;
// end;
// end;
//end;
{ TMVCCustomAuthenticationMiddleware }
constructor TMVCCustomAuthenticationMiddleware.Create(
const AAuthenticationHandler: IMVCAuthenticationHandler;
const ALoginUrl: string);
begin
inherited Create;
FAuthenticationHandler := AAuthenticationHandler;
FLoginUrl := ALoginUrl.ToLower;
end;
procedure TMVCCustomAuthenticationMiddleware.DoLogin(
AContext: TWebContext;
var AHandled: Boolean);
var
Jo: TJSONObject;
UserName, Password: string;
RolesList: TList<string>;
SessionPair: TPair<string, string>;
SessionData: TSessionData;
IsValid: Boolean;
begin
AContext.SessionStop(False);
AContext.LoggedUser.Clear;
if not AContext.Request.ThereIsRequestBody then
begin
AHandled := True;
AContext.Response.StatusCode := HTTP_STATUS.BadRequest;
AContext.Response.ContentType := TMVCMediaType.APPLICATION_JSON;
AContext.Response.RawWebResponse.Content :=
'{"status":"error", "message":"username and password are mandatory in the body request as json object"}';
Exit;
end;
Jo := TJSONObject.ParseJSONValue(AContext.Request.Body) as TJSONObject;
try
if not Assigned(Jo) then
begin
AHandled := True;
SendResponse(AContext, AHandled, HTTP_STATUS.BadRequest);
Exit;
end;
UserName := EmptyStr;
if (Jo.Get('username') <> nil) then
UserName := Jo.Get('username').JsonValue.Value;
Password := EmptyStr;
if (Jo.Get('password') <> nil) then
Password := Jo.Get('password').JsonValue.Value;
if UserName.IsEmpty or Password.IsEmpty then
begin
AHandled := True;
SendResponse(AContext, AHandled);
Exit;
end;
RolesList := TList<string>.Create;
try
SessionData := TSessionData.Create;
try
IsValid := False;
FAuthenticationHandler.OnAuthentication(AContext, UserName, Password, RolesList, IsValid, SessionData);
if not IsValid then
begin
SendResponse(AContext, AHandled);
Exit;
end;
AContext.LoggedUser.Roles.AddRange(RolesList);
AContext.LoggedUser.UserName := UserName;
AContext.LoggedUser.LoggedSince := Now;
AContext.LoggedUser.Realm := 'custom';
AContext.LoggedUser.SaveToSession(AContext.Session);
for SessionPair in SessionData do
AContext.Session[SessionPair.Key] := SessionPair.Value;
AContext.Response.StatusCode := HTTP_STATUS.OK;
AContext.Response.CustomHeaders.Values['X-LOGOUT-URL'] := FLoginUrl;
AContext.Response.CustomHeaders.Values['X-LOGOUT-METHOD'] := 'DELETE';
AContext.Response.ContentType := TMVCMediaType.APPLICATION_JSON;
AContext.Response.RawWebResponse.Content := '{"status":"OK"}';
AHandled := True;
finally
SessionData.Free;
end;
finally
RolesList.Free;
end;
finally
Jo.Free;
end;
end;
procedure TMVCCustomAuthenticationMiddleware.DoLogout(
AContext: TWebContext; var AHandled: Boolean);
begin
AContext.SessionStop(False);
SendResponse(AContext, AHandled, HTTP_STATUS.OK);
end;
procedure TMVCCustomAuthenticationMiddleware.OnAfterControllerAction(
AContext: TWebContext;
const AControllerQualifiedClassName: string; const AActionName: string;
const AHandled: Boolean);
begin
// Implement as needed
end;
procedure TMVCCustomAuthenticationMiddleware.OnAfterRouting(AContext: TWebContext; const AHandled: Boolean);
begin
end;
procedure TMVCCustomAuthenticationMiddleware.OnBeforeControllerAction(
AContext: TWebContext;
const AControllerQualifiedClassName, AActionName: string;
var AHandled: Boolean);
var
IsValid: Boolean;
IsAuthorized: Boolean;
AuthRequired: Boolean;
begin
FAuthenticationHandler.OnRequest(AContext, AControllerQualifiedClassName, AActionName, AuthRequired);
if not AuthRequired then
begin
AHandled := False;
Exit;
end;
AContext.LoggedUser.LoadFromSession(AContext.Session);
IsValid := AContext.LoggedUser.IsValid;
if not IsValid then
begin
AContext.SessionStop(False);
SendResponse(AContext, AHandled);
Exit;
end;
IsAuthorized := False;
FAuthenticationHandler.OnAuthorization(AContext, AContext.LoggedUser.Roles, AControllerQualifiedClassName,
AActionName, IsAuthorized);
if IsAuthorized then
AHandled := False
else
begin
if IsValid then
SendResponse(AContext, AHandled, HTTP_STATUS.Forbidden)
else
SendResponse(AContext, AHandled, HTTP_STATUS.Unauthorized);
end;
end;
procedure TMVCCustomAuthenticationMiddleware.OnBeforeRouting(
AContext: TWebContext; var AHandled: Boolean);
begin
if (AContext.Request.PathInfo.ToLower = FLoginUrl) then
begin
AHandled := False;
if (AContext.Request.HTTPMethod = httpPOST) and
(AContext.Request.ContentType.StartsWith(TMVCMediaType.APPLICATION_JSON)) then
DoLogin(AContext, AHandled);
if (AContext.Request.HTTPMethod = httpDELETE) then
DoLogout(AContext, AHandled);
end;
end;
procedure TMVCCustomAuthenticationMiddleware.SendResponse(
AContext: TWebContext; var AHandled: Boolean; AHttpStatus: Word);
var
IsPositive: Boolean;
Msg: string;
begin
AContext.LoggedUser.Clear;
AContext.Response.CustomHeaders.Values['X-LOGIN-URL'] := FLoginUrl;
AContext.Response.CustomHeaders.Values['X-LOGIN-METHOD'] := 'POST';
AContext.Response.StatusCode := AHttpStatus;
if AContext.Request.ClientAcceptHTML then
begin
AContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
AContext.Response.RawWebResponse.Content :=
Format(CONTENT_HTML_FORMAT, [IntToStr(AHttpStatus), AContext.Config[TMVCConfigKey.ServerName]]);
end
else
begin
IsPositive := (AHttpStatus div 100) = 2;
Msg := IfThen(IsPositive, 'OK', 'KO');
AContext.Response.ContentType := TMVCMediaType.APPLICATION_JSON;
AContext.Response.RawWebResponse.Content := '{"status":"' + Msg + '", "message":"' + IntToStr(AHttpStatus) + '"}';
end;
AHandled := True;
end;
end.

2
sources/MVCFramework.Filters.Compression.pas
View File

@ -33,7 +33,7 @@ uses
MVCFramework.Logger;
type
TMVCCompressionProtocolFilter = class(TProtocolFilter)
TMVCCompressionProtocolFilter = class(TCustomProtocolFilter)
private
fCompressionThreshold: Integer;
protected

6
sources/MVCFramework.Filters.JWT.pas
View File

@ -65,7 +65,7 @@ type
TJWTClaimsSetup = reference to procedure(const JWT: TJWT);
TMVCJWTProtocolFilter = class(TProtocolFilter)
TMVCJWTProtocolFilter = class(TCustomProtocolFilter)
private
FAuthenticationHandler: IMVCAuthenticationHandler;
FClaimsToChecks: TJWTCheckableClaims;
@ -88,7 +88,7 @@ type
procedure OnAfterRegistration(Engine: TMVCEngine); override;
type
TMVCJWTControllerFilter = class(TControllerFilter)
TMVCJWTControllerFilter = class(TCustomControllerFilter)
protected
FAuthorizationHeaderName: string;
FAuthorizationAccessToken: string;
@ -124,7 +124,7 @@ type
var AAccepted: Boolean);
TMVCOnNewJWTToBlackList = reference to procedure(AContext: TWebContext; AJWTToken: String);
TMVCJWTBlackListProtocolFilter = class(TProtocolFilter)
TMVCJWTBlackListProtocolFilter = class(TCustomProtocolFilter)
private
fOnAcceptToken: TMVCOnAcceptTokenProc;
fOnNewJWTToBlackList: TMVCOnNewJWTToBlackList;

2
sources/MVCFramework.Filters.Router.pas
View File

@ -42,7 +42,7 @@ type
end;
TMVCRouterFilter = class(TProtocolFilter)
TMVCRouterFilter = class(TCustomProtocolFilter)
private
fEngine: TMVCEngine;
fConfig: TMVCConfig;

2
sources/MVCFramework.Filters.StaticFiles.pas
View File

@ -58,7 +58,7 @@ type
TMVCStaticFileRulesProc = reference to procedure(const Context: TWebContext; var PathInfo: String; var Handled: Boolean);
TMVCStaticFileMediaTypesCustomizer = reference to procedure(const MediaTypes: TMVCStringDictionary);
TMVCStaticFilesProtocolFilter = class(TProtocolFilter)
TMVCStaticFilesProtocolFilter = class(TCustomProtocolFilter)
private
fSanityCheckOK: Boolean;
fMediaTypes: TMVCStringDictionary;

20
sources/MVCFramework.pas
View File

@ -982,7 +982,7 @@ type
function Build(const Engine: TMVCEngine): IControllerFilterChain;
end;
TProtocolFilter = class abstract(TInterfacedObject, IProtocolFilter)
TCustomProtocolFilter = class abstract(TInterfacedObject, IProtocolFilter)
private
fNext: IProtocolFilter;
protected
@ -1016,7 +1016,7 @@ type
function Build(const Engine: TMVCEngine): IControllerFilterChain;
end;
TControllerFilter = class abstract(TInterfacedObject, IControllerFilter)
TCustomControllerFilter = class abstract(TInterfacedObject, IControllerFilter)
private
fNext: IControllerFilter;
fEngine: TMVCEngine;
@ -3904,7 +3904,7 @@ end;
{ TFilter }
procedure TProtocolFilter.DoNext(Context: TWebContext);
procedure TCustomProtocolFilter.DoNext(Context: TWebContext);
begin
if Assigned(fNext) then
begin
@ -3912,12 +3912,12 @@ begin
end;
end;
procedure TProtocolFilter.OnAfterRegistration(Engine: TMVCEngine);
procedure TCustomProtocolFilter.OnAfterRegistration(Engine: TMVCEngine);
begin
//do nothing
end;
procedure TProtocolFilter.SetNext(NextFilter: IProtocolFilter);
procedure TCustomProtocolFilter.SetNext(NextFilter: IProtocolFilter);
begin
fNext := NextFilter;
end;
@ -3996,9 +3996,9 @@ begin
Result := Self;
end;
{ TControllerFilter }
{ TCustomControllerFilter }
procedure TControllerFilter.DoNext(
procedure TCustomControllerFilter.DoNext(
Context: TWebContext;
const Router: IMVCRouter);
begin
@ -4008,17 +4008,17 @@ begin
end;
end;
function TControllerFilter.GetEngine: TMVCEngine;
function TCustomControllerFilter.GetEngine: TMVCEngine;
begin
Result := fEngine;
end;
procedure TControllerFilter.SetEngine(const Engine: TMVCEngine);
procedure TCustomControllerFilter.SetEngine(const Engine: TMVCEngine);
begin
fEngine := Engine;
end;
procedure TControllerFilter.SetNext(NextFilter: IControllerFilter);
procedure TCustomControllerFilter.SetNext(NextFilter: IControllerFilter);
begin
fNext := NextFilter;
end;

316
unittests/general/Several/LiveServerTestU.pas
View File

@ -179,16 +179,16 @@ type
[Test]
procedure TestBasicAuth05;
// test authentication/authorization with CustomAuth
[Test]
procedure TestCustomAuthRequestWithoutLogin;
[Test]
procedure TestCustomAuthRequestsWithValidLogin;
[Test]
procedure TestCustomAuthRequestsWithValidLogin_HTML;
[Test]
procedure TestCustomAuthWrongRequestBodies;
[Test]
procedure TestCustomAuthLoginLogout;
// [Test]
// procedure TestCustomAuthRequestWithoutLogin;
// [Test]
// procedure TestCustomAuthRequestsWithValidLogin;
// [Test]
// procedure TestCustomAuthRequestsWithValidLogin_HTML;
// [Test]
// procedure TestCustomAuthWrongRequestBodies;
// [Test]
// procedure TestCustomAuthLoginLogout;
// typed actions
[Test]
@ -713,125 +713,125 @@ begin
end;
procedure TServerTest.TestCustomAuthRequestWithoutLogin;
var
lRes: IMVCRESTResponse;
begin
lRes := RESTClient.Get('/privatecustom/role1');
Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode);
Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGIN-URL'));
Assert.areEqual('POST', lRes.HeaderValue('X-LOGIN-METHOD'));
//procedure TServerTest.TestCustomAuthRequestWithoutLogin;
//var
// lRes: IMVCRESTResponse;
//begin
// lRes := RESTClient.Get('/privatecustom/role1');
// Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode);
// Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGIN-URL'));
// Assert.areEqual('POST', lRes.HeaderValue('X-LOGIN-METHOD'));
//
// lRes := RESTClient.Get('/privatecustom/role2');
// Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode);
// Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGIN-URL'));
// Assert.areEqual('POST', lRes.HeaderValue('X-LOGIN-METHOD'));
//end;
lRes := RESTClient.Get('/privatecustom/role2');
Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode);
Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGIN-URL'));
Assert.areEqual('POST', lRes.HeaderValue('X-LOGIN-METHOD'));
end;
//procedure TServerTest.TestCustomAuthRequestsWithValidLogin;
//var
// lRes: IMVCRESTResponse;
// lJSON: System.JSON.TJSONObject;
// lCookieValue: string;
//begin
// lJSON := System.JSON.TJSONObject.Create;
// try
// lJSON.AddPair('username', 'user1');
// lJSON.AddPair('password', 'user1');
// lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
// Assert.areEqual('application/json', lRes.ContentType);
// Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
// Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGOUT-URL'));
// Assert.areEqual('DELETE', lRes.HeaderValue('X-LOGOUT-METHOD'));
// Assert.areEqual('{"status":"OK"}', lRes.Content);
// lCookieValue := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
// Assert.AreNotEqual('', lCookieValue, 'Session cookie not returned after login');
// Assert.IsFalse(lCookieValue.Contains('invalid'), 'Returned an invalid session token');
//
// lRes := RESTClient.Get('/privatecustom/role2');
// Assert.areEqual<Integer>(HTTP_STATUS.Forbidden, lRes.StatusCode,
// 'Authorization not respected for not allowed action');
//
// lRes := RESTClient.Get('/privatecustom/role1');
// Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode,
// 'Authorization not respected for allowed action');
// finally
// lJSON.Free;
// end;
//end;
procedure TServerTest.TestCustomAuthRequestsWithValidLogin;
var
lRes: IMVCRESTResponse;
lJSON: System.JSON.TJSONObject;
lCookieValue: string;
begin
lJSON := System.JSON.TJSONObject.Create;
try
lJSON.AddPair('username', 'user1');
lJSON.AddPair('password', 'user1');
lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
Assert.areEqual('application/json', lRes.ContentType);
Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGOUT-URL'));
Assert.areEqual('DELETE', lRes.HeaderValue('X-LOGOUT-METHOD'));
Assert.areEqual('{"status":"OK"}', lRes.Content);
lCookieValue := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
Assert.AreNotEqual('', lCookieValue, 'Session cookie not returned after login');
Assert.IsFalse(lCookieValue.Contains('invalid'), 'Returned an invalid session token');
//procedure TServerTest.TestCustomAuthRequestsWithValidLogin_HTML;
//var
// lRes: IMVCRESTResponse;
// lJSON: System.JSON.TJSONObject;
// lCookieValue: string;
// lContentType: string;
// lContentCharset: string;
//begin
// lJSON := System.JSON.TJSONObject.Create;
// try
// lJSON.AddPair('username', 'user1');
// lJSON.AddPair('password', 'user1');
// lRes := RESTClient.Accept('text/html').Post('/system/users/logged',
// TSystemJSON.JSONValueToString(lJSON, false));
// SplitContentMediaTypeAndCharset(lRes.ContentType, lContentType, lContentCharset);
// Assert.areEqual(lContentType, TMVCMediaType.APPLICATION_JSON);
// Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
// Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGOUT-URL'));
// Assert.areEqual('DELETE', lRes.HeaderValue('X-LOGOUT-METHOD'));
// Assert.areEqual('{"status":"OK"}', lRes.Content);
// lCookieValue := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
// Assert.AreNotEqual('', lCookieValue, 'Session cookie not returned after login');
// Assert.IsFalse(lCookieValue.Contains('invalid'), 'Returned an invalid session token');
//
// lRes := RESTClient.Get('/privatecustom/role2');
// Assert.areEqual<Integer>(HTTP_STATUS.Forbidden, lRes.StatusCode,
// 'Authorization not respected for not allowed action');
//
// lRes := RESTClient.Get('/privatecustom/role1');
// Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode,
// 'Authorization not respected for allowed action');
// finally
// lJSON.Free;
// end;
//end;
lRes := RESTClient.Get('/privatecustom/role2');
Assert.areEqual<Integer>(HTTP_STATUS.Forbidden, lRes.StatusCode,
'Authorization not respected for not allowed action');
lRes := RESTClient.Get('/privatecustom/role1');
Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode,
'Authorization not respected for allowed action');
finally
lJSON.Free;
end;
end;
procedure TServerTest.TestCustomAuthRequestsWithValidLogin_HTML;
var
lRes: IMVCRESTResponse;
lJSON: System.JSON.TJSONObject;
lCookieValue: string;
lContentType: string;
lContentCharset: string;
begin
lJSON := System.JSON.TJSONObject.Create;
try
lJSON.AddPair('username', 'user1');
lJSON.AddPair('password', 'user1');
lRes := RESTClient.Accept('text/html').Post('/system/users/logged',
TSystemJSON.JSONValueToString(lJSON, false));
SplitContentMediaTypeAndCharset(lRes.ContentType, lContentType, lContentCharset);
Assert.areEqual(lContentType, TMVCMediaType.APPLICATION_JSON);
Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGOUT-URL'));
Assert.areEqual('DELETE', lRes.HeaderValue('X-LOGOUT-METHOD'));
Assert.areEqual('{"status":"OK"}', lRes.Content);
lCookieValue := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
Assert.AreNotEqual('', lCookieValue, 'Session cookie not returned after login');
Assert.IsFalse(lCookieValue.Contains('invalid'), 'Returned an invalid session token');
lRes := RESTClient.Get('/privatecustom/role2');
Assert.areEqual<Integer>(HTTP_STATUS.Forbidden, lRes.StatusCode,
'Authorization not respected for not allowed action');
lRes := RESTClient.Get('/privatecustom/role1');
Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode,
'Authorization not respected for allowed action');
finally
lJSON.Free;
end;
end;
procedure TServerTest.TestCustomAuthWrongRequestBodies;
var
lRes: IMVCRESTResponse;
lJSON: System.JSON.TJSONObject;
begin
lJSON := System.JSON.TJSONObject.Create;
try
// no request body
lRes := RESTClient.AddBody('', TMVCMediaType.APPLICATION_JSON).Post('/system/users/logged');
Assert.areEqual<Integer>(HTTP_STATUS.BadRequest, lRes.StatusCode,
'Empty request body doesn''t return HTTP 400 Bad Request');
// wrong request body 1
lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode,
'Invalid json doesn''t return HTTP 401 Unauthorized');
// wrong request body 2
lJSON.AddPair('username', '');
lJSON.AddPair('password', '');
lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode,
'Empty username and password doesn''t return HTTP 401 Unauthorized');
// wrong username and password 3
lJSON.RemovePair('username').Free;
lJSON.RemovePair('password').Free;
lJSON.AddPair('username', 'notvaliduser');
lJSON.AddPair('password', 'notvalidpassword');
lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode,
'Wrong username and password doesn''t return HTTP 401 Unauthorized');
finally
lJSON.Free;
end;
end;
//procedure TServerTest.TestCustomAuthWrongRequestBodies;
//var
// lRes: IMVCRESTResponse;
// lJSON: System.JSON.TJSONObject;
//begin
// lJSON := System.JSON.TJSONObject.Create;
// try
// // no request body
// lRes := RESTClient.AddBody('', TMVCMediaType.APPLICATION_JSON).Post('/system/users/logged');
// Assert.areEqual<Integer>(HTTP_STATUS.BadRequest, lRes.StatusCode,
// 'Empty request body doesn''t return HTTP 400 Bad Request');
//
// // wrong request body 1
// lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
// Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode,
// 'Invalid json doesn''t return HTTP 401 Unauthorized');
//
// // wrong request body 2
// lJSON.AddPair('username', '');
// lJSON.AddPair('password', '');
// lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
// Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode,
// 'Empty username and password doesn''t return HTTP 401 Unauthorized');
//
// // wrong username and password 3
// lJSON.RemovePair('username').Free;
// lJSON.RemovePair('password').Free;
// lJSON.AddPair('username', 'notvaliduser');
// lJSON.AddPair('password', 'notvalidpassword');
// lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
// Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode,
// 'Wrong username and password doesn''t return HTTP 401 Unauthorized');
// finally
// lJSON.Free;
// end;
//end;
procedure TServerTest.TestCustomerEcho;
var
@ -995,38 +995,38 @@ begin
end;
end;
procedure TServerTest.TestCustomAuthLoginLogout;
var
lRes: IMVCRESTResponse;
lJSON: System.JSON.TJSONObject;
lLogoutUrl: string;
lPass: boolean;
lCookie: TCookie;
begin
lJSON := System.JSON.TJSONObject.Create;
try
lJSON.AddPair('username', 'user1');
lJSON.AddPair('password', 'user1');
lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
lLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL');
lRes := RESTClient.Delete(lLogoutUrl);
lPass := false;
for lCookie in lRes.Cookies do
begin
if lCookie.Value.Contains('invalid') then
begin
lPass := true;
Break;
end;
end;
Assert.isTrue(lPass, 'No session cookie cleanup in the response');
finally
lJSON.Free;
end;
end;
//procedure TServerTest.TestCustomAuthLoginLogout;
//var
// lRes: IMVCRESTResponse;
// lJSON: System.JSON.TJSONObject;
// lLogoutUrl: string;
// lPass: boolean;
// lCookie: TCookie;
//begin
// lJSON := System.JSON.TJSONObject.Create;
// try
// lJSON.AddPair('username', 'user1');
// lJSON.AddPair('password', 'user1');
// lRes := RESTClient.Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
//
// Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
// lLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL');
//
// lRes := RESTClient.Delete(lLogoutUrl);
// lPass := false;
// for lCookie in lRes.Cookies do
// begin
// if lCookie.Value.Contains('invalid') then
// begin
// lPass := true;
// Break;
// end;
// end;
// Assert.isTrue(lPass, 'No session cookie cleanup in the response');
// finally
// lJSON.Free;
// end;
//end;
procedure TServerTest.TestEchoWithAllVerbs;
var

2
unittests/general/TestServer/SpeedProtocolFilterU.pas
View File

@ -30,7 +30,7 @@ uses
MVCFramework;
type
TSpeedProtocolFilter = class(TProtocolFilter)
TSpeedProtocolFilter = class(TCustomProtocolFilter)
protected
procedure DoFilter(Context: TWebContext); override;
end;

1
unittests/general/TestServer/WebModuleUnit.pas
View File

@ -133,7 +133,6 @@ begin
end)
.UseFilter(TMVCBasicAuthenticationControllerFilter.Create(TBasicAuthHandler.Create))
.UseFilter(TSpeedProtocolFilter.Create)
// .UseFilter(TMVCCustomAuthenticationMiddleware.Create(TCustomAuthHandler.Create, '/system/users/logged'))
.UseFilter(TMVCStaticFilesProtocolFilter.Create('/static', 'www', 'index.html', False))
.UseFilter(TMVCStaticFilesProtocolFilter.Create('/spa', 'www', 'index.html', True))
.UseFilter(TMVCCompressionProtocolFilter.Create);