Commit 7fc891cf by Mac Stephens

Add manual web-login fallback update logout and username-based auth using…

Add manual web-login fallback update logout and username-based auth using dedicated 000000/WEB_LOGIN rows
parent e137cc5a
...@@ -23,10 +23,8 @@ type ...@@ -23,10 +23,8 @@ type
public public
constructor Create; reintroduce; constructor Create; reintroduce;
destructor Destroy; override; destructor Destroy; override;
procedure Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess; procedure Login(AUser, APassword, AClientVersion: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
AError: TOnLoginError); procedure WebLogin(AUser, ATaskId, APassword: string; ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure WebLogin(AUser, APassword, ATaskId: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure Logout; procedure Logout;
function GetToken: string; function GetToken: string;
function Authenticated: Boolean; function Authenticated: Boolean;
...@@ -124,7 +122,7 @@ begin ...@@ -124,7 +122,7 @@ begin
end; end;
procedure TAuthService.WebLogin(AUser, APassword, ATaskId: string; ASuccess: TOnLoginSuccess; procedure TAuthService.WebLogin(AUser, ATaskId, APassword: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError); AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse); procedure OnLoad(Response: TXDataClientResponse);
...@@ -142,14 +140,14 @@ procedure TAuthService.WebLogin(AUser, APassword, ATaskId: string; ASuccess: TOn ...@@ -142,14 +140,14 @@ procedure TAuthService.WebLogin(AUser, APassword, ATaskId: string; ASuccess: TOn
end; end;
begin begin
if (AUser = '') or (APassword = '') then if (AUser = '') or (ATaskId = '') or (APassword = '') then
begin begin
AError('Invalid or expired code, please try again.'); AError('Please enter user id, task id, and password.');
Exit; Exit;
end; end;
FClient.RawInvoke( FClient.RawInvoke(
'IAuthService.WebLogin', [AUser, APassword, ATaskId], 'IAuthService.WebLogin', [AUser, ATaskId, APassword],
@OnLoad, @OnError @OnLoad, @OnError
); );
end; end;
......
...@@ -5,7 +5,7 @@ interface ...@@ -5,7 +5,7 @@ interface
uses uses
System.SysUtils, System.Classes, WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs, System.SysUtils, System.Classes, WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.JSON, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.JSON,
JS, XData.Web.Connection, WEBLib.ExtCtrls, JS, XData.Web.Connection, WEBLib.ExtCtrls, Web,
App.Types, ConnectionModule, XData.Web.Client; App.Types, ConnectionModule, XData.Web.Client;
type type
...@@ -25,11 +25,14 @@ type ...@@ -25,11 +25,14 @@ type
private private
FLoginProc: TSuccessProc; FLoginProc: TSuccessProc;
FMessage: string; FMessage: string;
FUserId: string;
FTaskId: string;
procedure ShowNotification(Notification: string); procedure ShowNotification(Notification: string);
procedure HideNotification; procedure HideNotification;
public public
class procedure Display(LoginProc: TSuccessProc); overload; class procedure Display(LoginProc: TSuccessProc); overload;
class procedure Display(LoginProc: TSuccessProc; AMsg: string); overload; class procedure Display(LoginProc: TSuccessProc; AMsg: string); overload;
class procedure Display(LoginProc: TSuccessProc; AUserId, ATaskId, AMsg: string); overload;
end; end;
var var
...@@ -46,7 +49,18 @@ uses ...@@ -46,7 +49,18 @@ uses
procedure TFViewLogin.btnLoginClick(Sender: TObject); procedure TFViewLogin.btnLoginClick(Sender: TObject);
procedure LoginSuccess; procedure LoginSuccess;
var
newUrl: string;
begin begin
newUrl := window.location.pathname +
'?user_id=' + edtUsername.Text +
'&task_id=' + edtTaskId.Text +
'&url_code=000000';
asm
window.history.replaceState({}, '', newUrl);
end;
FLoginProc; FLoginProc;
end; end;
...@@ -57,7 +71,7 @@ procedure TFViewLogin.btnLoginClick(Sender: TObject); ...@@ -57,7 +71,7 @@ procedure TFViewLogin.btnLoginClick(Sender: TObject);
begin begin
AuthService.WebLogin( AuthService.WebLogin(
edtUsername.Text, edtPassword.Text, edtTaskId.Text, edtUsername.Text, edtTaskId.Text, edtPassword.Text,
@LoginSuccess, @LoginSuccess,
@LoginError @LoginError
); );
...@@ -65,13 +79,20 @@ end; ...@@ -65,13 +79,20 @@ end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc); class procedure TFViewLogin.Display(LoginProc: TSuccessProc);
begin begin
TFViewLogin.Display(LoginProc, ''); TFViewLogin.Display(LoginProc, '', '', '');
end; end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc; AMsg: string); class procedure TFViewLogin.Display(LoginProc: TSuccessProc; AMsg: string);
begin
TFViewLogin.Display(LoginProc, '', '', AMsg);
end;
class procedure TFViewLogin.Display(LoginProc: TSuccessProc; AUserId, ATaskId, AMsg: string);
procedure FormCreate(AForm: TObject); procedure FormCreate(AForm: TObject);
begin begin
TFViewLogin(AForm).FUserId := AUserId;
TFViewLogin(AForm).FTaskId := ATaskId;
TFViewLogin(AForm).FMessage := AMsg; TFViewLogin(AForm).FMessage := AMsg;
end; end;
...@@ -103,7 +124,9 @@ end; ...@@ -103,7 +124,9 @@ end;
procedure TFViewLogin.WebFormCreate(Sender: TObject); procedure TFViewLogin.WebFormCreate(Sender: TObject);
begin begin
// lblAppTitle.Caption := 'EM Systems - webCharms App ver 0.9.2.22'; edtUsername.Text := FUserId;
edtTaskId.Text := FTaskId;
if FMessage <> '' then if FMessage <> '' then
ShowNotification(FMessage) ShowNotification(FMessage)
else else
......
...@@ -19,7 +19,7 @@ uses ...@@ -19,7 +19,7 @@ uses
{$R *.res} {$R *.res}
procedure DisplayLoginView(AMessage: string = ''); forward; procedure DisplayLoginView(AUserId: string = ''; ATaskId: string = ''; AMessage: string = ''); forward;
procedure DoLogout(AMsg: string = ''); forward; procedure DoLogout(AMsg: string = ''); forward;
procedure DisplayMainView; procedure DisplayMainView;
...@@ -45,24 +45,29 @@ procedure Login(userId: string; taskId: string; urlCode: string); ...@@ -45,24 +45,29 @@ procedure Login(userId: string; taskId: string; urlCode: string);
procedure LoginError(AMsg: string); procedure LoginError(AMsg: string);
begin begin
ShowAppDialog('' + AMsg); if (Pos('401:', AMsg) = 1) or
(Pos('Invalid url parameters', AMsg) > 0) or
(Pos('Expired link', AMsg) > 0) then
DisplayLoginView(userId, taskId)
else
ShowAppDialog('' + AMsg);
end; end;
begin begin
AuthService.Login( userId, taskId, urlCode, AuthService.Login(userId, taskId, urlCode,
@LoginSuccess, @LoginSuccess,
@LoginError @LoginError
); );
end; end;
procedure DisplayLoginView(AMessage: string); procedure DisplayLoginView(AUserId: string; ATaskId: string; AMessage: string);
begin begin
AuthService.Logout; AuthService.Logout;
DMConnection.ApiConnection.Connected := False; DMConnection.ApiConnection.Connected := False;
if Assigned(FViewMain) then if Assigned(FViewMain) then
FViewMain.Free; FViewMain.Free;
TFViewLogin.Display(@DisplayMainView, AMessage); TFViewLogin.Display(@DisplayMainView, AUserId, ATaskId, AMessage);
end; end;
...@@ -77,24 +82,29 @@ begin ...@@ -77,24 +82,29 @@ begin
codeParam := Application.Parameters.Values['url_code']; codeParam := Application.Parameters.Values['url_code'];
if (userIdParam = '') or (taskIdParam = '') or (codeParam = '') then if (userIdParam = '') or (taskIdParam = '') or (codeParam = '') then
begin DisplayLoginView(userIdParam, taskIdParam)
DisplayLoginView();
end
else else
begin begin
AuthService.Logout; AuthService.Logout;
DMConnection.ApiConnection.Connected := False; DMConnection.ApiConnection.Connected := False;
if Assigned(FViewMain) then if Assigned(FViewMain) then
FViewMain.Free; FViewMain.Free;
Login( userIdParam, taskIdParam, codeParam ); Login(userIdParam, taskIdParam, codeParam);
end; end;
end; end;
procedure DoLogout(AMsg: string); procedure DoLogout(AMsg: string);
var
userIdParam: string;
taskIdParam: string;
begin begin
AuthService.Logout; AuthService.Logout;
ShowAppDialog('Logout successful ' + AMsg);
userIdParam := Application.Parameters.Values['user_id'];
taskIdParam := Application.Parameters.Values['task_id'];
DisplayLoginView(userIdParam, taskIdParam);
end; end;
......
...@@ -104,6 +104,7 @@ object AuthDatabase: TAuthDatabase ...@@ -104,6 +104,7 @@ object AuthDatabase: TAuthDatabase
Database = 'eTask' Database = 'eTask'
Username = 'root' Username = 'root'
Server = '192.168.102.131' Server = '192.168.102.131'
Connected = True
LoginPrompt = False LoginPrompt = False
Left = 71 Left = 71
Top = 133 Top = 133
...@@ -130,15 +131,16 @@ object AuthDatabase: TAuthDatabase ...@@ -130,15 +131,16 @@ object AuthDatabase: TAuthDatabase
' w.WEB_LOGIN' ' w.WEB_LOGIN'
'from web_tasks_url w' 'from web_tasks_url w'
'join users u on u.USER_ID = w.USER_ID' 'join users u on u.USER_ID = w.USER_ID'
'where w.USER_ID = :USER_ID' 'where u.USER_NAME = :USER_NAME'
' and w.TASK_ID = :TASK_ID' ' and w.TASK_ID = :TASK_ID'
' and u.PASSWORD = :PASSWORD') ' and u.PASSWORD = :PASSWORD'
Left = 192 ' and w.URL_CODE = :URL_CODE')
Left = 194
Top = 44 Top = 44
ParamData = < ParamData = <
item item
DataType = ftUnknown DataType = ftUnknown
Name = 'USER_ID' Name = 'USER_NAME'
Value = nil Value = nil
end end
item item
...@@ -150,6 +152,11 @@ object AuthDatabase: TAuthDatabase ...@@ -150,6 +152,11 @@ object AuthDatabase: TAuthDatabase
DataType = ftUnknown DataType = ftUnknown
Name = 'PASSWORD' Name = 'PASSWORD'
Value = nil Value = nil
end
item
DataType = ftUnknown
Name = 'URL_CODE'
Value = nil
end> end>
object uqWebLoginUSER_ID: TStringField object uqWebLoginUSER_ID: TStringField
FieldName = 'USER_ID' FieldName = 'USER_ID'
......
...@@ -18,9 +18,9 @@ type ...@@ -18,9 +18,9 @@ type
[ServiceContract, Model(AUTH_MODEL)] [ServiceContract, Model(AUTH_MODEL)]
IAuthService = interface(IInvokable) IAuthService = interface(IInvokable)
['{9CFD59B2-A832-4F82-82BB-9A25FC93F305}'] ['{9CFD59B2-A832-4F82-82BB-9A25FC93F305}']
function Login(const userId, taskId, urlCode: string): string; function Login(userId, taskId, urlCode: string): string;
function VerifyVersion(ClientVersion: string): TJSONObject; function VerifyVersion(ClientVersion: string): TJSONObject;
function WebLogin(const userId, taskId, password: string): string; function WebLogin(userName, taskId, password: string): string;
end; end;
implementation implementation
......
...@@ -29,14 +29,14 @@ type ...@@ -29,14 +29,14 @@ type
procedure AfterConstruction; override; procedure AfterConstruction; override;
procedure BeforeDestruction; override; procedure BeforeDestruction; override;
function CheckUrlLogin(const userId, taskId, urlCode: string): Integer; function CheckUrlLogin(userId, taskId, urlCode: string): Integer;
function CheckUserLogin(const userId, taskId, password: string): Integer; function CheckUserLogin(userName, taskId, password: string): Integer;
procedure LoadUserFromUrlLoginQuery; procedure LoadUserFromUrlLoginQuery;
procedure LoadUserFromWebLoginQuery; procedure LoadUserFromWebLoginQuery;
public public
function Login(const userId, taskId, urlCode: string): string; function Login(userId, taskId, urlCode: string): string;
function VerifyVersion(ClientVersion: string): TJSONObject; function VerifyVersion(ClientVersion: string): TJSONObject;
function WebLogin(const userId, password, taskId: string): string; function WebLogin(userName, taskId, password: string): string;
end; end;
implementation implementation
...@@ -105,7 +105,7 @@ begin ...@@ -105,7 +105,7 @@ begin
end; end;
function TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer; function TAuthService.CheckUrlLogin(userId, taskId, urlCode: string): Integer;
var var
sql: string; sql: string;
timeNow: TDateTime; timeNow: TDateTime;
...@@ -180,7 +180,7 @@ begin ...@@ -180,7 +180,7 @@ begin
end; end;
function TAuthService.Login(const userId, taskId, urlCode: string): string; function TAuthService.Login(userId, taskId, urlCode: string): string;
var var
userState: Integer; userState: Integer;
jwt: TJWT; jwt: TJWT;
...@@ -239,39 +239,39 @@ begin ...@@ -239,39 +239,39 @@ begin
end; end;
function TAuthService.WebLogin(const userId, password, taskID: string): string; function TAuthService.WebLogin(userName, taskId, password: string): string;
var var
userState: Integer; userState: Integer;
jwt: TJWT; jwt: TJWT;
begin begin
Logger.Log(3, Format('AuthService.WebLogin - UserID: %s, TaskID: %s, password: %s', [userId, taskId, password])); Logger.Log(3, Format('AuthService.WebLogin - UserName: %s, TaskID: %s', [userName, taskId]));
try try
userState := CheckUserLogin(userId, taskId, password); userState := CheckUserLogin(userName, taskId, password);
except except
on E: Exception do on E: Exception do
begin begin
Logger.Log(1, 'URL Login failed due to database error: ' + E.Message); Logger.Log(1, 'Web Login failed due to database error: ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed: Unable to connect to the database.'); raise EXDataHttpException.Create(500, 'Login failed: Unable to connect to the database.');
end; end;
end; end;
if userState = 0 then if userState = 0 then
begin begin
Logger.Log(2, 'Login Error: Invalid url parameters'); Logger.Log(2, 'Web Login Error: Invalid username, task id, or password');
raise EXDataHttpUnauthorized.Create('Invalid url parameters'); raise EXDataHttpUnauthorized.Create('Invalid user name, task id, or password');
end; end;
if userState = 1 then if userState = 1 then
begin begin
Logger.Log(2, 'Login Error: User not active!'); Logger.Log(2, 'Web Login Error: User not active!');
raise EXDataHttpUnauthorized.Create('User not active!'); raise EXDataHttpUnauthorized.Create('User not active!');
end; end;
if userState = 2 then if userState = 2 then
begin begin
Logger.Log(2, 'Login Error: Expired link'); Logger.Log(2, 'Web Login Error: Web login is not enabled for this task');
raise EXDataHttpUnauthorized.Create('Expired link'); raise EXDataHttpUnauthorized.Create('Web login is not enabled for this task');
end; end;
jwt := TJWT.Create; jwt := TJWT.Create;
...@@ -298,26 +298,17 @@ begin ...@@ -298,26 +298,17 @@ begin
end; end;
function TAuthService.CheckUserLogin(const userId, taskId, password: string): Integer; function TAuthService.CheckUserLogin(userName, taskId, password: string): Integer;
var var
sql: string;
webLogin: string; webLogin: string;
begin begin
Logger.Log(3, 'TAuthService.CheckUserLogin(const userId, taskId, password: string): Integer' ); Logger.Log(3, 'TAuthService.CheckUserLogin(const userId, taskId, password: string): Integer');
sql := 'select u.USER_ID, u.USER_NAME, u.NAME, u.STATUS, u.EMAIL, u.ACCESS_LEVEL, ';
sql := sql + 'u.TASK_RIGHTS, u.PERSPECTIVE_ID, u.LAST_NAME, u.FIRST_NAME, ';
sql := sql + 'w.URL_TIME, w.URL_TIME_EXP, w.WEB_LOGIN ';
sql := sql + 'from web_tasks_url w ';
sql := sql + 'join users u on u.USER_ID = w.USER_ID ';
sql := sql + 'where w.USER_ID = :USER_ID and w.TASK_ID = :TASK_ID and u.PASSWORD = :PASSWORD and w.URL_CODE = :URL_CODE';
authDB.uqWebLogin.Close; authDB.uqWebLogin.Close;
authDB.uqWebLogin.SQL.Text := sql; authDB.uqWebLogin.ParamByName('USER_NAME').AsString := userName;
authDB.uqWebLogin.ParamByName('USER_ID').AsString := userId;
authDB.uqWebLogin.ParamByName('TASK_ID').AsString := taskId; authDB.uqWebLogin.ParamByName('TASK_ID').AsString := taskId;
authDB.uqWebLogin.ParamByName('PASSWORD').AsString := password; authDB.uqWebLogin.ParamByName('PASSWORD').AsString := password;
authDB.uqWebLogin.ParamByName('URL_CODE').AsString := 'WebLogin'; authDB.uqWebLogin.ParamByName('URL_CODE').AsString := '000000';
authDB.uqWebLogin.Open; authDB.uqWebLogin.Open;
if authDB.uqWebLogin.IsEmpty then if authDB.uqWebLogin.IsEmpty then
...@@ -337,7 +328,7 @@ begin ...@@ -337,7 +328,7 @@ begin
webLogin := authDB.uqWebLoginWEB_LOGIN.AsString; webLogin := authDB.uqWebLoginWEB_LOGIN.AsString;
if webLogin <> 'T' then if webLogin <> 'T' then
begin begin
Logger.Log( 3, '--Web Login failed 2: WEB_LOGIN <> "T"' ); Logger.Log(3, '--Web Login failed 2: WEB_LOGIN <> "T"');
Result := 2; Result := 2;
Exit; Exit;
end; end;
......
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
MemoLogLevel=4 MemoLogLevel=4
FileLogLevel=4 FileLogLevel=4
webClientVersion=0.8.8 webClientVersion=0.8.8
LogFileNum=169 LogFileNum=174
[Database] [Database]
--Server=192.168.102.131 Server=192.168.102.131
Server=192.168.116.131 --Server=192.168.116.131
--Server=192.168.159.10 --Server=192.168.159.10
Database=eTask Database=eTask
Username=root Username=root
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment