Commit cdb35e6e by Mac Stephens

Push for 7:00 work

parent b08c5f9e
object AuthDatabase: TAuthDatabase
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
Height = 207
Width = 303
object uqWebTasksUrl: TUniQuery
Connection = ucETaskAuth
SQL.Strings = (
'select'
' u.USER_ID,'
' u.USER_NAME,'
' u.NAME,'
' u.STATUS,'
' u.EMAIL,'
' u.ACCESS_LEVEL,'
' u.TASK_RIGHTS,'
' u.PERSPECTIVE_ID,'
' u.LAST_NAME,'
' u.FIRST_NAME,'
' w.URL_TIME,'
' w.URL_TIME_EXP'
'from web_tasks_url w'
'join users u on u.USER_ID = w.USER_ID'
'where w.USER_ID = :USER_ID'
' and w.TASK_ID = :TASK_ID'
' and w.URL_CODE = :URL_CODE'
' and TIMESTAMPDIFF(SECOND, w.URL_TIME, NOW()) between 0 and w.U' +
'RL_TIME_EXP'
'order by w.URL_TIME desc'
'limit 1')
FetchRows = 100
Left = 78
Top = 43
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'URL_CODE'
Value = nil
end>
object uqWebTasksUrlUSER_ID: TStringField
FieldName = 'USER_ID'
Required = True
Size = 7
end
object uqWebTasksUrlUSER_NAME: TStringField
FieldName = 'USER_NAME'
Required = True
Size = 12
end
object uqWebTasksUrlNAME: TStringField
FieldName = 'NAME'
Size = 40
end
object uqWebTasksUrlSTATUS: TStringField
FieldName = 'STATUS'
Size = 7
end
object uqWebTasksUrlEMAIL: TStringField
FieldName = 'EMAIL'
Size = 50
end
object uqWebTasksUrlACCESS_LEVEL: TIntegerField
FieldName = 'ACCESS_LEVEL'
end
object uqWebTasksUrlTASK_RIGHTS: TIntegerField
FieldName = 'TASK_RIGHTS'
end
object uqWebTasksUrlPERSPECTIVE_ID: TStringField
FieldName = 'PERSPECTIVE_ID'
Size = 45
end
object uqWebTasksUrlLAST_NAME: TStringField
FieldName = 'LAST_NAME'
Size = 35
end
object uqWebTasksUrlFIRST_NAME: TStringField
FieldName = 'FIRST_NAME'
Size = 25
end
object uqWebTasksUrlURL_TIME: TDateTimeField
FieldName = 'URL_TIME'
ReadOnly = True
Required = True
end
object uqWebTasksUrlURL_TIME_EXP: TIntegerField
FieldName = 'URL_TIME_EXP'
ReadOnly = True
Required = True
end
end
object ucETaskAuth: TUniConnection
ProviderName = 'MySQL'
Database = 'eTask'
Username = 'root'
Server = '192.168.102.131'
Connected = True
LoginPrompt = False
Left = 69
Top = 133
EncryptedPassword = '9AFF92FF8CFF86FF8CFFCFFFCEFF'
end
object MySQLUniProvider1: TMySQLUniProvider
Left = 194
Top = 132
end
object uqWebLogin: TUniQuery
Connection = ucETaskAuth
SQL.Strings = (
'select'
' u.USER_ID,'
' u.USER_NAME,'
' u.NAME,'
' u.STATUS,'
' u.EMAIL,'
' u.ACCESS_LEVEL,'
' u.TASK_RIGHTS,'
' u.PERSPECTIVE_ID,'
' u.LAST_NAME,'
' u.FIRST_NAME,'
' w.WEB_LOGIN'
'from web_tasks_url w'
'join users u on u.USER_ID = w.USER_ID'
'where w.USER_ID = :USER_ID'
' and w.TASK_ID = :TASK_ID'
' and u.PASSWORD = :PASSWORD')
Left = 192
Top = 44
ParamData = <
item
DataType = ftUnknown
Name = 'USER_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'TASK_ID'
Value = nil
end
item
DataType = ftUnknown
Name = 'PASSWORD'
Value = nil
end>
object uqWebLoginUSER_ID: TStringField
FieldName = 'USER_ID'
Required = True
Size = 7
end
object uqWebLoginUSER_NAME: TStringField
FieldName = 'USER_NAME'
Required = True
Size = 12
end
object uqWebLoginNAME: TStringField
FieldName = 'NAME'
Size = 40
end
object uqWebLoginSTATUS: TStringField
FieldName = 'STATUS'
Size = 7
end
object uqWebLoginEMAIL: TStringField
FieldName = 'EMAIL'
Size = 50
end
object uqWebLoginACCESS_LEVEL: TIntegerField
FieldName = 'ACCESS_LEVEL'
end
object uqWebLoginTASK_RIGHTS: TIntegerField
FieldName = 'TASK_RIGHTS'
end
object uqWebLoginPERSPECTIVE_ID: TStringField
FieldName = 'PERSPECTIVE_ID'
Size = 45
end
object uqWebLoginLAST_NAME: TStringField
FieldName = 'LAST_NAME'
Size = 35
end
object uqWebLoginFIRST_NAME: TStringField
FieldName = 'FIRST_NAME'
Size = 25
end
object uqWebLoginWEB_LOGIN: TStringField
FieldName = 'WEB_LOGIN'
ReadOnly = True
Required = True
FixedChar = True
Size = 1
end
end
end
// Auth Database to verify logins
unit Auth.Database;
interface
uses
System.SysUtils, System.Classes, IniFiles, Vcl.Forms, MemDS,
Data.DB, DBAccess, Uni, UniProvider, PostgreSQLUniProvider, MySQLUniProvider;
type
TAuthDatabase = class(TDataModule)
uqWebTasksUrl: TUniQuery;
ucETaskAuth: TUniConnection;
MySQLUniProvider1: TMySQLUniProvider;
uqWebTasksUrlUSER_ID: TStringField;
uqWebTasksUrlUSER_NAME: TStringField;
uqWebTasksUrlNAME: TStringField;
uqWebTasksUrlSTATUS: TStringField;
uqWebTasksUrlEMAIL: TStringField;
uqWebTasksUrlACCESS_LEVEL: TIntegerField;
uqWebTasksUrlTASK_RIGHTS: TIntegerField;
uqWebTasksUrlPERSPECTIVE_ID: TStringField;
uqWebTasksUrlLAST_NAME: TStringField;
uqWebTasksUrlFIRST_NAME: TStringField;
uqWebTasksUrlURL_TIME: TDateTimeField;
uqWebTasksUrlURL_TIME_EXP: TIntegerField;
uqWebLogin: TUniQuery;
uqWebLoginUSER_ID: TStringField;
uqWebLoginUSER_NAME: TStringField;
uqWebLoginNAME: TStringField;
uqWebLoginSTATUS: TStringField;
uqWebLoginEMAIL: TStringField;
uqWebLoginACCESS_LEVEL: TIntegerField;
uqWebLoginTASK_RIGHTS: TIntegerField;
uqWebLoginPERSPECTIVE_ID: TStringField;
uqWebLoginLAST_NAME: TStringField;
uqWebLoginFIRST_NAME: TStringField;
uqWebLoginWEB_LOGIN: TStringField;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AuthDatabase: TAuthDatabase;
implementation
uses
System.JSON,
Common.Config,
Common.Logging,
uLibrary;
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TAuthDatabase.DataModuleCreate(Sender: TObject);
begin
Logger.Log( 5, 'TAuthDatabase.DataModuleCreate' );
LoadDatabaseSettings( ucETaskAuth, 'emT3XDataServer.ini' );
try
ucETaskAuth.Connect;
except
on E: Exception do
begin
Logger.Log(2, '--TAuthDatabase.DataModuleCreate -Error connecting to database: ' + E.Message);
end;
end;
end;
procedure TAuthDatabase.DataModuleDestroy(Sender: TObject);
begin
ucETaskAuth.Connected := false;
end;
end.
unit Auth.ServiceImpl;
interface
uses
XData.Service.Common,
XData.Server.Module,
Auth.Service,
Auth.Database,
Uni, Data.DB, System.Hash, System.IniFiles, System.JSON;
type
[ServiceImplementation]
TAuthService = class(TInterfacedObject, IAuthService)
strict private
authDB: TAuthDatabase;
userId: string;
userName: string;
userFullName: string;
userStatus: string;
userEmail: string;
userAccessLevel: string;
userTaskRights: string;
userPerspectiveId: string;
userFirstName: string;
userLastName: string;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
function CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
procedure LoadUserFromUrlLoginQuery;
public
function Login(const userId, taskId, urlCode: string): string;
function VerifyVersion(ClientVersion: string): TJSONObject;
function WebLogin(const userId, taskId, password: string): string;
function CheckWebLogin(const userId, taskId, password: string): Integer;
procedure LoadUserFromWebLoginQuery;
end;
implementation
uses
System.SysUtils,
System.DateUtils,
Bcl.JOSE.Core.Builder,
Bcl.JOSE.Core.JWT,
Aurelius.Global.Utils,
XData.Sys.Exceptions,
Common.Logging,
Common.Config;
procedure TAuthService.AfterConstruction;
begin
inherited;
try
authDB := TAuthDatabase.Create(nil);
except
on E: Exception do
begin
Logger.Log(1, 'Error when creating the Auth database: ' + E.Message);
raise EXDataHttpException.Create(500, 'Unable to create Auth database: A Server Error has occured!');
end;
end;
end;
procedure TAuthService.BeforeDestruction;
begin
authDB.Free;
inherited;
end;
function TAuthService.VerifyVersion(ClientVersion: string): TJSONObject;
var
iniFile: TIniFile;
webClientVersion: string;
begin
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
iniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
webClientVersion := iniFile.ReadString('Settings', 'webClientVersion', '');
Result.AddPair('webClientVersion', webClientVersion);
if webClientVersion = '' then
begin
Result.AddPair('error', 'webClientVersion is not configured.');
Exit;
end;
if ClientVersion <> webClientVersion then
begin
Result.AddPair('error',
'Your browser is running an old version of the app.' + sLineBreak +
'Please click button to reload.' + sLineBreak + sLineBreak +
'If error continues, empty cache and hard reload.');
end;
finally
iniFile.Free;
end;
end;
function TAuthService.CheckUrlLogin(const userId, taskId, urlCode: string): Integer;
var
sql: string;
timeNow: TDateTime;
timeDiff: integer;
begin
Logger.Log(3, 'TAuthService.CheckUrlLogin(const userId, taskId, urlCode: 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, w.URL_TIME, w.URL_TIME_EXP ';
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 w.URL_CODE = :URL_CODE ';
//sql := sql + 'and TIMESTAMPDIFF(SECOND, w.URL_TIME, NOW()) between 0 and w.URL_TIME_EXP';
authDB.uqWebTasksUrl.Close;
authDB.uqWebTasksUrl.SQL.Text := sql;
authDB.uqWebTasksUrl.ParamByName('USER_ID').AsString := userId;
authDB.uqWebTasksUrl.ParamByName('TASK_ID').AsString := taskId;
authDB.uqWebTasksUrl.ParamByName('URL_CODE').AsString := urlCode;
authDB.uqWebTasksUrl.Open;
if authDB.uqWebTasksUrl.IsEmpty then
begin
Logger.Log(3, '--URL Login failed 0: authDB.uqWebTasksUrl.IsEmpty');
Result := 0;
Exit;
end;
if authDB.uqWebTasksUrlSTATUS.AsString <> 'ACTIVE' then
begin
Logger.Log(3, '--URL Login failed 1: authDB.uqWebTasksUrlSTATUS.AsString <> ACTIVE');
Result := 1;
Exit;
end;
timeNow := Now;
timeDiff := SecondsBetween( timeNow, authDB.uqWebTasksUrlURL_TIME.AsDateTime );
if timeDiff > authDB.uqWebTasksUrlURL_TIME_EXP.AsInteger then
begin
Logger.Log( 3, '--timeNow: ' + timeNow.ToString + ' -urlTime: ' + authDB.uqWebTasksUrlURL_TIME.AsString );
Logger.Log( 3, '--timeDiff: ' + IntToStr(timeDiff) + ' -timeExp (authDB.uqWebTasksUrlURL_TIME_EXP.AsInteger): ' + authDB.uqWebTasksUrlURL_TIME_EXP.AsString );
Logger.Log( 3, '--URL Login failed 2: timeDiff > timeExp' );
Result := 2;
Exit;
end;
LoadUserFromUrlLoginQuery;
Result := 3;
end;
procedure TAuthService.LoadUserFromUrlLoginQuery;
var
nameValue: string;
begin
Self.userId := authDB.uqWebTasksUrl.FieldByName('USER_ID').AsString;
userName := authDB.uqWebTasksUrl.FieldByName('USER_NAME').AsString;
userStatus := authDB.uqWebTasksUrl.FieldByName('STATUS').AsString;
userEmail := authDB.uqWebTasksUrl.FieldByName('EMAIL').AsString;
userAccessLevel := authDB.uqWebTasksUrl.FieldByName('ACCESS_LEVEL').AsString;
userTaskRights := authDB.uqWebTasksUrl.FieldByName('TASK_RIGHTS').AsString;
userPerspectiveId := authDB.uqWebTasksUrl.FieldByName('PERSPECTIVE_ID').AsString;
userLastName := authDB.uqWebTasksUrl.FieldByName('LAST_NAME').AsString;
userFirstName := authDB.uqWebTasksUrl.FieldByName('FIRST_NAME').AsString;
nameValue := Trim(authDB.uqWebTasksUrl.FieldByName('NAME').AsString);
if nameValue <> '' then
userFullName := nameValue
else
userFullName := Trim(userFirstName + ' ' + userLastName);
end;
function TAuthService.Login(const userId, taskId, urlCode: string): string;
var
userState: Integer;
jwt: TJWT;
begin
Logger.Log(3, Format('AuthService.Login - UserID: "%s", TaskID: "%s", Code: "%s"', [userId, taskId, urlCode]));
try
userState := CheckUrlLogin(userId, taskId, urlCode);
except
on E: Exception do
begin
Logger.Log(1, 'URL Login failed due to database error: ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed: Unable to connect to the database.');
end;
end;
if userState = 0 then
begin
Logger.Log(2, 'Login Error: Invalid url parameters');
raise EXDataHttpUnauthorized.Create('Invalid url parameters');
end;
if userState = 1 then
begin
Logger.Log(2, 'Login Error: User not active!');
raise EXDataHttpUnauthorized.Create('User not active!');
end;
if userState = 2 then
begin
Logger.Log(2, 'Login Error: Expired link');
raise EXDataHttpUnauthorized.Create('Expired link');
end;
jwt := TJWT.Create;
try
jwt.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
jwt.Claims.IssuedAt := Now;
jwt.Claims.Expiration := IncHour(Now, 12);
jwt.Claims.SetClaimOfType<string>('user_id', Self.userId);
jwt.Claims.SetClaimOfType<string>('user_name', userName);
jwt.Claims.SetClaimOfType<string>('user_fullname', userFullName);
jwt.Claims.SetClaimOfType<string>('user_status', userStatus);
jwt.Claims.SetClaimOfType<string>('user_email', userEmail);
jwt.Claims.SetClaimOfType<string>('user_access_level', userAccessLevel);
jwt.Claims.SetClaimOfType<string>('task_rights', userTaskRights);
jwt.Claims.SetClaimOfType<string>('user_perspective_id', userPerspectiveId);
jwt.Claims.SetClaimOfType<string>('first_name', userFirstName);
jwt.Claims.SetClaimOfType<string>('last_name', userLastName);
Result := TJOSE.SHA256CompactToken(serverConfig.jwtTokenSecret, jwt);
finally
jwt.Free;
end;
end;
function TAuthService.CheckWebLogin(const userId, taskId, password: string): Integer;
var
sql: string;
begin
Logger.Log(3, 'TAuthService.CheckWebLogin(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, 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 ';
authDB.uqWebLogin.Close;
authDB.uqWebLogin.SQL.Text := sql;
authDB.uqWebLogin.ParamByName('USER_ID').AsString := userId;
authDB.uqWebLogin.ParamByName('TASK_ID').AsString := taskId;
authDB.uqWebLogin.ParamByName('PASSWORD').AsString := password;
authDB.uqWebLogin.Open;
if authDB.uqWebLogin.IsEmpty then
begin
Logger.Log(3, '--Web Login failed 0: authDB.uqWebLogin.IsEmpty');
Result := 0;
Exit;
end;
if authDB.uqWebLoginSTATUS.AsString <> 'ACTIVE' then
begin
Logger.Log(3, '--Web Login failed 1: authDB.uqWebLoginSTATUS.AsString <> ACTIVE');
Result := 1;
Exit;
end;
if authDB.uqWebLoginWEB_LOGIN.AsString <> 'T' then
begin
Logger.Log(3, '--Web Login failed 2: WEB_LOGIN <> T');
Result := 2;
Exit;
end;
LoadUserFromWebLoginQuery;
Result := 3;
end;
procedure TAuthService.LoadUserFromWebLoginQuery;
var
nameValue: string;
begin
Self.userId := authDB.uqWebLoginUSER_ID.AsString;
userName := authDB.uqWebLoginUSER_NAME.AsString;
userStatus := authDB.uqWebLoginSTATUS.AsString;
userEmail := authDB.uqWebLoginEMAIL.AsString;
userAccessLevel := authDB.uqWebLoginACCESS_LEVEL.AsString;
userTaskRights := authDB.uqWebLoginTASK_RIGHTS.AsString;
userPerspectiveId := authDB.uqWebLoginPERSPECTIVE_ID.AsString;
userLastName := authDB.uqWebLoginLAST_NAME.AsString;
userFirstName := authDB.uqWebLoginFIRST_NAME.AsString;
nameValue := Trim(authDB.uqWebLoginNAME.AsString);
if nameValue <> '' then
userFullName := nameValue
else
userFullName := Trim(userFirstName + ' ' + userLastName);
end;
function TAuthService.WebLogin(const userId, taskId, password: string): string;
var
userState: Integer;
jwt: TJWT;
begin
Logger.Log(3, Format('AuthService.WebLogin - UserID: "%s", TaskID: "%s"', [userId, taskId]));
try
userState := CheckWebLogin(userId, taskId, password);
except
on E: Exception do
begin
Logger.Log(1, 'Web Login failed due to database error: ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed: Unable to connect to the database.');
end;
end;
if userState = 0 then
begin
Logger.Log(2, 'Web Login Error: Invalid user id or password');
raise EXDataHttpUnauthorized.Create('Invalid user id or password');
end;
if userState = 1 then
begin
Logger.Log(2, 'Web Login Error: User not active!');
raise EXDataHttpUnauthorized.Create('User not active!');
end;
if userState = 2 then
begin
Logger.Log(2, 'Web Login Error: Web login is not enabled for this task');
raise EXDataHttpUnauthorized.Create('Web login is not enabled for this task');
end;
jwt := TJWT.Create;
try
jwt.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
jwt.Claims.IssuedAt := Now;
jwt.Claims.Expiration := IncHour(Now, 12);
jwt.Claims.SetClaimOfType<string>('user_id', Self.userId);
jwt.Claims.SetClaimOfType<string>('user_name', userName);
jwt.Claims.SetClaimOfType<string>('user_fullname', userFullName);
jwt.Claims.SetClaimOfType<string>('user_status', userStatus);
jwt.Claims.SetClaimOfType<string>('user_email', userEmail);
jwt.Claims.SetClaimOfType<string>('user_access_level', userAccessLevel);
jwt.Claims.SetClaimOfType<string>('task_rights', userTaskRights);
jwt.Claims.SetClaimOfType<string>('user_perspective_id', userPerspectiveId);
jwt.Claims.SetClaimOfType<string>('first_name', userFirstName);
jwt.Claims.SetClaimOfType<string>('last_name', userLastName);
Result := TJOSE.SHA256CompactToken(serverConfig.jwtTokenSecret, jwt);
finally
jwt.Free;
end;
end;
initialization
RegisterServiceType(TAuthService);
end.
[Auth.ServiceImpl.pas]
SaveTime=4/15/2026 6:21:59 PM
FileCount=1
File0=C:\Projects\emT3web\emT3XDataServer\Source\Auth.ServiceImpl.pas
[Auth.Database.pas]
SaveTime=4/15/2026 6:21:59 PM
FileCount=2
File0=C:\Projects\emT3web\emT3XDataServer\Source\Auth.Database.pas
File1=C:\Projects\emT3web\emT3XDataServer\Source\Auth.Database.dfm
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