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

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 implementation
uses 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 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_401_NOT_AUTHORIZED = '401: Not authorized';
CONTENT_403_FORBIDDEN = '403: Forbidden'; 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 constructor TMVCBasicAuthenticationMiddleware.Create(AMVCAuthenticationHandler
: IMVCAuthenticationHandler; Realm: string); : IMVCAuthenticationHandler; Realm: string);
@ -78,7 +92,7 @@ end;
procedure TMVCBasicAuthenticationMiddleware.OnAfterControllerAction procedure TMVCBasicAuthenticationMiddleware.OnAfterControllerAction
(Context: TWebContext; const AActionName: string; const Handled: Boolean); (Context: TWebContext; const AActionName: string; const Handled: Boolean);
begin begin
// do nothing
end; end;
procedure TMVCBasicAuthenticationMiddleware.OnBeforeControllerAction procedure TMVCBasicAuthenticationMiddleware.OnBeforeControllerAction
@ -89,10 +103,7 @@ var
LPieces: TArray<string>; LPieces: TArray<string>;
LRoles: TList<string>; LRoles: TList<string>;
LIsValid: Boolean; LIsValid: Boolean;
LWebSession: TWebSession;
LSessionID: string;
LIsAuthorized: Boolean; LIsAuthorized: Boolean;
LSessionIDFromWebRequest: string;
LAuthRequired: Boolean; LAuthRequired: Boolean;
LSessionData: TSessionData; LSessionData: TSessionData;
LPair: TPair<String, String>; LPair: TPair<String, String>;
@ -103,12 +114,12 @@ var
begin begin
Context.Response.ContentType := 'text/html'; Context.Response.ContentType := 'text/html';
Context.Response.RawWebResponse.Content := 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 end
else else
begin begin
Context.Response.ContentType := 'text/plain'; 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; end;
Context.Response.StatusCode := 401; Context.Response.StatusCode := 401;
Context.Response.SetCustomHeader('WWW-Authenticate', Context.Response.SetCustomHeader('WWW-Authenticate',
@ -124,12 +135,12 @@ var
begin begin
Context.Response.ContentType := 'text/html'; Context.Response.ContentType := 'text/html';
Context.Response.RawWebResponse.Content := Context.Response.RawWebResponse.Content :=
Format(CONTENT_HTML_FORMAT, [CONTENT_403_FORBIDDEN]); Format(CONTENT_HTML_FORMAT, [CONTENT_403_FORBIDDEN, Context.Config[TMVCConfigKey.ServerName]]);
end end
else else
begin begin
Context.Response.ContentType := 'text/plain'; 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; end;
Context.Response.StatusCode := 403; Context.Response.StatusCode := 403;
Handled := true; Handled := true;
@ -145,35 +156,12 @@ begin
Exit; Exit;
end; end;
LSessionIDFromWebRequest := TMVCEngine.ExtractSessionIDFromWebRequest Context.LoggedUser.LoadFromSession(Context.Session);
(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);
if not Context.LoggedUser.IsValid then if not Context.LoggedUser.IsValid then
begin begin
// check if the resource is protected
// FMVCAuthenticationHandler.OnRequest(AControllerQualifiedClassName, AActionName, LAuthRequired);
// if not LAuthRequired then
// begin
// Handled := False;
// Exit;
// end;
// We NEED authentication // We NEED authentication
LAuth := Context.Request.Headers['Authorization']; LAuth := Context.Request.Headers['Authorization'];
LAuth := DecodeString(LAuth.Remove(0, 'Basic'.Length).Trim); LAuth := Base64DecodeString(LAuth.Remove(0, 'Basic'.Length).Trim);
LPieces := LAuth.Split([':']); LPieces := LAuth.Split([':']);
if LAuth.IsEmpty or (Length(LPieces) <> 2) then if LAuth.IsEmpty or (Length(LPieces) <> 2) then
begin begin
@ -195,14 +183,12 @@ begin
Context.LoggedUser.UserName := LPieces[0]; Context.LoggedUser.UserName := LPieces[0];
Context.LoggedUser.LoggedSince := Now; Context.LoggedUser.LoggedSince := Now;
Context.LoggedUser.Realm := FRealm; Context.LoggedUser.Realm := FRealm;
LSessionID := TMVCEngine.SendSessionCookie(Context); Context.LoggedUser.SaveToSession(Context.Session);
LWebSession := TMVCEngine.AddSessionToTheSessionList(LSessionID,
Context.Config.AsInt64[TMVCConfigKey.SessionTimeout]);
Context.LoggedUser.SaveToSession(LWebSession);
// save sessiondata to the actual session // save sessiondata to the actual session
for LPair in LSessionData do for LPair in LSessionData do
begin begin
LWebSession[LPair.Key] := LPair.Value; Context.Session[LPair.Key] := LPair.Value;
end; end;
end; end;
finally finally
@ -235,7 +221,7 @@ end;
procedure TMVCBasicAuthenticationMiddleware.OnBeforeRouting procedure TMVCBasicAuthenticationMiddleware.OnBeforeRouting
(Context: TWebContext; var Handled: Boolean); (Context: TWebContext; var Handled: Boolean);
begin begin
// do nothing
end; end;
end. end.

2
sources/MVCFramework.Session.pas
View File

@ -2,7 +2,7 @@
{ } { }
{ Delphi MVC Framework } { 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 } { https://github.com/danieleteti/delphimvcframework }
{ } { }

132
sources/MVCFramework.pas
View File

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

3
unittests/Several/FrameworkTestsU.pas
View File

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

77
unittests/Several/LiveServerTestU.pas
View File

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

4
unittests/TestServer/TestServer.dpr
View File

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

22
unittests/TestServer/TestServer.dproj
View File

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

22
unittests/TestServer/TestServerControllerU.pas
View File

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

2
unittests/TestServer/WebModuleUnit.pas
View File

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