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

Session refactoring

Browse Source 
Now session is available also with Context.Session
This commit is contained in:
danieleteti 2016-04-03 22:35:27 +02:00
parent ca0e79a27b
commit cacdabdbb7
9 changed files with 208 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
sources/MVCFramework.Middleware.Authentication.pas
View File

@ -50,7 +50,12 @@ type
implementation
uses
System.SysUtils, MVCFramework.Session, Soap.EncdDecd;
System.SysUtils, MVCFramework.Session
{$IF CompilerVersion >= 21}
, System.NetEncoding
{$ELSE}
, Soap.EncdDecd
{$ENDIF};
{
@ -61,11 +66,20 @@ uses
}
const
CONTENT_HTML_FORMAT = '<html><body><h1>%s</h1></body></html>';
CONTENT_HTML_FORMAT = '<html><body><h1>%s</h1><p>%s</p></body></html>';
CONTENT_401_NOT_AUTHORIZED = '401: Not authorized';
CONTENT_403_FORBIDDEN = '403: Forbidden';
{ TMVCSalutationMiddleware }
function Base64DecodeString(const Value: String): String; inline;
begin
{$IF CompilerVersion >= 21}
Result := TNetEncoding.Base64.Decode(Value);
{$ELSE}
Result := DecodeString(Value);
{$ENDIF}
end;
{ TMVCSalutationMiddleware }
constructor TMVCBasicAuthenticationMiddleware.Create(AMVCAuthenticationHandler
: IMVCAuthenticationHandler; Realm: string);
@ -78,7 +92,7 @@ end;
procedure TMVCBasicAuthenticationMiddleware.OnAfterControllerAction
(Context: TWebContext; const AActionName: string; const Handled: Boolean);
begin
// do nothing
end;
procedure TMVCBasicAuthenticationMiddleware.OnBeforeControllerAction
@ -89,10 +103,7 @@ var
LPieces: TArray<string>;
LRoles: TList<string>;
LIsValid: Boolean;
LWebSession: TWebSession;
LSessionID: string;
LIsAuthorized: Boolean;
LSessionIDFromWebRequest: string;
LAuthRequired: Boolean;
LSessionData: TSessionData;
LPair: TPair<String, String>;
@ -103,12 +114,12 @@ var
begin
Context.Response.ContentType := 'text/html';
Context.Response.RawWebResponse.Content :=
Format(CONTENT_HTML_FORMAT, [CONTENT_401_NOT_AUTHORIZED]);
Format(CONTENT_HTML_FORMAT, [CONTENT_401_NOT_AUTHORIZED, Context.Config[TMVCConfigKey.ServerName]]);
end
else
begin
Context.Response.ContentType := 'text/plain';
Context.Response.RawWebResponse.Content := CONTENT_401_NOT_AUTHORIZED;
Context.Response.RawWebResponse.Content := CONTENT_401_NOT_AUTHORIZED + sLineBreak + Context.Config[TMVCConfigKey.ServerName];
end;
Context.Response.StatusCode := 401;
Context.Response.SetCustomHeader('WWW-Authenticate',
@ -124,12 +135,12 @@ var
begin
Context.Response.ContentType := 'text/html';
Context.Response.RawWebResponse.Content :=
Format(CONTENT_HTML_FORMAT, [CONTENT_403_FORBIDDEN]);
Format(CONTENT_HTML_FORMAT, [CONTENT_403_FORBIDDEN, Context.Config[TMVCConfigKey.ServerName]]);
end
else
begin
Context.Response.ContentType := 'text/plain';
Context.Response.RawWebResponse.Content := CONTENT_403_FORBIDDEN;
Context.Response.RawWebResponse.Content := CONTENT_403_FORBIDDEN + sLineBreak + Context.Config[TMVCConfigKey.ServerName];
end;
Context.Response.StatusCode := 403;
Handled := true;
@ -145,35 +156,12 @@ begin
Exit;
end;
LSessionIDFromWebRequest := TMVCEngine.ExtractSessionIDFromWebRequest
(Context.Request.RawWebRequest);
LWebSession := TMVCEngine.GetCurrentSession
(Context.Config.AsInt64[TMVCConfigKey.SessionTimeout],
LSessionIDFromWebRequest, False);
// if (not LSessionIDFromWebRequest.IsEmpty) and (not Assigned(LWebSession)) then
// begin
// SendWWWAuthenticate;
// // Exit;
// // The sessionid is present but is not valid and there is an authentication header.
// // In this case, an exception is raised because the sessionid is not valid
// // raise EMVCSessionExpiredException.Create('Session expired');
// end;
Context.LoggedUser.LoadFromSession(LWebSession);
Context.LoggedUser.LoadFromSession(Context.Session);
if not Context.LoggedUser.IsValid then
begin
// check if the resource is protected
// FMVCAuthenticationHandler.OnRequest(AControllerQualifiedClassName, AActionName, LAuthRequired);
// if not LAuthRequired then
// begin
// Handled := False;
// Exit;
// end;
// We NEED authentication
LAuth := Context.Request.Headers['Authorization'];
LAuth := DecodeString(LAuth.Remove(0, 'Basic'.Length).Trim);
LAuth := Base64DecodeString(LAuth.Remove(0, 'Basic'.Length).Trim);
LPieces := LAuth.Split([':']);
if LAuth.IsEmpty or (Length(LPieces) <> 2) then
begin
@ -195,14 +183,12 @@ begin
Context.LoggedUser.UserName := LPieces[0];
Context.LoggedUser.LoggedSince := Now;
Context.LoggedUser.Realm := FRealm;
LSessionID := TMVCEngine.SendSessionCookie(Context);
LWebSession := TMVCEngine.AddSessionToTheSessionList(LSessionID,
Context.Config.AsInt64[TMVCConfigKey.SessionTimeout]);
Context.LoggedUser.SaveToSession(LWebSession);
Context.LoggedUser.SaveToSession(Context.Session);
// save sessiondata to the actual session
for LPair in LSessionData do
begin
LWebSession[LPair.Key] := LPair.Value;
Context.Session[LPair.Key] := LPair.Value;
end;
end;
finally
@ -235,7 +221,7 @@ end;
procedure TMVCBasicAuthenticationMiddleware.OnBeforeRouting
(Context: TWebContext; var Handled: Boolean);
begin
// do nothing
end;
end.

2
sources/MVCFramework.Session.pas
View File

@ -2,7 +2,7 @@
{ }
{ Delphi MVC Framework }
{ }
{ Copyright (c) 2010-2015 Daniele Teti and the DMVCFramework Team }
{ Copyright (c) 2010-2016 Daniele Teti and the DMVCFramework Team }
{ }
{ https://github.com/danieleteti/delphimvcframework }
{ }

132
sources/MVCFramework.pas
View File

@ -2,7 +2,7 @@
{ }
{ Delphi MVC Framework }
{ }
{ Copyright (c) 2010-2015 Daniele Teti and the DMVCFramework Team }
{ Copyright (c) 2010-2016 Daniele Teti and the DMVCFramework Team }
{ }
{ https://github.com/danieleteti/delphimvcframework }
{ }
@ -279,19 +279,32 @@ type
FParamsTable: TMVCRequestParamsTable;
FData: TDictionary<string, string>;
FLoggedUser: TUser;
FWebSession: TWebSession;
FIsSessionStarted: boolean;
FSessionMustBeClose: boolean;
function GetData: TDictionary<string, string>;
function GetWebSession: TWebSession;
protected
function SessionMustBeClose: boolean;
function IsSessionStarted: boolean;
constructor Create(ARequest: TWebRequest; AResponse: TWebResponse;
AConfig: TMVCConfig); virtual;
procedure SetParams(AParamsTable: TMVCRequestParamsTable);
procedure Flush;
function GetLoggedUser: TUser;
// Session
procedure SessionStart; virtual;
procedure BindToSession(SessionID: string);
function SendSessionCookie(AContext: TWebContext): string;
public
ReservedData: TObject;
destructor Destroy; override;
procedure SessionStop(ARaiseExceptionIfExpired: boolean = true); virtual;
property LoggedUser: TUser read GetLoggedUser;
property Request: TMVCWebRequest read FRequest;
property Response: TMVCWebResponse read FResponse;
property Session: TWebSession read GetWebSession;
property Config: TMVCConfig read FConfig;
property Data: TDictionary<string, string> read GetData;
end;
@ -320,12 +333,9 @@ type
TMVCController = class(TMVCBase)
private
FIsSessionStarted: boolean;
FSessionMustBeClose: boolean;
FViewModel: TMVCDataObjects;
FViewDataSets: TObjectDictionary<string, TDataSet>;
FContext: TWebContext;
FWebSession: TWebSession;
FResponseStream: TStringBuilder;
FContentCharset: string;
procedure SetContext(const Value: TWebContext);
@ -365,11 +375,6 @@ type
property ContentType: string read GetContentType write SetContentType;
property ContentCharset: string read GetContentCharset
write SetContentCharset;
// Session
procedure SessionStart; virtual;
procedure SessionStop(ARaiseExceptionIfExpired: boolean = true); virtual;
procedure BindToSession(SessionID: string);
function SendSessionCookie(AContext: TWebContext): string;
// Renderers
procedure Render(const Content: string); overload; virtual;
procedure Render; overload; virtual;
@ -838,7 +843,7 @@ begin
end;
end;
if SelectedController.FSessionMustBeClose then
if Context.SessionMustBeClose then
begin
// SessionList.Remove(SelectedController.Session.SessionID);
end
@ -856,7 +861,7 @@ begin
on E: EMVCSessionExpiredException do
begin
LogException(E, E.DetailedMessage);
SelectedController.SessionStop(false);
Context.SessionStop(false);
SelectedController.ResponseStatusCode(E.HTTPErrorCode);
SelectedController.Render(E);
end;
@ -1154,6 +1159,8 @@ constructor TWebContext.Create(ARequest: TWebRequest; AResponse: TWebResponse;
AConfig: TMVCConfig);
begin
inherited Create;
FIsSessionStarted := false;
FSessionMustBeClose := false;
if IsLibrary then
begin
@ -1190,6 +1197,7 @@ begin
FreeAndNil(FRequest);
FreeAndNil(FData);
FreeAndNil(FLoggedUser);
// do not destroy session here... it is stored in the session list
inherited;
end;
@ -1212,6 +1220,38 @@ begin
Result := FLoggedUser;
end;
function TWebContext.GetWebSession: TWebSession;
begin
if not Assigned(FWebSession) then
begin
FWebSession := TMVCEngine.GetCurrentSession
(StrToInt64(FConfig[TMVCConfigKey.SessionTimeout]),
TMVCEngine.ExtractSessionIDFromWebRequest(FRequest.RawWebRequest), false);
if not Assigned(FWebSession) then
SessionStart
else
begin
TMVCEngine.SendSessionCookie(Self, FWebSession.SessionID);
// daniele
end;
end;
Result := FWebSession;
Result.MarkAsUsed;
{
LSessionIDFromWebRequest := TMVCEngine.ExtractSessionIDFromWebRequest
(Context.Request.RawWebRequest);
LWebSession := TMVCEngine.GetCurrentSession
(Context.Config.AsInt64[TMVCConfigKey.SessionTimeout],
LSessionIDFromWebRequest, False);
}
end;
function TWebContext.IsSessionStarted: boolean;
begin
Result := FIsSessionStarted;
end;
procedure TWebContext.SetParams(AParamsTable: TMVCRequestParamsTable);
begin
FParamsTable := AParamsTable;
@ -1542,17 +1582,16 @@ end;
{ TMVCAction }
procedure TMVCController.BindToSession(SessionID: string);
procedure TWebContext.BindToSession(SessionID: string);
begin
if not Assigned(FWebSession) then
begin
FWebSession := TMVCEngine.GetCurrentSession
(StrToInt64(GetMVCConfig[TMVCConfigKey.SessionTimeout]),
SessionID, false);
(StrToInt64(FConfig[TMVCConfigKey.SessionTimeout]), SessionID, false);
if not Assigned(FWebSession) then
raise EMVCException.Create('Invalid SessionID');
FWebSession.MarkAsUsed;
TMVCEngine.SendSessionCookie(FContext, SessionID);
TMVCEngine.SendSessionCookie(Self, SessionID);
end
else
raise EMVCException.Create('Session already bounded for this request');
@ -1561,8 +1600,6 @@ end;
constructor TMVCController.Create;
begin
inherited Create;
FIsSessionStarted := false;
FSessionMustBeClose := false;
FContentCharset := TMVCConstants.DEFAULT_CONTENT_CHARSET;
end;
@ -1680,21 +1717,7 @@ end;
function TMVCController.GetWebSession: TWebSession;
begin
if not Assigned(FWebSession) then
begin
FWebSession := TMVCEngine.GetCurrentSession
(StrToInt64(GetMVCConfig[TMVCConfigKey.SessionTimeout]),
TMVCEngine.ExtractSessionIDFromWebRequest
(FContext.Request.RawWebRequest), false);
if not Assigned(FWebSession) then
SessionStart
else
begin
TMVCEngine.SendSessionCookie(FContext, FWebSession.SessionID); //daniele
end;
end;
Result := FWebSession;
Result.MarkAsUsed;
Result := FContext.Session;
end;
procedure TMVCController.LoadView(const ViewNames: TArray<String>);
@ -1872,9 +1895,9 @@ begin
TMVCStaticContents.SendFile(AFileName, ContentType, Context);
end;
function TMVCController.SendSessionCookie(AContext: TWebContext): string;
function TWebContext.SendSessionCookie(AContext: TWebContext): string;
begin
Result := TMVCEngine.SendSessionCookie(AContext);
Result := TMVCEngine.SendSessionCookie(Self);
end;
procedure TMVCController.SendStream(AStream: TStream; AOwnStream: boolean);
@ -1886,13 +1909,18 @@ begin
FContext.Response.FWebResponse.FreeContentStream := AOwnStream;
end;
procedure TMVCController.SessionStart;
function TWebContext.SessionMustBeClose: boolean;
begin
Result := FSessionMustBeClose;
end;
procedure TWebContext.SessionStart;
var
LSessionID: string;
begin
if not Assigned(FWebSession) then
begin
LSessionID := TMVCEngine.SendSessionCookie(FContext);
LSessionID := TMVCEngine.SendSessionCookie(Self);
FWebSession := TMVCEngine.AddSessionToTheSessionList(LSessionID,
StrToInt64(Config[TMVCConfigKey.SessionTimeout]));
FIsSessionStarted := true;
@ -1900,13 +1928,14 @@ begin
end;
end;
procedure TMVCController.SessionStop(ARaiseExceptionIfExpired: boolean);
procedure TWebContext.SessionStop(ARaiseExceptionIfExpired: boolean);
var
Cookie: TCookie;
LSessionID: string;
begin
// Set-Cookie: token=deleted; path=/; expires=Thu, 01 Jan 1970 00:00:00 GMT
FContext.FResponse.Cookies.Clear; // daniele ... remove all previous cookies
Cookie := FContext.FResponse.Cookies.Add;
FResponse.Cookies.Clear; // daniele ... remove all previous cookies
Cookie := FResponse.Cookies.Add;
Cookie.Name := TMVCConstants.SESSION_TOKEN_NAME;
// rubbish... invalid the cookie value
@ -1917,12 +1946,14 @@ begin
TMonitor.Enter(SessionList);
try
if not Assigned(FWebSession) then
FWebSession := TMVCEngine.GetCurrentSession
(StrToInt64(GetMVCConfig[TMVCConfigKey.SessionTimeout]), '',
ARaiseExceptionIfExpired);
if Assigned(FWebSession) then
SessionList.Remove(Session.SessionID);
LSessionID := TMVCEngine.ExtractSessionIDFromWebRequest
(FRequest.RawWebRequest);
// if not Assigned(FWebSession) then
// FWebSession := TMVCEngine.GetCurrentSession
// (StrToInt64(FConfig[TMVCConfigKey.SessionTimeout]), '',
// ARaiseExceptionIfExpired);
// if Assigned(FWebSession) then
SessionList.Remove(LSessionID);
finally
TMonitor.Exit(SessionList);
end;
@ -1956,11 +1987,12 @@ end;
procedure TMVCController.SetWebSession(const Value: TWebSession);
begin
if Assigned(FWebSession) then
raise EMVCException.Create('Web Session already set for controller ' +
ClassName);
FWebSession := Value;
FIsSessionStarted := Assigned(FWebSession);
raise Exception.Create('Qualcuno mi usa...');
// if Assigned(FContext.FWebSession) then
// raise EMVCException.Create('Web Session already set for controller ' +
// ClassName);
// FContext.FWebSession := Value;
// FIsSessionStarted := Assigned(FContext.FWebSession);
end;
{ TMVCPathAttribute }

3
unittests/Several/FrameworkTestsU.pas
View File

@ -80,8 +80,6 @@ uses MVCFramework.Commons,
function MD5(const aStream: TStream): string;
var
idmd5: TIdHashMessageDigest5;
fs: TFileStream;
hash: T4x4LongWordRecord;
begin
aStream.Position := 0;
idmd5 := TIdHashMessageDigest5.Create;
@ -585,7 +583,6 @@ var
SO: TMyStreamObject;
JSONObj: TJSONObject;
ResultSO: TMyStreamObject;
ResultStr, str: UnicodeString;
begin
// ARRANGE
SO := TMyStreamObject.Create;

77
unittests/Several/LiveServerTestU.pas
View File

@ -27,6 +27,7 @@ type
procedure TestPOSTWithObjectJSONBody;
procedure TestPUTWithParamsAndJSONBody;
procedure TestSession;
procedure TestInvalidateSession;
procedure TestAsynchRequestPOST;
procedure TestAsynchRequestPUT;
procedure TestAsynchRequestGET;
@ -46,6 +47,7 @@ type
procedure TestAuthentication02;
procedure TestAuthentication03;
procedure TestAuthentication04;
procedure TestAuthentication05;
end;
implementation
@ -175,8 +177,8 @@ begin
end,
procedure(E: Exception)
begin
end).doPOST('/echo', ['1', '2', '3'], TJSONObject.Create(TJSONPair.Create('from client',
'hello world')), true);
end).doPOST('/echo', ['1', '2', '3'],
TJSONObject.Create(TJSONPair.Create('from client', 'hello world')), true);
// wait for thred finish
repeat
@ -212,8 +214,8 @@ begin
end,
procedure(E: Exception)
begin
end).doPUT('/echo', ['1', '2', '3'], TJSONObject.Create(TJSONPair.Create('from client',
'hello world')), true);
end).doPUT('/echo', ['1', '2', '3'],
TJSONObject.Create(TJSONPair.Create('from client', 'hello world')), true);
// wait for thred finish
repeat
@ -232,8 +234,9 @@ procedure TServerTest.TestAuthentication01;
var
LRes: IRESTResponse;
begin
RESTClient.UserName := 'user1';
RESTClient.Password := 'user1';
RESTClient.Authentication('user1', 'user1');
CheckEquals('user1', RESTClient.UserName);
CheckEquals('user1', RESTClient.Password);
LRes := RESTClient.doGET('/private/role1', []);
CheckEquals(HTTP_STATUS.OK, LRes.ResponseCode);
end;
@ -273,6 +276,29 @@ begin
CheckEquals(HTTP_STATUS.OK, LRes.ResponseCode);
end;
procedure TServerTest.TestAuthentication05;
var
LRes: IRESTResponse;
begin
RESTClient.UserName := 'user1';
RESTClient.Password := 'user1';
RESTClient.UseBasicAuthentication := true;
// first
LRes := RESTClient.doGET('/private/role1session?value=danieleteti', []);
CheckEquals(HTTP_STATUS.OK, LRes.ResponseCode);
LRes := RESTClient.doGET('/private/role1session', []);
CheckEquals(HTTP_STATUS.OK, LRes.ResponseCode);
CheckEquals('"danieleteti"', LRes.BodyAsString);
// second
LRes := RESTClient.doGET('/private/role1session?value=johndoe', []);
CheckEquals(HTTP_STATUS.OK, LRes.ResponseCode);
LRes := RESTClient.doGET('/private/role1session', []);
CheckEquals(HTTP_STATUS.OK, LRes.ResponseCode);
CheckEquals('"johndoe"', LRes.BodyAsString);
end;
procedure TServerTest.TestEncodingRenderJSONValue;
var
res: IRESTResponse;
@ -312,11 +338,31 @@ begin
CheckEquals(HTTP_STATUS.InternalServerError, res.ResponseCode);
end;
procedure TServerTest.TestInvalidateSession;
var
c1: TRESTClient;
res: IRESTResponse;
begin
c1 := TRESTClient.Create('localhost', 9999);
try
c1.Accept(TMVCMediaType.APPLICATION_JSON);
c1.doPOST('/session', ['daniele teti']); // imposto un valore in sessione
res := c1.doGET('/session', []); // rileggo il valore dalla sessione
CheckEquals('"daniele teti"', res.BodyAsString);
c1.SessionID := '';
res := c1.doGET('/session', []); // rileggo il valore dalla sessione
CheckEquals('""', res.BodyAsString);
finally
c1.Free;
end;
end;
procedure TServerTest.TestMiddlewareHandler;
var
r: IRESTResponse;
begin
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON).doGET('/handledbymiddleware', []);
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON)
.doGET('/handledbymiddleware', []);
CheckEquals('This is a middleware response', r.BodyAsString);
CheckEquals(HTTP_STATUS.OK, r.ResponseCode);
end;
@ -332,8 +378,8 @@ begin
P.LastName := StringOfChar('*', 1000);
P.DOB := EncodeDate(1979, 1, 1);
P.Married := true;
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON).doPOST('/objects', [],
Mapper.ObjectToJSONObject(P));
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON)
.doPOST('/objects', [], Mapper.ObjectToJSONObject(P));
finally
P.Free;
end;
@ -422,8 +468,10 @@ procedure TServerTest.TestProducesConsumesWithWrongAcceptHeader;
var
res: IRESTResponse;
begin
res := RESTClient.Accept('text/plain') // action is waiting for a accept: application/json
.ContentType('application/json').doPOST('/testconsumes', [], TJSONString.Create('Hello World'));
res := RESTClient.Accept('text/plain')
// action is waiting for a accept: application/json
.ContentType('application/json').doPOST('/testconsumes', [],
TJSONString.Create('Hello World'));
CheckEquals(HTTP_STATUS.NotFound, res.ResponseCode);
end;
@ -432,7 +480,8 @@ var
res: IRESTResponse;
begin
res := RESTClient.Accept('application/json').ContentType('application/json')
.ContentEncoding('utf-8').doPOST('/testconsumes', [], TJSONString.Create('Hello World'));
.ContentEncoding('utf-8').doPOST('/testconsumes', [],
TJSONString.Create('Hello World'));
CheckEquals(HTTP_STATUS.OK, res.ResponseCode);
CheckEquals('"Hello World"', res.BodyAsJsonValue.ToString);
CheckEquals('application/json', res.ContentType);
@ -443,8 +492,8 @@ procedure TServerTest.TestProducesConsumes02;
var
res: IRESTResponse;
begin
res := RESTClient.Accept('text/plain').ContentType('text/plain').doPOST('/testconsumes', [],
'Hello World');
res := RESTClient.Accept('text/plain').ContentType('text/plain')
.doPOST('/testconsumes', [], 'Hello World');
CheckEquals('Hello World', res.BodyAsString);
CheckEquals('text/plain', res.ContentType);
CheckEquals('UTF-8', res.ContentEncoding);

4
unittests/TestServer/TestServer.dpr
View File

@ -8,7 +8,7 @@ uses
IdHTTPWebBrokerBridge,
Web.WebReq,
Web.WebBroker,
WebModuleUnit in 'WebModuleUnit.pas' {wm: TWebModule},
WebModuleUnit in 'WebModuleUnit.pas' {wm: TWebModule} ,
TestServerControllerU in 'TestServerControllerU.pas',
BusinessObjectsU in '..\..\samples\commons\BusinessObjectsU.pas',
TestServerControllerExceptionU in 'TestServerControllerExceptionU.pas',
@ -32,7 +32,9 @@ begin
LHandle := GetStdHandle(STD_INPUT_HANDLE);
while True do
begin
{$WARN SYMBOL_PLATFORM OFF}
Win32Check(ReadConsoleInput(LHandle, LInputRecord, 1, LEvent));
{$WARN SYMBOL_PLATFORM ON}
if (LInputRecord.EventType = KEY_EVENT) and
LInputRecord.Event.KeyEvent.bKeyDown and
(LInputRecord.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE) then

22
unittests/TestServer/TestServer.dproj
View File

@ -176,16 +176,7 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="DependencyModule">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
@ -499,7 +490,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules"/>
<DeployClass Name="DependencyModule">
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>

22
unittests/TestServer/TestServerControllerU.pas
View File

@ -104,6 +104,9 @@ type
public
[MVCPath('/role1')]
procedure OnlyRole1(ctx: TWebContext);
[MVCPath('/role1session')]
[MVCHTTPMethods([httpGET])]
procedure OnlyRole1Session(ctx: TWebContext);
[MVCPath('/role2')]
procedure OnlyRole2(ctx: TWebContext);
end;
@ -201,13 +204,14 @@ end;
procedure TTestServerController.Logout(ctx: TWebContext);
begin
SessionStop(false);
ctx.SessionStop(false);
end;
procedure TTestServerController.ReqWithParams(ctx: TWebContext);
begin
Render(TJSONObject.Create.AddPair('par1', ctx.Request.Params['par1']).AddPair('par2',
ctx.Request.Params['par2']).AddPair('par3', ctx.Request.Params['par3']).AddPair('method',
Render(TJSONObject.Create.AddPair('par1', ctx.Request.Params['par1'])
.AddPair('par2', ctx.Request.Params['par2']).AddPair('par3',
ctx.Request.Params['par3']).AddPair('method',
ctx.Request.HTTPMethodAsString));
end;
@ -341,6 +345,18 @@ begin
Render(ctx.LoggedUser.UserName);
end;
procedure TTestPrivateServerController.OnlyRole1Session(ctx: TWebContext);
begin
if ctx.Request.QueryStringParamExists('value') then
begin
Session['value'] := ctx.Request.Params['value'];
end
else
begin
Render(Session['value']);
end;
end;
procedure TTestPrivateServerController.OnlyRole2(ctx: TWebContext);
begin
Render(ctx.LoggedUser.UserName);

2
unittests/TestServer/WebModuleUnit.pas
View File

@ -89,7 +89,7 @@ const ControllerQualifiedClassName, ActionName: string;
var IsAuthorized: Boolean);
begin
IsAuthorized := False;
if ActionName = 'OnlyRole1' then
if (ActionName = 'OnlyRole1') or (ActionName = 'OnlyRole1Session') then
IsAuthorized := UserRoles.Contains('role1');
if ActionName = 'OnlyRole2' then