Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
E
emT3web
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Mac Stephens
emT3web
Commits
cdb35e6e
Commit
cdb35e6e
authored
Apr 15, 2026
by
Mac Stephens
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Push for 7:00 work
parent
b08c5f9e
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
659 additions
and
0 deletions
+659
-0
Auth.Database.dfm
emT3XDataServer/Source/__recovery/Auth.Database.dfm
+203
-0
Auth.Database.pas
emT3XDataServer/Source/__recovery/Auth.Database.pas
+83
-0
Auth.ServiceImpl.pas
emT3XDataServer/Source/__recovery/Auth.ServiceImpl.pas
+364
-0
__recovery.ini
emT3XDataServer/Source/__recovery/__recovery.ini
+9
-0
No files found.
emT3XDataServer/Source/__recovery/Auth.Database.dfm
0 → 100644
View file @
cdb35e6e
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
emT3XDataServer/Source/__recovery/Auth.Database.pas
0 → 100644
View file @
cdb35e6e
// 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
.
emT3XDataServer/Source/__recovery/Auth.ServiceImpl.pas
0 → 100644
View file @
cdb35e6e
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
.
emT3XDataServer/Source/__recovery/__recovery.ini
0 → 100644
View file @
cdb35e6e
[Auth.ServiceImpl.pas]
SaveTime
=
4/15/2026 6:21:59 PM
FileCount
=
1
File0
=
C:
\P
rojects
\e
mT3web
\e
mT3XDataServer
\S
ource
\A
uth.ServiceImpl.pas
[Auth.Database.pas]
SaveTime
=
4/15/2026 6:21:59 PM
FileCount
=
2
File0
=
C:
\P
rojects
\e
mT3web
\e
mT3XDataServer
\S
ource
\A
uth.Database.pas
File1
=
C:
\P
rojects
\e
mT3web
\e
mT3XDataServer
\S
ource
\A
uth.Database.dfm
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment