Commit 9137ff06 by Mac Stephens

Merge device management and add ADMIN login through ?devices without device…

Merge device management and add ADMIN login through ?devices without device registration; preserve server fixes and restore password visibility button
parents 46bac255 4a520774
......@@ -7,7 +7,8 @@ uses
Aurelius.Mapping.Attributes,
System.JSON,
System.Generics.Collections,
System.Classes;
System.Classes,
Auth.Service; // for TDeviceItem / TDeviceList
const
API_MODEL = 'Api';
......@@ -30,10 +31,16 @@ type
[HttpGet] function GetUnitDetails(const UnitId: string): TJSONObject;
[HttpGet] function GetUnitLogs(const UnitId: string): TJSONObject;
// Device management — requires valid JWT; caller must also have user_admin = true
[HttpGet] function GetDeviceList: TDeviceList;
function RevokeDevice(const CredentialId: string): TJSONObject;
function UnrevokeDevice(const CredentialId: string): TJSONObject;
function AddPendingDevice(const DeviceName, PhoneNumber: string): TJSONObject;
function DeletePendingDevice(const PhoneNumber: string): TJSONObject;
function SendAppLink(const PhoneNumber: string): TJSONObject;
function UpdateDeviceUsername(const CredentialId, Username: string): TJSONObject;
end;
implementation
end.
unit Api.ServiceImpl;
unit Api.ServiceImpl;
interface
uses
XData.Server.Module, XData.Service.Common, Api.Database, Data.DB,
System.SysUtils, System.Generics.Collections, XData.Sys.Exceptions, System.StrUtils,
System.Hash, System.Classes, Common.Logging, System.JSON, Api.Service, VCL.Forms;
System.Hash, System.Classes, Common.Logging, System.JSON, Api.Service, VCL.Forms,
Auth.Service, Uni, UniProvider, PostgreSQLUniProvider, Common.Ini,
Sparkle.HttpServer.Context, System.NetEncoding, Common.Config,
System.Net.HttpClient, System.Net.URLClient;
type
......@@ -14,8 +17,13 @@ type
strict private
ApiDB: TApiDatabaseModule;
private
//procedure AfterConstruction; override;
//procedure BeforeDestruction; override;
FDeviceManagementOnly: Boolean;
procedure RequireMobileAccess;
procedure RequireAdmin;
procedure RequireActiveDevice;
function OpenLemsConnection: TUniConnection;
public
constructor Create;
destructor Destroy; override;
......@@ -32,6 +40,13 @@ type
function GetUnitDetails(const UnitId: string): TJSONObject;
function GetUnitLogs(const UnitId: string): TJSONObject;
function GetComplaintMemos(const CfsId: string): TJSONObject;
function GetDeviceList: TDeviceList;
function RevokeDevice(const CredentialId: string): TJSONObject;
function UnrevokeDevice(const CredentialId: string): TJSONObject;
function AddPendingDevice(const DeviceName, PhoneNumber: string): TJSONObject;
function DeletePendingDevice(const PhoneNumber: string): TJSONObject;
function SendAppLink(const PhoneNumber: string): TJSONObject;
function UpdateDeviceUsername(const CredentialId, Username: string): TJSONObject;
end;
implementation
......@@ -57,6 +72,7 @@ begin
end;
Logger.Log(3, 'ApiDatabaseModule created');
RequireActiveDevice;
end;
destructor TApiService.Destroy;
......@@ -70,6 +86,7 @@ end;
function TApiService.GetBadgeCounts: TJSONObject;
begin
RequireMobileAccess;
Logger.Log(3, '---TApiService.GetBadgeCounts initiated');
Result := TJSONObject.Create;
......@@ -110,6 +127,7 @@ var
latestUpdate: TDateTime;
unitObj: TJSONObject;
begin
RequireMobileAccess;
Logger.Log(3, '---TApiService.GetComplaintMap initiated');
Result := TJSONObject.Create;
......@@ -252,6 +270,7 @@ var
unitStatus: string;
updateTimeText: string;
begin
RequireMobileAccess;
Logger.Log(4, '---TApiService.GetUnitMap initiated');
Result := TJSONObject.Create;
......@@ -341,6 +360,7 @@ var
data: TJSONArray;
lastDistrict: string;
begin
RequireMobileAccess;
Logger.Log(3, '---TApiService.GetComplaintList initiated');
Result := TJSONObject.Create;
......@@ -437,6 +457,7 @@ var
data: TJSONArray;
lastAgency: string;
begin
RequireMobileAccess;
Logger.Log(3, '---TApiService.GetUnitList initiated');
Result := TJSONObject.Create;
......@@ -615,6 +636,7 @@ function TApiService.GetComplaintDetails(const ComplaintId: string): TJSONObject
var
obj: TJSONObject;
begin
RequireMobileAccess;
Logger.Log(3,'---TApiService.GetComplaintDetails initiated: '+ComplaintId);
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
......@@ -696,6 +718,7 @@ function TApiService.GetComplaintArchiveDetails(const ComplaintId: string): TJSO
var
obj: TJSONObject;
begin
RequireMobileAccess;
Logger.Log(3,'---TApiService.GetComplaintArchiveDetails initiated: '+ComplaintId);
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
......@@ -782,6 +805,7 @@ var
item: TJSONObject;
ts: string;
begin
RequireMobileAccess;
Logger.Log(3, '---TApiService.GetComplaintMemos initiated: ' + CfsId);
Result := TJSONObject.Create;
......@@ -846,6 +870,7 @@ var
rowObj: TJSONObject;
returnedCount: Integer;
begin
RequireMobileAccess;
Logger.Log(4, '---TApiService.GetComplaintHistory initiated: ' + ComplaintId);
Result := TJSONObject.Create;
......@@ -914,6 +939,7 @@ var
rowObj: TJSONObject;
returnedCount: Integer;
begin
RequireMobileAccess;
Logger.Log(4, '---TApiService.GetComplaintContacts initiated: ' + ComplaintId);
Result := TJSONObject.Create;
......@@ -975,6 +1001,7 @@ var
apartmentText: string;
cityText: string;
begin
RequireMobileAccess;
Logger.Log(3, '---TApiService.GetComplaintWarnings initiated: ' + ComplaintId);
Result := TJSONObject.Create;
......@@ -1055,6 +1082,7 @@ var
ts: string;
complaintText: string;
begin
RequireMobileAccess;
Logger.Log(4, '---TApiService.GetUnitLogs initiated: ' + UnitId);
Result := TJSONObject.Create;
......@@ -1120,6 +1148,7 @@ var
updateTimeText: string;
unitStatus: string;
begin
RequireMobileAccess;
Logger.Log(4, '---TApiService.GetUnitDetails initiated: ' + UnitId);
Result := TJSONObject.Create;
......@@ -1183,6 +1212,639 @@ begin
end;
// ---------------------------------------------------------------------------
// Device Management
// ---------------------------------------------------------------------------
procedure TApiService.RequireMobileAccess;
begin
if FDeviceManagementOnly then
raise EXDataHttpException.Create(403, 'This login is for device management only');
end;
procedure TApiService.RequireAdmin;
var
ctx: THttpServerContext;
authHeader, b64payload, payload: string;
parts: TArray<string>;
padLen: Integer;
payloadObj: TJSONObject;
isAdmin: Boolean;
begin
isAdmin := False;
try
// Note: The JWT middleware validates the signature; only ADMIN manages devices.
// THttpServerContext.Current is the Sparkle thread-local request context.
ctx := THttpServerContext.Current;
if ctx <> nil then
begin
authHeader := ctx.Request.Headers.Get('Authorization');
if authHeader.StartsWith('Bearer ') then
begin
parts := authHeader.Substring(7).Split(['.']);
if Length(parts) >= 2 then
begin
// JWT uses URL-safe base64 (no padding) — convert before decoding
b64payload := parts[1].Replace('-', '+').Replace('_', '/');
padLen := (4 - Length(b64payload) mod 4) mod 4;
b64payload := b64payload + StringOfChar('=', padLen);
payload := TEncoding.UTF8.GetString(TNetEncoding.Base64.DecodeStringToBytes(b64payload));
payloadObj := TJSONObject.ParseJSONValue(payload) as TJSONObject;
if Assigned(payloadObj) then
try
isAdmin := SameText(Trim(payloadObj.GetValue<string>('user_name', '')), 'ADMIN');
finally
payloadObj.Free;
end;
end;
end;
end;
except
isAdmin := False;
end;
if not isAdmin then
raise EXDataHttpException.Create(403, 'Admin access required');
end;
procedure TApiService.RequireActiveDevice;
var
ctx: THttpServerContext;
authHeader, b64p, payload, credId, deviceStatus: string;
parts: TArray<string>;
padLen: Integer;
payloadObj: TJSONObject;
conn: TUniConnection;
q: TUniQuery;
begin
credId := '';
try
ctx := THttpServerContext.Current;
if ctx = nil then Exit;
authHeader := ctx.Request.Headers.Get('Authorization');
if not authHeader.StartsWith('Bearer ') then Exit;
parts := authHeader.Substring(7).Split(['.']);
if Length(parts) >= 2 then
begin
b64p := parts[1].Replace('-', '+').Replace('_', '/');
padLen := (4 - Length(b64p) mod 4) mod 4;
b64p := b64p + StringOfChar('=', padLen);
payload := TEncoding.UTF8.GetString(TNetEncoding.Base64.DecodeStringToBytes(b64p));
payloadObj := TJSONObject.ParseJSONValue(payload) as TJSONObject;
if Assigned(payloadObj) then
try
credId := payloadObj.GetValue<string>('credential_id', '');
FDeviceManagementOnly := payloadObj.GetValue<Boolean>('device_management_only', False);
finally
payloadObj.Free;
end;
end;
except
Exit; // Malformed JWT — let Sparkle middleware reject it
end;
if credId = '' then Exit; // JWT predates this feature — allow through
deviceStatus := '';
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
q.SQL.Text :=
'SELECT status FROM lems.device_registrations WHERE credential_id = :CID';
q.ParamByName('CID').AsString := credId;
q.Open;
if not q.IsEmpty then
deviceStatus := q.FieldByName('status').AsString;
q.Close;
finally
q.Free;
end;
finally
conn.Free;
end;
if deviceStatus = 'revoked' then
begin
Logger.Log(2, 'RequireActiveDevice - rejected revoked credential: ' + Copy(credId, 1, 20));
raise EXDataHttpException.Create(401, 'Device access has been revoked.');
end;
end;
function TApiService.OpenLemsConnection: TUniConnection;
begin
Result := TUniConnection.Create(nil);
Result.ProviderName := 'PostgreSQL';
Result.Server := IniEntries.DatabaseServer;
Result.Port := IniEntries.DatabasePort;
Result.Database := IniEntries.DatabaseName;
Result.Username := IniEntries.DatabaseUsername;
Result.Password := IniEntries.DatabasePassword;
Result.LoginPrompt := False;
Result.Connect;
end;
function TApiService.GetDeviceList: TDeviceList;
var
conn: TUniConnection;
q: TUniQuery;
item: TDeviceItem;
begin
RequireAdmin;
Logger.Log(2, 'TApiService.GetDeviceList - call');
Result := TDeviceList.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
Result.data := TList<TDeviceItem>.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result.data);
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
q.SQL.Text :=
'SELECT id, credential_id, device_name, phone_number, username, ' +
' user_agent, registered_at, revoked_at, revoked_by, status ' +
'FROM lems.device_registrations ' +
'ORDER BY registered_at DESC';
q.Open;
try
while not q.Eof do
begin
item := TDeviceItem.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(item);
item.id := q.FieldByName('id').AsInteger;
item.credential_id := q.FieldByName('credential_id').AsString;
item.device_name := q.FieldByName('device_name').AsString;
item.phone_number := q.FieldByName('phone_number').AsString;
item.username := q.FieldByName('username').AsString;
item.user_agent := q.FieldByName('user_agent').AsString;
item.registered_at := q.FieldByName('registered_at').AsString;
if q.FieldByName('revoked_at').IsNull then
item.revoked_at := ''
else
item.revoked_at := q.FieldByName('revoked_at').AsString;
item.revoked_by := q.FieldByName('revoked_by').AsString;
item.status := q.FieldByName('status').AsString;
Result.data.Add(item);
q.Next;
end;
finally
q.Close;
end;
finally
q.Free;
end;
finally
conn.Free;
end;
Result.count := Result.data.Count;
Result.returned := Result.data.Count;
Logger.Log(2, 'TApiService.GetDeviceList - returned ' + IntToStr(Result.count));
end;
function TApiService.RevokeDevice(const CredentialId: string): TJSONObject;
var
conn: TUniConnection;
q: TUniQuery;
ctx: THttpServerContext;
revokedBy, authHeader, b64p, payload: string;
parts: TArray<string>;
padLen: Integer;
payloadObj: TJSONObject;
begin
RequireAdmin;
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
if Trim(CredentialId) = '' then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'CredentialId is required.');
Exit;
end;
// Extract revoking admin's username from JWT payload for audit trail
revokedBy := 'admin';
try
ctx := THttpServerContext.Current;
if ctx <> nil then
begin
authHeader := ctx.Request.Headers.Get('Authorization');
if authHeader.StartsWith('Bearer ') then
begin
parts := authHeader.Substring(7).Split(['.']);
if Length(parts) >= 2 then
begin
b64p := parts[1].Replace('-', '+').Replace('_', '/');
padLen := (4 - Length(b64p) mod 4) mod 4;
b64p := b64p + StringOfChar('=', padLen);
payload := TEncoding.UTF8.GetString(TNetEncoding.Base64.DecodeStringToBytes(b64p));
payloadObj := TJSONObject.ParseJSONValue(payload) as TJSONObject;
if Assigned(payloadObj) then
try
revokedBy := payloadObj.GetValue<string>('user_name', 'admin');
finally
payloadObj.Free;
end;
end;
end;
end;
except
revokedBy := 'admin';
end;
Logger.Log(2, Format('TApiService.RevokeDevice - credId: %s by: %s', [Copy(CredentialId, 1, 20), revokedBy]));
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
q.SQL.Text :=
'UPDATE lems.device_registrations ' +
'SET revoked_at = NOW(), revoked_by = :REVOKED_BY, status = ''revoked'' ' +
'WHERE credential_id = :CID AND status = ''active''';
q.ParamByName('REVOKED_BY').AsString := revokedBy;
q.ParamByName('CID').AsString := Trim(CredentialId);
q.ExecSQL;
if q.RowsAffected > 0 then
begin
Logger.Log(2, 'TApiService.RevokeDevice - revoked credential: ' + Copy(CredentialId, 1, 20));
Result.AddPair('status', 'ok');
Result.AddPair('message', 'Device access revoked.');
end
else
begin
Logger.Log(2, 'TApiService.RevokeDevice - not found or already revoked: ' + Copy(CredentialId, 1, 20));
Result.AddPair('status', 'error');
Result.AddPair('message', 'Device not found or already revoked.');
end;
finally
q.Free;
end;
finally
conn.Free;
end;
end;
function TApiService.UnrevokeDevice(const CredentialId: string): TJSONObject;
var
conn: TUniConnection;
q: TUniQuery;
begin
RequireAdmin;
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
if Trim(CredentialId) = '' then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'CredentialId is required.');
Exit;
end;
Logger.Log(2, 'TApiService.UnrevokeDevice - credId: ' + Copy(CredentialId, 1, 20));
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
q.SQL.Text :=
'UPDATE lems.device_registrations ' +
'SET revoked_at = NULL, revoked_by = NULL, status = ''active'' ' +
'WHERE credential_id = :CID AND status = ''revoked''';
q.ParamByName('CID').AsString := Trim(CredentialId);
q.ExecSQL;
if q.RowsAffected > 0 then
begin
Logger.Log(2, 'TApiService.UnrevokeDevice - restored: ' + Copy(CredentialId, 1, 20));
Result.AddPair('status', 'ok');
Result.AddPair('message', 'Device access restored.');
end
else
begin
Logger.Log(2, 'TApiService.UnrevokeDevice - not found or not revoked: ' + Copy(CredentialId, 1, 20));
Result.AddPair('status', 'error');
Result.AddPair('message', 'Device not found or not revoked.');
end;
finally
q.Free;
end;
finally
conn.Free;
end;
end;
function NormalizePhoneE164Api(const APhone: string): string;
var
digits: string;
i: Integer;
begin
digits := '';
for i := 1 to Length(APhone) do
if CharInSet(APhone[i], ['0'..'9']) then
digits := digits + APhone[i];
if (Length(digits) = 11) and (digits[1] = '1') then
Delete(digits, 1, 1);
if Length(digits) <> 10 then
raise Exception.Create('Invalid phone number. Enter a 10-digit US number.');
Result := '+1' + digits;
end;
function TApiService.AddPendingDevice(const DeviceName, PhoneNumber: string): TJSONObject;
var
conn: TUniConnection;
q: TUniQuery;
normalizedPhone: string;
begin
RequireAdmin;
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
if Trim(DeviceName) = '' then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Device name is required.');
Exit;
end;
try
normalizedPhone := NormalizePhoneE164Api(PhoneNumber);
except
on E: Exception do
begin
Result.AddPair('status', 'error');
Result.AddPair('message', E.Message);
Exit;
end;
end;
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
// Reject if a pending entry with this phone already exists
q.SQL.Text :=
'SELECT id FROM lems.device_registrations ' +
'WHERE phone_number = :PHONE AND status = ''pending''';
q.ParamByName('PHONE').AsString := normalizedPhone;
q.Open;
if not q.IsEmpty then
begin
q.Close;
Result.AddPair('status', 'error');
Result.AddPair('message', 'A pending entry for that phone number already exists.');
Exit;
end;
q.Close;
q.SQL.Text :=
'INSERT INTO lems.device_registrations (device_name, phone_number, status) ' +
'VALUES (:NAME, :PHONE, ''pending'')';
q.ParamByName('NAME').AsString := Trim(DeviceName);
q.ParamByName('PHONE').AsString := normalizedPhone;
q.ExecSQL;
Logger.Log(2, 'TApiService.AddPendingDevice - added "' + Trim(DeviceName) + '" phone: ' + normalizedPhone);
Result.AddPair('status', 'ok');
Result.AddPair('message', 'Pending device added.');
finally
q.Free;
end;
finally
conn.Free;
end;
end;
function TApiService.DeletePendingDevice(const PhoneNumber: string): TJSONObject;
var
conn: TUniConnection;
q: TUniQuery;
normalizedPhone: string;
begin
RequireAdmin;
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
try
normalizedPhone := NormalizePhoneE164Api(PhoneNumber);
except
on E: Exception do
begin
Result.AddPair('status', 'error');
Result.AddPair('message', E.Message);
Exit;
end;
end;
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
q.SQL.Text :=
'DELETE FROM lems.device_registrations ' +
'WHERE phone_number = :PHONE AND status = ''pending''';
q.ParamByName('PHONE').AsString := normalizedPhone;
q.ExecSQL;
if q.RowsAffected > 0 then
begin
Logger.Log(2, 'TApiService.DeletePendingDevice - deleted phone: ' + normalizedPhone);
Result.AddPair('status', 'ok');
Result.AddPair('message', 'Pending device removed.');
end
else
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Pending device not found.');
end;
finally
q.Free;
end;
finally
conn.Free;
end;
end;
function TApiService.SendAppLink(const PhoneNumber: string): TJSONObject;
var
conn: TUniConnection;
q: TUniQuery;
normalizedPhone, redeemCode, linkUrl, msgBody: string;
httpClient: THTTPClient;
bodyStream: TStringStream;
formData, authStr: string;
response: IHTTPResponse;
begin
RequireAdmin;
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
try
normalizedPhone := NormalizePhoneE164Api(PhoneNumber);
except
on E: Exception do
begin
Result.AddPair('status', 'error');
Result.AddPair('message', E.Message);
Exit;
end;
end;
if (ServerConfig.twilioAccountSid = '') or (ServerConfig.twilioAuthToken = '') or
(ServerConfig.twilioFromNumber = '') then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Twilio is not configured on the server.');
Exit;
end;
// Pick an unused redeem code (SKIP LOCKED for concurrent safety)
redeemCode := '';
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
conn.StartTransaction;
try
q.SQL.Text :=
'SELECT code FROM lems.redeem_codes ' +
'WHERE used_at IS NULL ' +
'ORDER BY id ' +
'LIMIT 1 FOR UPDATE SKIP LOCKED';
q.Open;
if q.IsEmpty then
begin
q.Close;
conn.Rollback;
Result.AddPair('status', 'error');
Result.AddPair('message', 'No unused redeem codes available.');
Exit;
end;
redeemCode := q.FieldByName('code').AsString;
q.Close;
q.SQL.Text :=
'UPDATE lems.redeem_codes SET used_at = NOW(), used_for = :PHONE ' +
'WHERE code = :CODE';
q.ParamByName('PHONE').AsString := normalizedPhone;
q.ParamByName('CODE').AsString := redeemCode;
q.ExecSQL;
conn.Commit;
except
conn.Rollback;
raise;
end;
finally
q.Free;
end;
finally
conn.Free;
end;
// Build and send Twilio SMS
linkUrl := 'https://apps.apple.com/redeem?code=' + redeemCode + '&ctx=apps';
msgBody := 'Your emiMobile app download link: ' + linkUrl;
authStr := TNetEncoding.Base64.Encode(ServerConfig.twilioAccountSid + ':' + ServerConfig.twilioAuthToken)
.Replace(#13, '').Replace(#10, '');
formData := 'From=' + TNetEncoding.URL.Encode(ServerConfig.twilioFromNumber) +
'&To=' + TNetEncoding.URL.Encode(normalizedPhone) +
'&Body=' + TNetEncoding.URL.Encode(msgBody);
httpClient := THTTPClient.Create;
try
httpClient.ContentType := 'application/x-www-form-urlencoded';
httpClient.CustomHeaders['Authorization'] := 'Basic ' + authStr;
bodyStream := TStringStream.Create(formData, TEncoding.UTF8);
try
response := httpClient.Post(
'https://api.twilio.com/2010-04-01/Accounts/' + ServerConfig.twilioAccountSid + '/Messages.json',
bodyStream);
if response.StatusCode >= 300 then
raise Exception.CreateFmt('Twilio error %d: %s', [response.StatusCode, response.ContentAsString]);
finally
bodyStream.Free;
end;
finally
httpClient.Free;
end;
Logger.Log(2, Format('TApiService.SendAppLink - sent to %s code %s', [normalizedPhone, redeemCode]));
Result.AddPair('status', 'ok');
Result.AddPair('message', 'App link sent via SMS.');
Result.AddPair('code', redeemCode);
end;
function TApiService.UpdateDeviceUsername(const CredentialId, Username: string): TJSONObject;
var
conn: TUniConnection;
q: TUniQuery;
begin
RequireAdmin;
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
if Trim(CredentialId) = '' then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'CredentialId is required.');
Exit;
end;
conn := OpenLemsConnection;
try
q := TUniQuery.Create(nil);
try
q.Connection := conn;
q.SQL.Text :=
'UPDATE lems.device_registrations ' +
'SET username = :UNAME ' +
'WHERE credential_id = :CID AND status = ''active''';
q.ParamByName('UNAME').AsString := Trim(Username);
q.ParamByName('CID').AsString := Trim(CredentialId);
q.ExecSQL;
if q.RowsAffected = 0 then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Device not found or not active.');
Exit;
end;
finally
q.Free;
end;
finally
conn.Free;
end;
Logger.Log(2, Format('TApiService.UpdateDeviceUsername - set username "%s" on credId %s',
[Trim(Username), Copy(CredentialId, 1, 20)]));
Result.AddPair('status', 'ok');
end;
initialization
RegisterServiceType(TApiService);
......
......@@ -39,13 +39,64 @@ type
data: TList<TAgencyConfigItem>;
end;
// Device record returned by GetDeviceList (Api.Service)
TDeviceItem = class
public
id: Integer;
credential_id: string;
device_name: string;
phone_number: string;
username: string;
agency: string;
user_agent: string;
registered_at: string;
revoked_at: string;
revoked_by: string;
status: string;
end;
TDeviceList = class
public
count: Integer;
returned: Integer;
data: TList<TDeviceItem>;
end;
[ServiceContract, Model(AUTH_MODEL)]
IAuthService = interface(IInvokable)
['{D2290B28-964C-4155-A83A-DAE87C4C7FE7}']
function Login(const user, password, agency: string): string;
// Full WebAuthn assertion login — issues JWT on success
function Login(const user, password, agency, credentialId,
challengeToken, authenticatorData, clientDataJSON,
signature: string): string;
function LoginDeviceManager(User, Password, Agency: string): string;
[HttpGet] function GetAgenciesList(): TAgenciesList;
[HttpGet] function GetAgencyConfigList: TAgencyConfigList;
function VerifyVersion(ClientVersion: string): TJSONObject;
// WebAuthn registration — step 1: server checks phone pre-auth, returns challenge
function BeginRegistration(const PhoneNumber: string): TJSONObject;
// WebAuthn registration — step 2: client submits credential, server verifies + activates pending row
function CompleteRegistration(const PhoneNumber, CredentialId,
AttestationObject, ClientDataJSON,
ChallengeToken: string): TJSONObject;
// WebAuthn authentication challenge — called before Login
function BeginAuthentication(const CredentialId: string): TJSONObject;
// Returns stored username/agency for a credential (unauthenticated; used by login form)
function GetDeviceUser(const CredentialId: string): TJSONObject;
// Passkey-only login (no password) — uses stored username+agency from device record
function LoginAutomatic(const CredentialId, ChallengeToken,
AuthenticatorData, ClientDataJSON,
Signature: string): string;
// Simple-key registration — client generates key, no crypto verification
function CompleteRegistrationSimple(const PhoneNumber, DeviceKey,
ChallengeToken: string): TJSONObject;
// Simple-key auto-login — verifies challenge token + credential ownership
function LoginDeviceKey(const CredentialId, ChallengeToken: string): string;
// Simple-key password login — password + challenge token (first login / fallback)
function LoginPasswordAndSimpleKey(const User, Password, Agency,
CredentialId, ChallengeToken: string): string;
end;
implementation
......
unit Auth.ServiceImpl;
unit Auth.ServiceImpl;
interface
......@@ -21,16 +21,39 @@ type
userBadge: string;
userId: string;
userPersonnelId: string;
userIsAdmin: Boolean;
//procedure AfterConstruction; override;
//procedure BeforeDestruction; override;
function VerifyVersion(ClientVersion: string): TJSONObject;
function CheckUser(const User, Password, Agency: string): Integer;
function LoadUserByName(const User, Agency: string): Boolean;
function Decrypt(inStr, keyStr: AnsiString): AnsiString;
// Returns True and sets AChallengeB64 if token is valid and of the expected type
function VerifyChallengeToken(const ChallengeToken, ExpectedType: string;
out AChallengeB64: string): Boolean;
public
function Login(const user, password, agency, credentialId,
challengeToken, authenticatorData, clientDataJSON,
signature: string): string;
function LoginDeviceManager(User, Password, Agency: string): string;
constructor Create;
destructor Destroy; override;
function Login(const User, Password, Agency: string): string;
function GetAgencieslist(): TAgenciesList;
function GetAgencyConfiglist: TAgencyConfigList;
function BeginRegistration(const PhoneNumber: string): TJSONObject;
function CompleteRegistration(const PhoneNumber, CredentialId,
AttestationObject, ClientDataJSON,
ChallengeToken: string): TJSONObject;
function BeginAuthentication(const CredentialId: string): TJSONObject;
function GetDeviceUser(const CredentialId: string): TJSONObject;
function LoginAutomatic(const CredentialId, ChallengeToken,
AuthenticatorData, ClientDataJSON,
Signature: string): string;
function CompleteRegistrationSimple(const PhoneNumber, DeviceKey,
ChallengeToken: string): TJSONObject;
function LoginDeviceKey(const CredentialId, ChallengeToken: string): string;
function LoginPasswordAndSimpleKey(const User, Password, Agency,
CredentialId, ChallengeToken: string): string;
end;
implementation
......@@ -38,12 +61,16 @@ implementation
uses
System.DateUtils,
System.Generics.Collections,
System.NetEncoding,
Bcl.JOSE.Core.Builder,
Bcl.JOSE.Core.JWT,
Aurelius.Global.Utils,
XData.Sys.Exceptions,
Common.Logging,
Common.Config;
Common.Config,
Sparkle.HttpServer.Context,
Webauthn.Crypto,
Webauthn.Cbor;
{ TAuthService }
......@@ -71,6 +98,1112 @@ begin
inherited Destroy;
end;
// ---------------------------------------------------------------------------
// Challenge token helpers
// ---------------------------------------------------------------------------
// Challenge token format: challengeB64url:type:expiryUnix:hmacB64url
// HMAC key = UTF-8 bytes of jwtTokenSecret
function TAuthService.VerifyChallengeToken(const ChallengeToken, ExpectedType: string;
out AChallengeB64: string): Boolean;
var
parts: TArray<string>;
expiry: Int64;
tokenData: string;
keyBytes, hmacBytes: TBytes;
computedHmac: string;
begin
Result := False;
AChallengeB64 := '';
parts := ChallengeToken.Split([':'], 4);
if Length(parts) <> 4 then Exit;
AChallengeB64 := parts[0];
if parts[1] <> ExpectedType then Exit;
expiry := StrToInt64Def(parts[2], 0);
if (expiry = 0) or (DateTimeToUnix(TTimeZone.Local.ToUniversalTime(Now)) > expiry) then
begin
Logger.Log(2, 'VerifyChallengeToken - token expired');
Exit;
end;
tokenData := parts[0] + ':' + parts[1] + ':' + parts[2];
keyBytes := TEncoding.UTF8.GetBytes(ServerConfig.jwtTokenSecret);
hmacBytes := HMACSHA256Bytes(keyBytes, TEncoding.UTF8.GetBytes(tokenData));
computedHmac := Base64UrlEncode(hmacBytes);
Result := (computedHmac = parts[3]);
if not Result then
Logger.Log(2, 'VerifyChallengeToken - HMAC mismatch');
end;
function MakeChallengeToken(const AType: string): string;
var
challenge: TBytes;
challengeB64, expiry, tokenData: string;
keyBytes, hmacBytes: TBytes;
begin
challenge := RandomBytes(32);
challengeB64 := Base64UrlEncode(challenge);
expiry := IntToStr(DateTimeToUnix(TTimeZone.Local.ToUniversalTime(IncMinute(Now, 5))));
tokenData := challengeB64 + ':' + AType + ':' + expiry;
keyBytes := TEncoding.UTF8.GetBytes(ServerConfig.jwtTokenSecret);
hmacBytes := HMACSHA256Bytes(keyBytes, TEncoding.UTF8.GetBytes(tokenData));
Result := tokenData + ':' + Base64UrlEncode(hmacBytes);
end;
// ---------------------------------------------------------------------------
// Extract hostname from a WebAuthn origin URL (e.g. "http://192.168.1.5:2009" → "192.168.1.5")
// This is what the browser uses as the effective domain for rpId binding.
function ExtractOriginHostname(const AOrigin: string): string;
var
s: string;
colonPos: Integer;
begin
s := Trim(AOrigin);
if s.StartsWith('https://') then Delete(s, 1, 8)
else if s.StartsWith('http://') then Delete(s, 1, 7);
// Strip port if present
colonPos := Pos(':', s);
if colonPos > 0 then
s := Copy(s, 1, colonPos - 1);
// Strip any trailing path
colonPos := Pos('/', s);
if colonPos > 0 then
s := Copy(s, 1, colonPos - 1);
Result := LowerCase(Trim(s));
end;
function NormalizePhoneE164(const APhone: string): string;
var
digits: string;
i: Integer;
begin
digits := '';
for i := 1 to Length(APhone) do
if CharInSet(APhone[i], ['0'..'9']) then
digits := digits + APhone[i];
if (Length(digits) = 11) and (digits[1] = '1') then
Delete(digits, 1, 1);
if Length(digits) <> 10 then
raise Exception.Create('Invalid phone number. Enter a 10-digit US number.');
Result := '+1' + digits;
end;
// ---------------------------------------------------------------------------
// BeginRegistration
// ---------------------------------------------------------------------------
function TAuthService.BeginRegistration(const PhoneNumber: string): TJSONObject;
var
token, challengeB64, normalizedPhone: string;
q: TUniQuery;
begin
Logger.Log(2, 'AuthService.BeginRegistration - phone: "' + PhoneNumber + '"');
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
if Trim(PhoneNumber) = '' then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Phone number is required.');
Exit;
end;
try
normalizedPhone := NormalizePhoneE164(PhoneNumber);
except
on E: Exception do
begin
Result.AddPair('status', 'error');
Result.AddPair('message', E.Message);
Exit;
end;
end;
// Verify phone number was pre-authorized by admin
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'SELECT id FROM lems.device_registrations ' +
'WHERE phone_number = :PHONE AND status = ''pending''';
q.ParamByName('PHONE').AsString := normalizedPhone;
q.Open;
if q.IsEmpty then
begin
q.Close;
Logger.Log(2, 'BeginRegistration - phone not pre-authorized: "' + normalizedPhone + '"');
Result.AddPair('status', 'error');
Result.AddPair('message', 'Phone number not recognized. Contact your administrator.');
Exit;
end;
q.Close;
finally
q.Free;
end;
token := MakeChallengeToken('reg');
challengeB64 := token.Split([':'], 4)[0];
Result.AddPair('challenge', challengeB64);
Result.AddPair('challengeToken', token);
Result.AddPair('rpId', ServerConfig.rpId);
Result.AddPair('rpName', ServerConfig.rpName);
end;
// ---------------------------------------------------------------------------
// CompleteRegistration
// ---------------------------------------------------------------------------
function TAuthService.CompleteRegistration(const PhoneNumber, CredentialId,
AttestationObject, ClientDataJSON, ChallengeToken: string): TJSONObject;
var
challengeB64: string;
cdJsonBytes, attObjBytes, credIdBytes: TBytes;
cdJsonText: string;
cdJson: TJSONObject;
typeVal, challengeVal, originVal, effectiveRpId: string;
authData: TBytes;
rpIdHash, credId, pubKeyX, pubKeyY: TBytes;
flags: Byte;
signCount: Cardinal;
pubKeyAlg: Integer;
expectedRpIdHash: TBytes;
q: TUniQuery;
credIdB64: string;
begin
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
Logger.Log(2, 'AuthService.CompleteRegistration - credId: ' + Copy(CredentialId, 1, 20) + '...');
// 1. Verify challenge token
if not VerifyChallengeToken(ChallengeToken, 'reg', challengeB64) then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Invalid or expired registration challenge.');
Exit;
end;
// 2. Decode and parse clientDataJSON
try
cdJsonBytes := Base64UrlDecode(ClientDataJSON);
cdJsonText := TEncoding.UTF8.GetString(cdJsonBytes);
cdJson := TJSONObject.ParseJSONValue(cdJsonText) as TJSONObject;
except
Result.AddPair('status', 'error');
Result.AddPair('message', 'Failed to parse clientDataJSON.');
Exit;
end;
if not Assigned(cdJson) then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'clientDataJSON is not valid JSON.');
Exit;
end;
try
typeVal := cdJson.GetValue<string>('type', '');
challengeVal := cdJson.GetValue<string>('challenge', '');
originVal := cdJson.GetValue<string>('origin', '');
finally
cdJson.Free;
end;
if typeVal <> 'webauthn.create' then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'clientDataJSON type mismatch.');
Exit;
end;
if challengeVal <> challengeB64 then
begin
Logger.Log(2, 'CompleteRegistration - challenge mismatch');
Result.AddPair('status', 'error');
Result.AddPair('message', 'Challenge mismatch.');
Exit;
end;
// Derive effectiveRpId from the origin the browser reported.
// Falls back to ServerConfig.rpId only if origin is absent.
effectiveRpId := ExtractOriginHostname(originVal);
if effectiveRpId = '' then
effectiveRpId := ServerConfig.rpId;
Logger.Log(2, 'CompleteRegistration - effectiveRpId: "' + effectiveRpId + '" origin: "' + originVal + '"');
// 3. Decode attestationObject and extract authData
try
attObjBytes := Base64UrlDecode(AttestationObject);
except
Result.AddPair('status', 'error');
Result.AddPair('message', 'Failed to decode attestationObject.');
Exit;
end;
if not CborGetAuthData(attObjBytes, authData) then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Failed to parse attestationObject authData.');
Exit;
end;
// 4. Parse authData
if not ParseAuthData(authData, rpIdHash, flags, signCount,
credId, pubKeyX, pubKeyY, pubKeyAlg) then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Failed to parse authData.');
Exit;
end;
// 5. Verify rpIdHash against effective rpId from clientDataJSON origin
expectedRpIdHash := SHA256Bytes(TEncoding.UTF8.GetBytes(effectiveRpId));
if not CompareMem(@rpIdHash[0], @expectedRpIdHash[0], 32) then
begin
Logger.Log(2, Format('CompleteRegistration - rpId hash mismatch. effectiveRpId="%s"', [effectiveRpId]));
Result.AddPair('status', 'error');
Result.AddPair('message', Format('rpId mismatch (server derived "%s" from origin "%s").', [effectiveRpId, originVal]));
Exit;
end;
// 6. Verify user-present flag (bit 0)
if (flags and $01) = 0 then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'User presence flag not set.');
Exit;
end;
// 7. Verify we got a valid P-256 key (alg = -7)
if (pubKeyAlg <> -7) or (Length(pubKeyX) <> 32) or (Length(pubKeyY) <> 32) then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Only ES256 (ECDSA P-256) credentials are supported.');
Exit;
end;
// 8. The credentialId from authData must match the parameter
credIdB64 := Base64UrlEncode(credId);
if credIdB64 <> Trim(CredentialId) then
begin
Logger.Log(2, 'CompleteRegistration - credential ID mismatch');
Result.AddPair('status', 'error');
Result.AddPair('message', 'Credential ID mismatch.');
Exit;
end;
// 9. Normalize phone and activate the pending row
var normalizedPhone: string := '';
try
normalizedPhone := NormalizePhoneE164(PhoneNumber);
except
on E: Exception do
begin
Result.AddPair('status', 'error');
Result.AddPair('message', E.Message);
Exit;
end;
end;
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
var ctx := THttpServerContext.Current;
var userAgent: string := '';
if ctx <> nil then
userAgent := ctx.Request.Headers.Get('User-Agent');
q.SQL.Text :=
'UPDATE lems.device_registrations ' +
'SET credential_id = :CID, user_agent = :AGENT, ' +
' public_key_x = :KEYX, public_key_y = :KEYY, ' +
' public_key_alg = :ALG, sign_count = :CNT, ' +
' status = ''active'', registered_at = NOW() ' +
'WHERE phone_number = :PHONE AND status = ''pending''';
q.ParamByName('CID').AsString := Trim(CredentialId);
q.ParamByName('AGENT').AsString := userAgent;
q.ParamByName('KEYX').AsBytes := pubKeyX;
q.ParamByName('KEYY').AsBytes := pubKeyY;
q.ParamByName('ALG').AsInteger := pubKeyAlg;
q.ParamByName('CNT').AsInteger := Integer(signCount);
q.ParamByName('PHONE').AsString := normalizedPhone;
q.ExecSQL;
if q.RowsAffected = 0 then
begin
Logger.Log(2, 'CompleteRegistration - no pending row for phone "' + normalizedPhone + '"');
Result.AddPair('status', 'error');
Result.AddPair('message', 'Phone number is not pending registration. Contact your administrator.');
Exit;
end;
finally
q.Free;
end;
Logger.Log(2, 'CompleteRegistration - activated credential for phone "' + normalizedPhone + '"');
Result.AddPair('status', 'ok');
Result.AddPair('message', 'Device registered successfully.');
Result.AddPair('credentialId', Trim(CredentialId));
end;
// ---------------------------------------------------------------------------
// BeginAuthentication
// ---------------------------------------------------------------------------
function TAuthService.BeginAuthentication(const CredentialId: string): TJSONObject;
var
q: TUniQuery;
token, challengeB64: string;
begin
Logger.Log(2, 'AuthService.BeginAuthentication - credId: ' + Copy(CredentialId, 1, 20));
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
if Trim(CredentialId) = '' then
begin
Result.AddPair('error', 'CredentialId is required.');
Exit;
end;
// Verify the credential exists and is not revoked
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'SELECT username, agency FROM lems.device_registrations ' +
'WHERE credential_id = :CID AND revoked_at IS NULL';
q.ParamByName('CID').AsString := Trim(CredentialId);
q.Open;
try
if q.IsEmpty then
begin
Logger.Log(2, 'BeginAuthentication - credential not found or revoked');
Result.AddPair('error', 'Device not registered or access has been revoked.');
Exit;
end;
finally
q.Close;
end;
finally
q.Free;
end;
token := MakeChallengeToken('auth');
challengeB64 := token.Split([':'], 4)[0];
Result.AddPair('challenge', challengeB64);
Result.AddPair('challengeToken', token);
end;
// ---------------------------------------------------------------------------
// GetDeviceUser — unauthenticated; returns stored username/agency for the
// credential so the login form can offer passkey-only auto-login
// ---------------------------------------------------------------------------
function TAuthService.GetDeviceUser(const CredentialId: string): TJSONObject;
var
q: TUniQuery;
begin
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
if Trim(CredentialId) = '' then
begin
Result.AddPair('username', '');
Result.AddPair('agency', '');
Exit;
end;
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'SELECT username, agency FROM lems.device_registrations ' +
'WHERE credential_id = :CID AND status = ''active''';
q.ParamByName('CID').AsString := Trim(CredentialId);
q.Open;
try
if q.IsEmpty then
begin
Result.AddPair('username', '');
Result.AddPair('agency', '');
end
else
begin
Result.AddPair('username', q.FieldByName('username').AsString);
Result.AddPair('agency', q.FieldByName('agency').AsString);
end;
finally
q.Close;
end;
finally
q.Free;
end;
end;
// ---------------------------------------------------------------------------
// Login — verifies WebAuthn assertion then issues JWT
// ---------------------------------------------------------------------------
function TAuthService.Login(const user, password, agency, credentialId,
challengeToken, authenticatorData, clientDataJSON, signature: string): string;
var
userState: Integer;
challengeB64: string;
cdJsonBytes, authDataBytes, sigBytes: TBytes;
cdJsonText: string;
cdJson: TJSONObject;
typeVal, challengeVal, loginOriginVal, loginEffectiveRpId: string;
rpIdHash, expectedRpIdHash: TBytes;
flags: Byte;
signCount: Cardinal;
pubKeyX, pubKeyY: TBytes;
message: TBytes;
q: TUniQuery;
storedSignCount: Int64;
JWT: TJWT;
begin
Logger.Log(1, Format('AuthService.Login - User: "%s" Agency: "%s"', [user, agency]));
// 1. Verify user credentials
try
userState := CheckUser(user, password, agency);
except
on E: Exception do
begin
Logger.Log(2, 'AuthService.Login - CheckUser error: ' + E.ClassName + ': ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed');
end;
end;
if userState = 0 then
begin
Logger.Log(2, Format('AuthService.Login - invalid login for User: "%s" Agency: "%s"', [user, agency]));
raise EXDataHttpUnauthorized.Create('Invalid user or password');
end;
if userState = 1 then
begin
Logger.Log(2, Format('AuthService.Login - inactive user: "%s" Agency: "%s"', [user, agency]));
raise EXDataHttpUnauthorized.Create('User not active');
end;
// 2. Verify challenge token
if not VerifyChallengeToken(challengeToken, 'auth', challengeB64) then
raise EXDataHttpUnauthorized.Create('Invalid or expired authentication challenge.');
// 3. Parse and verify clientDataJSON
try
cdJsonBytes := Base64UrlDecode(clientDataJSON);
cdJsonText := TEncoding.UTF8.GetString(cdJsonBytes);
cdJson := TJSONObject.ParseJSONValue(cdJsonText) as TJSONObject;
except
raise EXDataHttpUnauthorized.Create('Failed to parse clientDataJSON.');
end;
if not Assigned(cdJson) then
raise EXDataHttpUnauthorized.Create('clientDataJSON is not valid JSON.');
try
typeVal := cdJson.GetValue<string>('type', '');
challengeVal := cdJson.GetValue<string>('challenge', '');
loginOriginVal := cdJson.GetValue<string>('origin', '');
finally
cdJson.Free;
end;
if typeVal <> 'webauthn.get' then
raise EXDataHttpUnauthorized.Create('clientDataJSON type mismatch.');
if challengeVal <> challengeB64 then
raise EXDataHttpUnauthorized.Create('Challenge mismatch.');
loginEffectiveRpId := ExtractOriginHostname(loginOriginVal);
if loginEffectiveRpId = '' then
loginEffectiveRpId := ServerConfig.rpId;
Logger.Log(2, Format('AuthService.Login - effectiveRpId: "%s" origin: "%s"', [loginEffectiveRpId, loginOriginVal]));
// 4. Load credential from DB
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'SELECT public_key_x, public_key_y, sign_count ' +
'FROM lems.device_registrations ' +
'WHERE credential_id = :CID AND revoked_at IS NULL';
q.ParamByName('CID').AsString := Trim(credentialId);
q.Open;
try
if q.IsEmpty then
begin
Logger.Log(2, 'AuthService.Login - credential not found or revoked: ' + Copy(credentialId, 1, 20));
raise EXDataHttpUnauthorized.Create('Device not registered or access has been revoked.');
end;
pubKeyX := q.FieldByName('public_key_x').AsBytes;
pubKeyY := q.FieldByName('public_key_y').AsBytes;
storedSignCount := q.FieldByName('sign_count').AsLargeInt;
finally
q.Close;
end;
finally
q.Free;
end;
// 5. Parse authenticatorData
try
authDataBytes := Base64UrlDecode(authenticatorData);
except
raise EXDataHttpUnauthorized.Create('Failed to decode authenticatorData.');
end;
if Length(authDataBytes) < 37 then
raise EXDataHttpUnauthorized.Create('authenticatorData too short.');
// Verify rpIdHash (first 32 bytes of authData) against effective rpId from clientDataJSON origin
SetLength(rpIdHash, 32);
Move(authDataBytes[0], rpIdHash[0], 32);
expectedRpIdHash := SHA256Bytes(TEncoding.UTF8.GetBytes(loginEffectiveRpId));
if not CompareMem(@rpIdHash[0], @expectedRpIdHash[0], 32) then
raise EXDataHttpUnauthorized.Create(
Format('rpId mismatch — server used "%s" (from origin "%s")', [loginEffectiveRpId, loginOriginVal]));
// Check user-present flag
flags := authDataBytes[32];
if (flags and $01) = 0 then
raise EXDataHttpUnauthorized.Create('User presence flag not set.');
// 6. Verify ECDSA signature
// message = authenticatorData || SHA256(clientDataJSON)
SetLength(message, Length(authDataBytes) + 32);
Move(authDataBytes[0], message[0], Length(authDataBytes));
var cdHash := SHA256Bytes(cdJsonBytes);
Move(cdHash[0], message[Length(authDataBytes)], 32);
try
sigBytes := Base64UrlDecode(signature);
except
raise EXDataHttpUnauthorized.Create('Failed to decode signature.');
end;
if not VerifyECDSAP256(pubKeyX, pubKeyY, message, sigBytes) then
begin
Logger.Log(2, 'AuthService.Login - signature verification failed for credId: ' + Copy(credentialId, 1, 20));
raise EXDataHttpUnauthorized.Create('WebAuthn signature verification failed.');
end;
// 7. Update sign count (replay attack protection)
signCount := (Cardinal(authDataBytes[33]) shl 24) or
(Cardinal(authDataBytes[34]) shl 16) or
(Cardinal(authDataBytes[35]) shl 8) or
authDataBytes[36];
if (storedSignCount > 0) and (Int64(signCount) <= storedSignCount) then
Logger.Log(1, 'AuthService.Login - WARNING: sign count did not increase (possible cloned authenticator)');
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'UPDATE lems.device_registrations SET sign_count = :CNT WHERE credential_id = :CID';
q.ParamByName('CNT').AsInteger := Integer(signCount);
q.ParamByName('CID').AsString := Trim(credentialId);
q.ExecSQL;
finally
q.Free;
end;
// 8. Issue JWT
Logger.Log(2, Format('AuthService.Login - success for User: "%s" Agency: "%s"', [user, agency]));
JWT := TJWT.Create;
try
JWT.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
JWT.Claims.IssuedAt := Now;
JWT.Claims.Expiration := IncHour(Now, 24);
JWT.Claims.SetClaimOfType<string>('user_name', userName);
JWT.Claims.SetClaimOfType<string>('user_fullname', userFullName);
JWT.Claims.SetClaimOfType<string>('user_agency', userAgency);
JWT.Claims.SetClaimOfType<string>('user_badge', userBadge);
JWT.Claims.SetClaimOfType<string>('user_id', userId);
JWT.Claims.SetClaimOfType<string>('user_personnelid', userPersonnelId);
JWT.Claims.SetClaimOfType<Boolean>('user_admin', userIsAdmin);
JWT.Claims.SetClaimOfType<string>('credential_id', Trim(credentialId));
Result := TJOSE.SHA256CompactToken(ServerConfig.jwtTokenSecret, JWT);
finally
JWT.Free;
end;
// 9. Persist username + agency on the device record so future auto-login works
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'UPDATE lems.device_registrations ' +
'SET username = :UNAME, agency = :AGCY ' +
'WHERE credential_id = :CID';
q.ParamByName('UNAME').AsString := userName;
q.ParamByName('AGCY').AsString := userAgency;
q.ParamByName('CID').AsString := Trim(credentialId);
q.ExecSQL;
finally
q.Free;
end;
end;
// ---------------------------------------------------------------------------
// LoadUserByName — like CheckUser but without password verification
// ---------------------------------------------------------------------------
function TAuthService.LoadUserByName(const User, Agency: string): Boolean;
begin
authDB.uqAuth.Close;
authDB.uqAuth.SQL.Text :=
'select u.* from lems.users u ' +
'where upper(user_name) = :USER_NAME ' +
'and u.dept = :AGENCY';
authDB.uqAuth.ParamByName('USER_NAME').AsString := UpperCase(Trim(User));
authDB.uqAuth.ParamByName('AGENCY').AsString := UpperCase(Trim(Agency));
authDB.uqAuth.Open;
try
if authDB.uqAuth.IsEmpty then
Exit(False);
if authDB.uqAuth.FieldByName('active').AsString = 'F' then
Exit(False);
userName := authDB.uqAuth.FieldByName('user_name').AsString;
userFullName := authDB.uqAuth.FieldByName('firstname').AsString + ' ' +
authDB.uqAuth.FieldByName('lastname').AsString;
userAgency := authDB.uqAuth.FieldByName('dept').AsString;
userBadge := authDB.uqAuth.FieldByName('badgenum').AsString;
userId := authDB.uqAuth.FieldByName('userid').AsString;
userPersonnelId := authDB.uqAuth.FieldByName('personnelid').AsString;
userIsAdmin := SameText(Trim(User), 'admin');
Result := True;
finally
authDB.uqAuth.Close;
end;
end;
// ---------------------------------------------------------------------------
// LoginAutomatic — WebAuthn assertion login without username/password
// Uses stored username + agency from device_registrations
// ---------------------------------------------------------------------------
function TAuthService.LoginAutomatic(const CredentialId, ChallengeToken,
AuthenticatorData, ClientDataJSON, Signature: string): string;
var
challengeB64: string;
cdJsonBytes, authDataBytes, sigBytes: TBytes;
cdJsonText: string;
cdJson: TJSONObject;
typeVal, challengeVal, loginOriginVal, loginEffectiveRpId: string;
rpIdHash, expectedRpIdHash: TBytes;
flags: Byte;
signCount: Cardinal;
pubKeyX, pubKeyY: TBytes;
message: TBytes;
q: TUniQuery;
storedSignCount: Int64;
storedUsername, storedAgency: string;
JWT: TJWT;
begin
Logger.Log(2, 'AuthService.LoginAutomatic - credId: ' + Copy(CredentialId, 1, 20));
// 1. Verify challenge token
if not VerifyChallengeToken(ChallengeToken, 'auth', challengeB64) then
raise EXDataHttpUnauthorized.Create('Invalid or expired authentication challenge.');
// 2. Parse and verify clientDataJSON
try
cdJsonBytes := Base64UrlDecode(ClientDataJSON);
cdJsonText := TEncoding.UTF8.GetString(cdJsonBytes);
cdJson := TJSONObject.ParseJSONValue(cdJsonText) as TJSONObject;
except
raise EXDataHttpUnauthorized.Create('Failed to parse clientDataJSON.');
end;
if not Assigned(cdJson) then
raise EXDataHttpUnauthorized.Create('clientDataJSON is not valid JSON.');
try
typeVal := cdJson.GetValue<string>('type', '');
challengeVal := cdJson.GetValue<string>('challenge', '');
loginOriginVal := cdJson.GetValue<string>('origin', '');
finally
cdJson.Free;
end;
if typeVal <> 'webauthn.get' then
raise EXDataHttpUnauthorized.Create('clientDataJSON type mismatch.');
if challengeVal <> challengeB64 then
raise EXDataHttpUnauthorized.Create('Challenge mismatch.');
loginEffectiveRpId := ExtractOriginHostname(loginOriginVal);
if loginEffectiveRpId = '' then
loginEffectiveRpId := ServerConfig.rpId;
// 3. Load credential + stored username/agency from DB
storedUsername := '';
storedAgency := '';
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'SELECT public_key_x, public_key_y, sign_count, username, agency ' +
'FROM lems.device_registrations ' +
'WHERE credential_id = :CID AND status = ''active''';
q.ParamByName('CID').AsString := Trim(CredentialId);
q.Open;
try
if q.IsEmpty then
raise EXDataHttpUnauthorized.Create('Device not registered or access has been revoked.');
pubKeyX := q.FieldByName('public_key_x').AsBytes;
pubKeyY := q.FieldByName('public_key_y').AsBytes;
storedSignCount := q.FieldByName('sign_count').AsLargeInt;
storedUsername := q.FieldByName('username').AsString;
storedAgency := q.FieldByName('agency').AsString;
finally
q.Close;
end;
finally
q.Free;
end;
if (storedUsername = '') or (storedAgency = '') then
raise EXDataHttpUnauthorized.Create(
'No username saved for this device. Please sign in with your username and password first.');
// 4. Parse authenticatorData
try
authDataBytes := Base64UrlDecode(AuthenticatorData);
except
raise EXDataHttpUnauthorized.Create('Failed to decode authenticatorData.');
end;
if Length(authDataBytes) < 37 then
raise EXDataHttpUnauthorized.Create('authenticatorData too short.');
SetLength(rpIdHash, 32);
Move(authDataBytes[0], rpIdHash[0], 32);
expectedRpIdHash := SHA256Bytes(TEncoding.UTF8.GetBytes(loginEffectiveRpId));
if not CompareMem(@rpIdHash[0], @expectedRpIdHash[0], 32) then
raise EXDataHttpUnauthorized.Create(
Format('rpId mismatch — server used "%s"', [loginEffectiveRpId]));
flags := authDataBytes[32];
if (flags and $01) = 0 then
raise EXDataHttpUnauthorized.Create('User presence flag not set.');
// 5. Verify ECDSA signature
SetLength(message, Length(authDataBytes) + 32);
Move(authDataBytes[0], message[0], Length(authDataBytes));
var cdHash := SHA256Bytes(cdJsonBytes);
Move(cdHash[0], message[Length(authDataBytes)], 32);
try
sigBytes := Base64UrlDecode(Signature);
except
raise EXDataHttpUnauthorized.Create('Failed to decode signature.');
end;
if not VerifyECDSAP256(pubKeyX, pubKeyY, message, sigBytes) then
raise EXDataHttpUnauthorized.Create('WebAuthn signature verification failed.');
// 6. Update sign count
signCount := (Cardinal(authDataBytes[33]) shl 24) or
(Cardinal(authDataBytes[34]) shl 16) or
(Cardinal(authDataBytes[35]) shl 8) or
authDataBytes[36];
if (storedSignCount > 0) and (Int64(signCount) <= storedSignCount) then
Logger.Log(1, 'AuthService.LoginAutomatic - WARNING: sign count did not increase');
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'UPDATE lems.device_registrations SET sign_count = :CNT WHERE credential_id = :CID';
q.ParamByName('CNT').AsInteger := Integer(signCount);
q.ParamByName('CID').AsString := Trim(CredentialId);
q.ExecSQL;
finally
q.Free;
end;
// 7. Load user details from CAD (no password check)
if not LoadUserByName(storedUsername, storedAgency) then
raise EXDataHttpUnauthorized.Create(
Format('User "%s" not found or inactive in agency "%s".', [storedUsername, storedAgency]));
Logger.Log(2, Format('AuthService.LoginAutomatic - success for User: "%s" Agency: "%s"',
[userName, userAgency]));
// 8. Issue JWT
JWT := TJWT.Create;
try
JWT.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
JWT.Claims.IssuedAt := Now;
JWT.Claims.Expiration := IncHour(Now, 24);
JWT.Claims.SetClaimOfType<string>('user_name', userName);
JWT.Claims.SetClaimOfType<string>('user_fullname', userFullName);
JWT.Claims.SetClaimOfType<string>('user_agency', userAgency);
JWT.Claims.SetClaimOfType<string>('user_badge', userBadge);
JWT.Claims.SetClaimOfType<string>('user_id', userId);
JWT.Claims.SetClaimOfType<string>('user_personnelid', userPersonnelId);
JWT.Claims.SetClaimOfType<Boolean>('user_admin', userIsAdmin);
JWT.Claims.SetClaimOfType<string>('credential_id', Trim(CredentialId));
Result := TJOSE.SHA256CompactToken(ServerConfig.jwtTokenSecret, JWT);
finally
JWT.Free;
end;
end;
// ---------------------------------------------------------------------------
// CompleteRegistrationSimple — client-generated key, no crypto verification
// ---------------------------------------------------------------------------
function TAuthService.CompleteRegistrationSimple(const PhoneNumber, DeviceKey,
ChallengeToken: string): TJSONObject;
var
challengeB64, normalizedPhone: string;
q: TUniQuery;
begin
Result := TJSONObject.Create;
TXDataOperationContext.Current.Handler.ManagedObjects.Add(Result);
Logger.Log(2, 'AuthService.CompleteRegistrationSimple - phone: "' + PhoneNumber + '"');
if not VerifyChallengeToken(ChallengeToken, 'reg', challengeB64) then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Invalid or expired registration challenge.');
Exit;
end;
if Trim(DeviceKey) = '' then
begin
Result.AddPair('status', 'error');
Result.AddPair('message', 'Device key is required.');
Exit;
end;
try
normalizedPhone := NormalizePhoneE164(PhoneNumber);
except
on E: Exception do
begin
Result.AddPair('status', 'error');
Result.AddPair('message', E.Message);
Exit;
end;
end;
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
var ctx := THttpServerContext.Current;
var userAgent: string := '';
if ctx <> nil then
userAgent := ctx.Request.Headers.Get('User-Agent');
q.SQL.Text :=
'UPDATE lems.device_registrations ' +
'SET credential_id = :CID, user_agent = :AGENT, ' +
' key_type = ''simple'', ' +
' status = ''active'', registered_at = NOW() ' +
'WHERE phone_number = :PHONE AND status = ''pending''';
q.ParamByName('CID').AsString := Trim(DeviceKey);
q.ParamByName('AGENT').AsString := userAgent;
q.ParamByName('PHONE').AsString := normalizedPhone;
q.ExecSQL;
if q.RowsAffected = 0 then
begin
Logger.Log(2, 'CompleteRegistrationSimple - no pending row for "' + normalizedPhone + '"');
Result.AddPair('status', 'error');
Result.AddPair('message', 'Phone number is not pending registration. Contact your administrator.');
Exit;
end;
finally
q.Free;
end;
Logger.Log(2, 'CompleteRegistrationSimple - activated simple key for "' + normalizedPhone + '"');
Result.AddPair('status', 'ok');
Result.AddPair('message', 'Device registered successfully.');
Result.AddPair('credentialId', Trim(DeviceKey));
end;
// ---------------------------------------------------------------------------
// LoginDeviceKey — auto-login for simple-key devices (no password)
// ---------------------------------------------------------------------------
function TAuthService.LoginDeviceKey(const CredentialId, ChallengeToken: string): string;
var
challengeB64: string;
storedUsername, storedAgency: string;
q: TUniQuery;
JWT: TJWT;
begin
Logger.Log(2, 'AuthService.LoginDeviceKey - credId: ' + Copy(CredentialId, 1, 20));
if not VerifyChallengeToken(ChallengeToken, 'auth', challengeB64) then
raise EXDataHttpUnauthorized.Create('Invalid or expired authentication challenge.');
storedUsername := '';
storedAgency := '';
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'SELECT username, agency FROM lems.device_registrations ' +
'WHERE credential_id = :CID AND key_type = ''simple'' AND status = ''active''';
q.ParamByName('CID').AsString := Trim(CredentialId);
q.Open;
try
if q.IsEmpty then
raise EXDataHttpUnauthorized.Create('Device not registered, revoked, or not a simple-key device.');
storedUsername := q.FieldByName('username').AsString;
storedAgency := q.FieldByName('agency').AsString;
finally
q.Close;
end;
finally
q.Free;
end;
if (storedUsername = '') or (storedAgency = '') then
raise EXDataHttpUnauthorized.Create(
'No username saved for this device. Please sign in with your username and password first.');
if not LoadUserByName(storedUsername, storedAgency) then
raise EXDataHttpUnauthorized.Create(
Format('User "%s" not found or inactive.', [storedUsername]));
Logger.Log(2, Format('AuthService.LoginDeviceKey - success for User: "%s"', [userName]));
JWT := TJWT.Create;
try
JWT.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
JWT.Claims.IssuedAt := Now;
JWT.Claims.Expiration := IncHour(Now, 24);
JWT.Claims.SetClaimOfType<string>('user_name', userName);
JWT.Claims.SetClaimOfType<string>('user_fullname', userFullName);
JWT.Claims.SetClaimOfType<string>('user_agency', userAgency);
JWT.Claims.SetClaimOfType<string>('user_badge', userBadge);
JWT.Claims.SetClaimOfType<string>('user_id', userId);
JWT.Claims.SetClaimOfType<string>('user_personnelid', userPersonnelId);
JWT.Claims.SetClaimOfType<Boolean>('user_admin', userIsAdmin);
JWT.Claims.SetClaimOfType<string>('credential_id', Trim(CredentialId));
Result := TJOSE.SHA256CompactToken(ServerConfig.jwtTokenSecret, JWT);
finally
JWT.Free;
end;
end;
// ---------------------------------------------------------------------------
// LoginPasswordAndSimpleKey — password login for simple-key devices
// ---------------------------------------------------------------------------
function TAuthService.LoginPasswordAndSimpleKey(const User, Password, Agency,
CredentialId, ChallengeToken: string): string;
var
challengeB64: string;
userState: Integer;
q: TUniQuery;
JWT: TJWT;
begin
Logger.Log(1, Format('AuthService.LoginPasswordAndSimpleKey - User: "%s" Agency: "%s"', [User, Agency]));
try
userState := CheckUser(User, Password, Agency);
except
on E: Exception do
begin
Logger.Log(2, 'LoginPasswordAndSimpleKey - CheckUser error: ' + E.ClassName + ': ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed');
end;
end;
if userState = 0 then
raise EXDataHttpUnauthorized.Create('Invalid user or password');
if userState = 1 then
raise EXDataHttpUnauthorized.Create('User not active');
if not VerifyChallengeToken(ChallengeToken, 'auth', challengeB64) then
raise EXDataHttpUnauthorized.Create('Invalid or expired authentication challenge.');
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'SELECT id FROM lems.device_registrations ' +
'WHERE credential_id = :CID AND key_type = ''simple'' AND status = ''active''';
q.ParamByName('CID').AsString := Trim(CredentialId);
q.Open;
try
if q.IsEmpty then
raise EXDataHttpUnauthorized.Create('Device not registered or not a simple-key device.');
finally
q.Close;
end;
finally
q.Free;
end;
Logger.Log(2, Format('AuthService.LoginPasswordAndSimpleKey - success for User: "%s"', [User]));
JWT := TJWT.Create;
try
JWT.Claims.JWTId := LowerCase(Copy(TUtils.GuidToVariant(TUtils.NewGuid), 2, 36));
JWT.Claims.IssuedAt := Now;
JWT.Claims.Expiration := IncHour(Now, 24);
JWT.Claims.SetClaimOfType<string>('user_name', userName);
JWT.Claims.SetClaimOfType<string>('user_fullname', userFullName);
JWT.Claims.SetClaimOfType<string>('user_agency', userAgency);
JWT.Claims.SetClaimOfType<string>('user_badge', userBadge);
JWT.Claims.SetClaimOfType<string>('user_id', userId);
JWT.Claims.SetClaimOfType<string>('user_personnelid', userPersonnelId);
JWT.Claims.SetClaimOfType<Boolean>('user_admin', userIsAdmin);
JWT.Claims.SetClaimOfType<string>('credential_id', Trim(CredentialId));
Result := TJOSE.SHA256CompactToken(ServerConfig.jwtTokenSecret, JWT);
finally
JWT.Free;
end;
// Persist username + agency so future auto-logins work
q := TUniQuery.Create(nil);
try
q.Connection := authDB.ucLemsOCSO;
q.SQL.Text :=
'UPDATE lems.device_registrations ' +
'SET username = :UNAME, agency = :AGCY ' +
'WHERE credential_id = :CID';
q.ParamByName('UNAME').AsString := userName;
q.ParamByName('AGCY').AsString := userAgency;
q.ParamByName('CID').AsString := Trim(CredentialId);
q.ExecSQL;
finally
q.Free;
end;
end;
// ---------------------------------------------------------------------------
// Existing methods (unchanged)
// ---------------------------------------------------------------------------
function TAuthService.GetAgenciesList: TAgenciesList;
var
......@@ -162,7 +1295,6 @@ begin
Logger.Log(2, 'GetAgencyConfigList - ' + IntToStr(Result.Count));
end;
function TAuthService.VerifyVersion(ClientVersion: string): TJSONObject;
var
iniFile: TIniFile;
......@@ -206,35 +1338,68 @@ begin
end;
end;
//
//function TAuthService.Login(const User, Password, Agency: string): string;
//var
// userState: Integer;
// JWT: TJWT;
//begin
// Logger.Log(1, Format('AuthService.Login - User: "%s" Agency: "%s"', [User, Agency]));
// userState := CheckUser(User, Password, Agency);
//
// try
// userState := CheckUser(User, Password, Agency);
// except
// on E: Exception do
// begin
// Logger.Log(2, 'AuthService.Login - CheckUser error: ' + E.ClassName + ': ' + E.Message);
// raise EXDataHttpException.Create(500, 'Login failed');
// end;
// end;
//
// if userState = 0 then
// begin
// Logger.Log(2, Format('AuthService.Login - invalid login for User: "%s" Agency: "%s"', [User, Agency]));
// raise EXDataHttpUnauthorized.Create('Invalid user or password');
// end;
//
// if userState = 1 then
// begin
// Logger.Log(2, Format('AuthService.Login - inactive user: "%s" Agency: "%s"', [User, Agency]));
// raise EXDataHttpUnauthorized.Create('User not active');
// 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, 24);
// JWT.Claims.SetClaimOfType<string>('user_name', userName);
// JWT.Claims.SetClaimOfType<string>('user_fullname', userFullName);
// JWT.Claims.SetClaimOfType<string>('user_agency', userAgency);
// JWT.Claims.SetClaimOfType<string>('user_badge', userBadge);
// JWT.Claims.SetClaimOfType<string>('user_id', userId);
// JWT.Claims.SetClaimOfType<string>('user_personnelid', userPersonnelId);
// Result := TJOSE.SHA256CompactToken(ServerConfig.jwtTokenSecret, JWT);
// finally
// JWT.Free;
// end;
//end;
function TAuthService.Login(const User, Password, Agency: string): string;
function TAuthService.LoginDeviceManager(User, Password, Agency: string): string;
var
userState: Integer;
JWT: TJWT;
begin
Logger.Log(1, Format('AuthService.Login - User: "%s" Agency: "%s"', [User, Agency]));
if not SameText(Trim(User), 'ADMIN') then
raise EXDataHttpUnauthorized.Create('Invalid administrator username or password');
try
userState := CheckUser(User, Password, Agency);
except
on E: Exception do
begin
Logger.Log(2, 'AuthService.Login - CheckUser error: ' + E.ClassName + ': ' + E.Message);
raise EXDataHttpException.Create(500, 'Login failed');
end;
end;
if (Trim(Password) = '') or (Trim(Agency) = '') then
raise EXDataHttpUnauthorized.Create('Username, password, and agency are required');
if userState = 0 then
begin
Logger.Log(2, Format('AuthService.Login - invalid login for User: "%s" Agency: "%s"', [User, Agency]));
raise EXDataHttpUnauthorized.Create('Invalid user or password');
end;
if userState = 1 then
begin
Logger.Log(2, Format('AuthService.Login - inactive user: "%s" Agency: "%s"', [User, Agency]));
raise EXDataHttpUnauthorized.Create('User not active');
end;
userState := CheckUser(User, Password, Agency);
if userState <> 2 then
raise EXDataHttpUnauthorized.Create('Invalid administrator username or password, or account inactive');
JWT := TJWT.Create;
try
......@@ -242,11 +1407,9 @@ begin
JWT.Claims.IssuedAt := Now;
JWT.Claims.Expiration := IncHour(Now, 24);
JWT.Claims.SetClaimOfType<string>('user_name', userName);
JWT.Claims.SetClaimOfType<string>('user_fullname', userFullName);
JWT.Claims.SetClaimOfType<string>('user_agency', userAgency);
JWT.Claims.SetClaimOfType<string>('user_badge', userBadge);
JWT.Claims.SetClaimOfType<string>('user_id', userId);
JWT.Claims.SetClaimOfType<string>('user_personnelid', userPersonnelId);
JWT.Claims.SetClaimOfType<Boolean>('user_admin', True);
JWT.Claims.SetClaimOfType<Boolean>('device_management_only', True);
Result := TJOSE.SHA256CompactToken(ServerConfig.jwtTokenSecret, JWT);
finally
JWT.Free;
......@@ -292,6 +1455,8 @@ begin
userId := authDB.uqAuth.FieldByName('userid').AsString;
userPersonnelId := authDB.uqAuth.FieldByName('personnelid').AsString;
userIsAdmin := SameText(Trim(User), 'admin');
userStr := '?username=' + userName;
userStr := userStr + '&fullname=' + userFullName;
userStr := userStr + '&agency=' + userAgency;
......@@ -316,11 +1481,8 @@ var
k, i: integer;
tempKeyStr: AnsiString;
begin
if inStr = '' then
Exit('');
if keyStr = '' then
Exit('');
if inStr = '' then Exit('');
if keyStr = '' then Exit('');
k := Integer(inStr[1]);
tempKeyStr := keyStr;
......@@ -339,4 +1501,3 @@ initialization
RegisterServiceType(TAuthService);
end.
......@@ -14,6 +14,11 @@ type
FWebAppFolder: string;
FReportsFolder: string;
FAuditEnabled: Boolean;
FRpId: string;
FRpName: string;
FTwilioAccountSid: string;
FTwilioAuthToken: string;
FTwilioFromNumber: string;
public
constructor Create;
property url: string read FUrl write FUrl;
......@@ -22,6 +27,13 @@ type
property webAppFolder: string read FWebAppFolder write FWebAppFolder;
property reportsFolder: string read FReportsFolder write FReportsFolder;
property auditEnabled: Boolean read FAuditEnabled write FAuditEnabled;
// WebAuthn Relying Party — must match the domain serving the app (e.g. "localhost")
property rpId: string read FRpId write FRpId;
property rpName: string read FRpName write FRpName;
// Twilio SMS (for sending App Store redemption links)
property twilioAccountSid: string read FTwilioAccountSid write FTwilioAccountSid;
property twilioAuthToken: string read FTwilioAuthToken write FTwilioAuthToken;
property twilioFromNumber: string read FTwilioFromNumber write FTwilioFromNumber;
end;
procedure LoadServerConfig;
......@@ -32,27 +44,62 @@ var
implementation
uses
Bcl.Json, System.SysUtils, System.IOUtils, System.StrUtils,
System.JSON, System.SysUtils, System.IOUtils, System.StrUtils,
Common.Logging;
procedure LoadServerConfig;
function GetStr(obj: TJSONObject; const key: string): string;
var
v: TJSONValue;
begin
v := obj.GetValue(key);
if Assigned(v) and not (v is TJSONNull) then
Result := v.Value
else
Result := '';
end;
var
configFile: string;
localConfig: TServerConfig;
configFile, s: string;
jsonObj: TJSONObject;
begin
Logger.Log(1, '--LoadServerConfig - start');
configFile := TPath.ChangeExtension(ParamStr(0), '.json');
Logger.Log(1, '-- Config file: ' + configFile);
if TFile.Exists(configFile) then
if not TFile.Exists(configFile) then
begin
Logger.Log(1, '-- Config file not found.');
Logger.Log(1, '--LoadServerConfig - end');
Exit;
end;
Logger.Log(1, '-- Config file found.');
localConfig := TJson.Deserialize<TServerConfig>(TFile.ReadAllText(configFile));
Logger.Log(1, '-- localConfig loaded from config file');
serverConfig.Free;
Logger.Log(1, '-- serverConfig.Free - called');
serverConfig := localConfig;
Logger.Log(1, '-- serverConfig := localConfig - called');
jsonObj := TJSONObject.ParseJSONValue(TFile.ReadAllText(configFile)) as TJSONObject;
if not Assigned(jsonObj) then
begin
Logger.Log(1, '-- Config file could not be parsed as JSON.');
Logger.Log(1, '--LoadServerConfig - end');
Exit;
end;
try
s := GetStr(jsonObj, 'url'); if s <> '' then serverConfig.url := s;
s := GetStr(jsonObj, 'jwtTokenSecret'); if s <> '' then serverConfig.jwtTokenSecret := s;
s := GetStr(jsonObj, 'adminPassword'); if s <> '' then serverConfig.adminPassword := s;
s := GetStr(jsonObj, 'webAppFolder'); if s <> '' then serverConfig.webAppFolder := s;
s := GetStr(jsonObj, 'reportsFolder'); if s <> '' then serverConfig.reportsFolder := s;
s := GetStr(jsonObj, 'rpId'); if s <> '' then serverConfig.rpId := s;
s := GetStr(jsonObj, 'rpName'); if s <> '' then serverConfig.rpName := s;
serverConfig.twilioAccountSid := GetStr(jsonObj, 'twilioAccountSid');
serverConfig.twilioAuthToken := GetStr(jsonObj, 'twilioAuthToken');
serverConfig.twilioFromNumber := GetStr(jsonObj, 'twilioFromNumber');
serverConfig.auditEnabled := jsonObj.GetValue<Boolean>('auditEnabled', serverConfig.auditEnabled);
finally
jsonObj.Free;
end;
Logger.Log(1, '');
Logger.Log(1, '--- Server Config Values ---');
......@@ -60,13 +107,11 @@ begin
Logger.Log(1, '-- adminPassword: ' + serverConfig.adminPassword + IfThen(serverConfig.adminPassword = 'whatisthisusedfor', ' [default]', ' [from config]'));
Logger.Log(1, '-- jwtTokenSecret: ' + serverConfig.jwtTokenSecret + IfThen(serverConfig.jwtTokenSecret = 'super_secret0123super_secret4567', ' [default]', ' [from config]'));
Logger.Log(1, '-- webAppFolder: ' + serverConfig.webAppFolder + IfThen(serverConfig.webAppFolder = 'static', ' [default]', ' [from config]'));
Logger.Log(1, '-- rpId: ' + serverConfig.rpId + IfThen(serverConfig.rpId = 'wcemimobile.em-sys.net', ' [default]', ' [from config]'));
Logger.Log(1, '-- auditEnabled: ' + BoolToStr(serverConfig.auditEnabled, True));
end
else
begin
Logger.Log(1, '-- Config file not found.');
end;
Logger.Log(1, '-- twilioAccountSid: ' + IfThen(serverConfig.twilioAccountSid <> '', '[configured]', '[not set]'));
Logger.Log(1, '-- twilioAuthToken: ' + IfThen(serverConfig.twilioAuthToken <> '', '[configured]', '[not set]'));
Logger.Log(1, '-- twilioFromNumber: ' + serverConfig.twilioFromNumber + IfThen(serverConfig.twilioFromNumber <> '', '', ' [not set]'));
Logger.Log(1, '-------------------------------------------------------------');
Logger.Log(1, '--LoadServerConfig - end');
end;
......@@ -82,6 +127,8 @@ begin
webAppFolder := 'static';
reportsFolder := 'reports';
auditEnabled := False;
rpId := 'wcemimobile.em-sys.net';
rpName := 'emiMobile';
Logger.Log(1, '--TServerConfig.Create - end');
end;
......
unit Webauthn.Cbor;
{
Minimal CBOR (RFC 7049) decoder for WebAuthn attestationObject and authData parsing.
Supports only what is needed: unsigned/negative integers, byte strings, text strings,
arrays, and maps. Indefinite-length items are not supported.
}
interface
uses
System.SysUtils, System.Classes;
// Extract the authData byte string from a CBOR-encoded attestationObject map.
function CborGetAuthData(const AAttestationObject: TBytes; out AAuthData: TBytes): Boolean;
// Parse a COSE EC2 public key from CBOR bytes starting at APos.
// Advances APos past the COSE map on success.
// Returns True if a valid ES256 (alg=-7) P-256 key with 32-byte x and y is found.
function CborParseCoseKey(const AData: TBytes; var APos: Integer;
out AX, AY: TBytes; out AAlg: Integer): Boolean;
// Parse the fixed-layout authData structure.
// AT flag (bit 6) must be set; otherwise ACredentialId/APublicKey fields are empty.
function ParseAuthData(const AAuthData: TBytes;
out ARpIdHash: TBytes;
out AFlags: Byte;
out ASignCount: Cardinal;
out ACredentialId: TBytes;
out APubKeyX, APubKeyY: TBytes;
out APubKeyAlg: Integer): Boolean;
implementation
// ---------------------------------------------------------------------------
// Internal CBOR reader primitives
// ---------------------------------------------------------------------------
// Read the initial byte and additional length/value bytes.
// For major type 1 (negative int), AValue is returned as the negative result: -1 - raw.
// Returns False if data is truncated or an unsupported additional-info is encountered.
function CborReadHead(const AData: TBytes; var APos: Integer;
out AMajorType: Byte; out AValue: Int64): Boolean;
var
b, addInfo: Byte;
begin
Result := False;
if APos >= Length(AData) then Exit;
b := AData[APos]; Inc(APos);
AMajorType := b shr 5;
addInfo := b and $1F;
case addInfo of
0..23: AValue := addInfo;
24:
begin
if APos >= Length(AData) then Exit;
AValue := AData[APos]; Inc(APos);
end;
25:
begin
if APos + 1 > Length(AData) then Exit;
AValue := (Int64(AData[APos]) shl 8) or AData[APos + 1];
Inc(APos, 2);
end;
26:
begin
if APos + 3 > Length(AData) then Exit;
AValue := (Int64(AData[APos]) shl 24) or
(Int64(AData[APos + 1]) shl 16) or
(Int64(AData[APos + 2]) shl 8) or
AData[APos + 3];
Inc(APos, 4);
end;
27:
begin
if APos + 7 > Length(AData) then Exit;
AValue := (Int64(AData[APos]) shl 56) or
(Int64(AData[APos + 1]) shl 48) or
(Int64(AData[APos + 2]) shl 40) or
(Int64(AData[APos + 3]) shl 32) or
(Int64(AData[APos + 4]) shl 24) or
(Int64(AData[APos + 5]) shl 16) or
(Int64(AData[APos + 6]) shl 8) or
AData[APos + 7];
Inc(APos, 8);
end;
else
Exit; // indefinite-length or reserved — not supported
end;
if AMajorType = 1 then
AValue := -1 - AValue;
Result := True;
end;
function CborReadBytes(const AData: TBytes; var APos: Integer;
out AResult: TBytes): Boolean;
var
mt: Byte;
count: Int64;
begin
Result := False;
if not CborReadHead(AData, APos, mt, count) then Exit;
if mt <> 2 then Exit;
if (count < 0) or (APos + count > Length(AData)) then Exit;
SetLength(AResult, count);
if count > 0 then
Move(AData[APos], AResult[0], count);
Inc(APos, Integer(count));
Result := True;
end;
function CborReadText(const AData: TBytes; var APos: Integer;
out AResult: string): Boolean;
var
mt: Byte;
count: Int64;
raw: TBytes;
begin
Result := False;
if not CborReadHead(AData, APos, mt, count) then Exit;
if mt <> 3 then Exit;
if (count < 0) or (APos + count > Length(AData)) then Exit;
SetLength(raw, count);
if count > 0 then
Move(AData[APos], raw[0], count);
Inc(APos, Integer(count));
AResult := TEncoding.UTF8.GetString(raw);
Result := True;
end;
function CborReadInt(const AData: TBytes; var APos: Integer;
out AResult: Int64): Boolean;
var
mt: Byte;
begin
Result := False;
if not CborReadHead(AData, APos, mt, AResult) then Exit;
Result := (mt = 0) or (mt = 1);
end;
// Skip any CBOR item at APos, advancing APos past it.
function CborSkipItem(const AData: TBytes; var APos: Integer): Boolean;
var
mt: Byte;
count, i: Int64;
begin
Result := False;
if not CborReadHead(AData, APos, mt, count) then Exit;
case mt of
0, 1: Result := True; // integer — head already consumed
2, 3: // byte string or text string
begin
if (count < 0) or (APos + count > Length(AData)) then Exit;
Inc(APos, Integer(count));
Result := True;
end;
4: // array
begin
for i := 0 to count - 1 do
if not CborSkipItem(AData, APos) then Exit;
Result := True;
end;
5: // map
begin
for i := 0 to count - 1 do
begin
if not CborSkipItem(AData, APos) then Exit; // key
if not CborSkipItem(AData, APos) then Exit; // value
end;
Result := True;
end;
6: // tag — skip tagged item
Result := CborSkipItem(AData, APos);
7: // simple / float — additional bytes already consumed by CborReadHead
Result := True;
end;
end;
// ---------------------------------------------------------------------------
// Public API
// ---------------------------------------------------------------------------
function CborGetAuthData(const AAttestationObject: TBytes;
out AAuthData: TBytes): Boolean;
var
pos: Integer;
mt: Byte;
mapCount, i: Int64;
key: string;
begin
Result := False;
pos := 0;
if not CborReadHead(AAttestationObject, pos, mt, mapCount) then Exit;
if mt <> 5 then Exit; // must be a CBOR map
for i := 0 to mapCount - 1 do
begin
if not CborReadText(AAttestationObject, pos, key) then Exit;
if key = 'authData' then
begin
Result := CborReadBytes(AAttestationObject, pos, AAuthData);
Exit;
end;
// skip the value for any other key
if not CborSkipItem(AAttestationObject, pos) then Exit;
end;
end;
function CborParseCoseKey(const AData: TBytes; var APos: Integer;
out AX, AY: TBytes; out AAlg: Integer): Boolean;
var
mt: Byte;
mapCount, i, keyInt, valInt: Int64;
begin
Result := False;
AAlg := 0;
SetLength(AX, 0);
SetLength(AY, 0);
if not CborReadHead(AData, APos, mt, mapCount) then Exit;
if mt <> 5 then Exit;
for i := 0 to mapCount - 1 do
begin
if not CborReadInt(AData, APos, keyInt) then Exit;
case keyInt of
3: // alg
begin
if not CborReadInt(AData, APos, valInt) then Exit;
AAlg := Integer(valInt);
end;
-2: // x coordinate
begin
if not CborReadBytes(AData, APos, AX) then Exit;
end;
-3: // y coordinate
begin
if not CborReadBytes(AData, APos, AY) then Exit;
end;
else
if not CborSkipItem(AData, APos) then Exit;
end;
end;
Result := (Length(AX) = 32) and (Length(AY) = 32);
end;
function ParseAuthData(const AAuthData: TBytes;
out ARpIdHash: TBytes;
out AFlags: Byte;
out ASignCount: Cardinal;
out ACredentialId: TBytes;
out APubKeyX, APubKeyY: TBytes;
out APubKeyAlg: Integer): Boolean;
var
pos: Integer;
credIdLen: Word;
begin
Result := False;
pos := 0;
// Minimum length for fixed header: 32 (rpIdHash) + 1 (flags) + 4 (signCount) = 37
if Length(AAuthData) < 37 then Exit;
SetLength(ARpIdHash, 32);
Move(AAuthData[0], ARpIdHash[0], 32);
pos := 32;
AFlags := AAuthData[pos]; Inc(pos);
ASignCount := (Cardinal(AAuthData[pos]) shl 24) or
(Cardinal(AAuthData[pos + 1]) shl 16) or
(Cardinal(AAuthData[pos + 2]) shl 8) or
AAuthData[pos + 3];
Inc(pos, 4);
// AT flag = bit 6 ($40) — attested credential data present
if (AFlags and $40) = 0 then
begin
Result := True; // no credential data, valid for authentication assertions
Exit;
end;
// Skip AAGUID (16 bytes)
if pos + 16 > Length(AAuthData) then Exit;
Inc(pos, 16);
// Credential ID length (2 bytes big-endian)
if pos + 2 > Length(AAuthData) then Exit;
credIdLen := (Word(AAuthData[pos]) shl 8) or AAuthData[pos + 1];
Inc(pos, 2);
// Credential ID
if pos + Integer(credIdLen) > Length(AAuthData) then Exit;
SetLength(ACredentialId, credIdLen);
if credIdLen > 0 then
Move(AAuthData[pos], ACredentialId[0], credIdLen);
Inc(pos, credIdLen);
// COSE public key
Result := CborParseCoseKey(AAuthData, pos, APubKeyX, APubKeyY, APubKeyAlg);
end;
end.
unit Webauthn.Crypto;
interface
uses
System.SysUtils, System.NetEncoding, System.Hash;
function Base64UrlEncode(const ABytes: TBytes): string;
function Base64UrlDecode(const AStr: string): TBytes;
function SHA256Bytes(const AData: TBytes): TBytes;
function HMACSHA256Bytes(const AKey, AData: TBytes): TBytes;
function RandomBytes(ACount: Integer): TBytes;
// Convert DER-encoded ECDSA signature (from WebAuthn) to raw 64-byte r||s
function DerSigToRaw(const ADer: TBytes): TBytes;
// Verify ES256 ECDSA-P256 signature over AMessage (raw bytes, hashed internally)
// APubKeyX, APubKeyY: raw 32-byte big-endian coordinates
// ASignatureDer: DER-encoded signature bytes from WebAuthn assertion
function VerifyECDSAP256(const APubKeyX, APubKeyY, AMessage, ASignatureDer: TBytes): Boolean;
implementation
uses
Winapi.Windows;
const
BCRYPT_ECDSA_PUBLIC_P256_MAGIC: DWORD = $31534345;
BCRYPT_ECC_PUBLIC_BLOB = 'ECCPUBLICBLOB';
STATUS_SUCCESS = LongInt(0);
BCRYPT_USE_SYSTEM_PREFERRED_RNG: DWORD = 2;
type
NTSTATUS = LongInt;
BCRYPT_ALG_HANDLE = THandle;
BCRYPT_KEY_HANDLE = THandle;
BCRYPT_ECCKEY_BLOB = packed record
dwMagic: DWORD;
cbKey: DWORD;
end;
function BCryptOpenAlgorithmProvider(out phAlgorithm: BCRYPT_ALG_HANDLE;
pszAlgId, pszImplementation: PWideChar; dwFlags: DWORD): NTSTATUS;
stdcall; external 'bcrypt.dll';
function BCryptCloseAlgorithmProvider(hAlgorithm: BCRYPT_ALG_HANDLE;
dwFlags: DWORD): NTSTATUS;
stdcall; external 'bcrypt.dll';
function BCryptImportKeyPair(hAlgorithm: BCRYPT_ALG_HANDLE;
hImportKey: BCRYPT_KEY_HANDLE; pszBlobType: PWideChar;
out phKey: BCRYPT_KEY_HANDLE; pbInput: PByte; cbInput: DWORD;
dwFlags: DWORD): NTSTATUS;
stdcall; external 'bcrypt.dll';
function BCryptDestroyKey(hKey: BCRYPT_KEY_HANDLE): NTSTATUS;
stdcall; external 'bcrypt.dll';
function BCryptVerifySignature(hKey: BCRYPT_KEY_HANDLE; pPaddingInfo: Pointer;
pbHash: PByte; cbHash: DWORD; pbSignature: PByte; cbSignature: DWORD;
dwFlags: DWORD): NTSTATUS;
stdcall; external 'bcrypt.dll';
function BCryptGenRandom(hAlgorithm: BCRYPT_ALG_HANDLE; pbBuffer: PByte;
cbBuffer: DWORD; dwFlags: DWORD): NTSTATUS;
stdcall; external 'bcrypt.dll';
// ---------------------------------------------------------------------------
function Base64UrlEncode(const ABytes: TBytes): string;
begin
Result := TNetEncoding.Base64.EncodeBytesToString(ABytes);
Result := Result.Replace('+', '-').Replace('/', '_').TrimRight(['=']);
end;
function Base64UrlDecode(const AStr: string): TBytes;
var
s: string;
padLen: Integer;
begin
s := AStr.Replace('-', '+').Replace('_', '/');
padLen := (4 - (Length(s) mod 4)) mod 4;
if padLen > 0 then
s := s + StringOfChar('=', padLen);
Result := TNetEncoding.Base64.DecodeStringToBytes(s);
end;
function SHA256Bytes(const AData: TBytes): TBytes;
var
Hash: THashSHA2;
begin
Hash := THashSHA2.Create(SHA256);
Hash.Update(AData);
Result := Hash.HashAsBytes;
end;
function HMACSHA256Bytes(const AKey, AData: TBytes): TBytes;
const
BlockSize = 64;
var
normKey: TBytes;
ipadKey, opadKey: TBytes;
innerData, outerData: TBytes;
innerHash: TBytes;
i: Integer;
begin
// Normalize key to block size
SetLength(normKey, BlockSize);
FillChar(normKey[0], BlockSize, 0);
if Length(AKey) > BlockSize then
begin
innerHash := SHA256Bytes(AKey);
Move(innerHash[0], normKey[0], Length(innerHash));
end
else if Length(AKey) > 0 then
Move(AKey[0], normKey[0], Length(AKey));
SetLength(ipadKey, BlockSize);
SetLength(opadKey, BlockSize);
for i := 0 to BlockSize - 1 do
begin
ipadKey[i] := normKey[i] xor $36;
opadKey[i] := normKey[i] xor $5C;
end;
// inner = SHA256(ipadKey || data)
SetLength(innerData, BlockSize + Length(AData));
Move(ipadKey[0], innerData[0], BlockSize);
if Length(AData) > 0 then
Move(AData[0], innerData[BlockSize], Length(AData));
innerHash := SHA256Bytes(innerData);
// result = SHA256(opadKey || innerHash)
SetLength(outerData, BlockSize + 32);
Move(opadKey[0], outerData[0], BlockSize);
Move(innerHash[0], outerData[BlockSize], 32);
Result := SHA256Bytes(outerData);
end;
function RandomBytes(ACount: Integer): TBytes;
begin
SetLength(Result, ACount);
if ACount > 0 then
BCryptGenRandom(0, @Result[0], ACount, BCRYPT_USE_SYSTEM_PREFERRED_RNG);
end;
function DerSigToRaw(const ADer: TBytes): TBytes;
var
pos, rLen, sLen, rStart, sStart: Integer;
begin
SetLength(Result, 64);
FillChar(Result[0], 64, 0);
pos := 0;
if (Length(ADer) < 8) or (ADer[pos] <> $30) then Exit;
Inc(pos);
// Skip sequence length (handle 1-byte and 2-byte forms)
if ADer[pos] = $81 then Inc(pos);
Inc(pos);
// r integer
if (pos >= Length(ADer)) or (ADer[pos] <> $02) then Exit;
Inc(pos);
rLen := ADer[pos]; Inc(pos);
rStart := pos;
Inc(pos, rLen);
// s integer
if (pos >= Length(ADer)) or (ADer[pos] <> $02) then Exit;
Inc(pos);
sLen := ADer[pos]; Inc(pos);
sStart := pos;
// Copy r right-justified into Result[0..31], stripping leading 0x00
if (rLen > 0) and (ADer[rStart] = $00) then begin Inc(rStart); Dec(rLen); end;
if rLen > 32 then begin Inc(rStart, rLen - 32); rLen := 32; end;
if rLen > 0 then
Move(ADer[rStart], Result[32 - rLen], rLen);
// Copy s right-justified into Result[32..63], stripping leading 0x00
if (sLen > 0) and (ADer[sStart] = $00) then begin Inc(sStart); Dec(sLen); end;
if sLen > 32 then begin Inc(sStart, sLen - 32); sLen := 32; end;
if sLen > 0 then
Move(ADer[sStart], Result[64 - sLen], sLen);
end;
function VerifyECDSAP256(const APubKeyX, APubKeyY, AMessage, ASignatureDer: TBytes): Boolean;
var
algHandle: BCRYPT_ALG_HANDLE;
keyHandle: BCRYPT_KEY_HANDLE;
blob: TBytes;
header: BCRYPT_ECCKEY_BLOB;
msgHash, rawSig: TBytes;
status: NTSTATUS;
begin
Result := False;
if (Length(APubKeyX) <> 32) or (Length(APubKeyY) <> 32) then Exit;
header.dwMagic := BCRYPT_ECDSA_PUBLIC_P256_MAGIC;
header.cbKey := 32;
SetLength(blob, SizeOf(BCRYPT_ECCKEY_BLOB) + 64);
Move(header, blob[0], SizeOf(BCRYPT_ECCKEY_BLOB));
Move(APubKeyX[0], blob[SizeOf(BCRYPT_ECCKEY_BLOB)], 32);
Move(APubKeyY[0], blob[SizeOf(BCRYPT_ECCKEY_BLOB) + 32], 32);
// ES256 signs SHA-256(message)
msgHash := SHA256Bytes(AMessage);
rawSig := DerSigToRaw(ASignatureDer);
if Length(rawSig) <> 64 then Exit;
status := BCryptOpenAlgorithmProvider(algHandle, 'ECDSA_P256', nil, 0);
if status <> STATUS_SUCCESS then Exit;
try
status := BCryptImportKeyPair(algHandle, 0, BCRYPT_ECC_PUBLIC_BLOB,
keyHandle, @blob[0], Length(blob), 0);
if status <> STATUS_SUCCESS then Exit;
try
status := BCryptVerifySignature(keyHandle, nil,
@msgHash[0], Length(msgHash),
@rawSig[0], Length(rawSig), 0);
Result := (status = STATUS_SUCCESS);
finally
BCryptDestroyKey(keyHandle);
end;
finally
BCryptCloseAlgorithmProvider(algHandle, 0);
end;
end;
end.
[Settings]
LogFileNum=112
LogFileNum=116
webClientVersion=0.9.4.5
[Database]
......
-- WebAuthn device registrations for emiMobile
-- Run against the LEMS database.
-- Drop and recreate if upgrading from the UUID-based schema.
DROP TABLE IF EXISTS lems.device_registrations;
CREATE TABLE lems.device_registrations (
id SERIAL PRIMARY KEY,
credential_id TEXT NOT NULL UNIQUE,
device_name VARCHAR(255),
user_agent TEXT,
public_key_x BYTEA NOT NULL,
public_key_y BYTEA NOT NULL,
public_key_alg INTEGER NOT NULL DEFAULT -7, -- -7 = ES256
sign_count BIGINT NOT NULL DEFAULT 0,
registered_at TIMESTAMPTZ DEFAULT NOW(),
revoked_at TIMESTAMPTZ,
revoked_by VARCHAR(255)
);
CREATE INDEX IF NOT EXISTS idx_device_reg_cred_id
ON lems.device_registrations (credential_id);
COMMENT ON TABLE lems.device_registrations IS
'WebAuthn (FIDO2) credential store for emiMobile device access control. '
'credential_id is the base64url-encoded credential ID from navigator.credentials.create(). '
'public_key_x/y are the raw 32-byte big-endian EC P-256 coordinates. '
'sign_count is updated after each successful authentication assertion. '
'Admins revoke access by setting revoked_at.';
-- Add key_type column to distinguish WebAuthn vs simple-key devices
ALTER TABLE lems.device_registrations
ADD COLUMN IF NOT EXISTS key_type VARCHAR(10) DEFAULT 'webauthn';
-- Back-fill existing active rows as webauthn
UPDATE lems.device_registrations
SET key_type = 'webauthn'
WHERE key_type IS NULL AND status = 'active';
-- Migration: add pending-device support to device_registrations
-- Run once against the lems database.
-- 1. Add status column (active for all existing rows)
ALTER TABLE lems.device_registrations
ADD COLUMN IF NOT EXISTS status VARCHAR(10) NOT NULL DEFAULT 'active';
-- 2. Mark already-revoked rows correctly
UPDATE lems.device_registrations
SET status = 'revoked'
WHERE revoked_at IS NOT NULL AND status = 'active';
-- 3. Allow credential_id / public-key columns to be NULL for pending rows
ALTER TABLE lems.device_registrations
ALTER COLUMN credential_id DROP NOT NULL;
ALTER TABLE lems.device_registrations
ALTER COLUMN public_key_x DROP NOT NULL;
ALTER TABLE lems.device_registrations
ALTER COLUMN public_key_y DROP NOT NULL;
-- Migration: add phone_number to device_registrations + create redeem_codes table
-- Run once against the lems database (after device_registrations_pending.sql).
-- 1. Add phone_number column (nullable; unique among non-revoked rows via app logic)
ALTER TABLE lems.device_registrations
ADD COLUMN IF NOT EXISTS phone_number VARCHAR(20);
-- 2. Create redeem_codes table for App Store redemption links
CREATE TABLE IF NOT EXISTS lems.redeem_codes (
id SERIAL PRIMARY KEY,
code VARCHAR(20) NOT NULL UNIQUE,
used_at TIMESTAMPTZ,
used_for VARCHAR(20) -- E.164 phone number this code was sent to
);
-- 3. Seed redeem codes from wyoming_redeem_codes_03_2023.csv
INSERT INTO lems.redeem_codes (code) VALUES
('6KMHNH7A6LN9'),
('6MXT9NTX6L9E'),
('YAJWXLFYHL64'),
('PPYK7L6YKEER'),
('A37L4E733ENH'),
('33JAW639P3YX'),
('HHAKYY9T36PJ'),
('T9FJ7KRML43Y'),
('E73AARXT946K'),
('AEAFJT7XRJWN'),
('PXFA7E69LKNT'),
('PHKAP6M6N76T'),
('67EWNTXFKKHN'),
('3HR7479KMKJ7'),
('EYYR7Y79T3PL'),
('TYJYHY6FKX7E'),
('9N6E9X4KYHHJ'),
('FTMFLJ43ANN6'),
('R6HKEHMM3MRL'),
('7M3JNAKYTJ6H'),
('TRWMRNE6TA33'),
('3NJ7YX3NFAFX'),
('NRJTARKHMEHH'),
('EP4APXP46RWN'),
('TAMPH6EK3XA6'),
('6K9AAT7WA3PF'),
('AJXYJTL6A37W'),
('YKPA6LR3LFP6'),
('XPXRPFHH7EXY'),
('9NN693L766JN'),
('4F9EPN9YWFTW'),
('FJ9RXNNL6M3R'),
('A4HMWTR4Y6YR'),
('JL9RMJYWH3RW'),
('NYXEELXHEEWR'),
('TPTYRPWEFHLL'),
('JWLEXF3T3HPX'),
('WPYFWTJHMNEA'),
('JLYHHAR9LAJ7'),
('KW9YX4AY4F7F'),
('LMJAJHE7HH69'),
('LAWPM9WJYMLH'),
('NLFMEA744NRJ'),
('ETN39J3KYA3N'),
('6Y7R3NX6K497'),
('N3RN7WRRTEH6'),
('LJ7REJWYPHWN'),
('RWEMWAFWN4EP'),
('M4XKLLAN7YNF'),
('6NHRYRM4RTL7'),
('WR3TA9KE47JN'),
('H7TWKXYPNJEK'),
('X4XHH6AHXMET'),
('MPWKKNMKWML7'),
('J3HEW4JWRKN3'),
('E766HNR7AWAN'),
('P6PTAFJJF6WY'),
('XM7MR44FYPT4'),
('TNM64T3FAHML'),
('MEJ4YP7F9NJT'),
('LLWHYLEAXJRX'),
('TT7JPF7LRFNY'),
('FXN6EFHXLHAY'),
('M934TNKH7N6K'),
('X94WXYT9PML7'),
('L9AKMW376JTP'),
('LTLKEWWA47JT'),
('KRRNJYXPKHWH'),
('NMTNKTKRXRPR'),
('XMLFRRYA669X'),
('EM96HJHJ64YA'),
('XTF9TM94EKXH'),
('P944369MR7N4'),
('LJTFEAJFJ9F9'),
('AX749RNJNFXP'),
('XNY3W6JKHALK'),
('XLK79WPMRP7R'),
('T49KNHXKJ7L3'),
('LRHAP7LNRLNL'),
('NNJWPN69YATJ'),
('LAALW6EH3L3A'),
('FH3A7NYMX9YY'),
('F369PH7W4HYL'),
('FEAMK994PEL7'),
('9AE7A4TYKPFM'),
('4TYJHWMA99KX'),
('MPR643T4E47R'),
('3JEMLFRNTLP4'),
('K7EWYHFJ96AW'),
('P9YKYAPYHXWE'),
('3R96N4FMHTEA'),
('XJPPTEJT7YAM'),
('396PF9KKMK4P'),
('J9WJRKYNXMAR'),
('RYTTTP44RTMJ'),
('R6JHY44LKE7N'),
('L7L7K3KR9TLP'),
('AX7YFHTN63KP'),
('WTKPYRF9FMJN'),
('4YL3MN7FWFP7')
ON CONFLICT (code) DO NOTHING;
-- Migration: add username and agency to device_registrations
-- username: the CAD username of the person who last logged in from this device
-- (saved automatically on first successful login, or set manually by admin)
-- agency: the CAD agency used at login time (saved automatically; required for auto-login)
ALTER TABLE lems.device_registrations
ADD COLUMN IF NOT EXISTS username VARCHAR(50),
ADD COLUMN IF NOT EXISTS agency VARCHAR(20);
......@@ -32,7 +32,9 @@ uses
Ws.Server.Module in 'Source\Ws.Server.Module.pas' {WsServerModule: TDataModule},
Ws.DataModel in 'Source\Ws.DataModel.pas',
WsMessages in 'Source\shared\WsMessages.pas',
WebSocket.Manager in 'Source\WebSocket.Manager.pas';
WebSocket.Manager in 'Source\WebSocket.Manager.pas',
Webauthn.Cbor in 'Source\Webauthn.Cbor.pas',
Webauthn.Crypto in 'Source\Webauthn.Crypto.pas';
type
TMemoLogAppender = class( TInterfacedObject, ILogAppender )
......
......@@ -180,6 +180,8 @@
<DCCReference Include="Source\Ws.DataModel.pas"/>
<DCCReference Include="Source\shared\WsMessages.pas"/>
<DCCReference Include="Source\WebSocket.Manager.pas"/>
<DCCReference Include="Source\Webauthn.Cbor.pas"/>
<DCCReference Include="Source\Webauthn.Crypto.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
......@@ -872,9 +874,6 @@
<Platform Name="Win64x">
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
......@@ -945,10 +944,6 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
......@@ -959,10 +954,6 @@
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="WinARM64EC">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
......
......@@ -9,15 +9,17 @@ uses
const
TOKEN_NAME = 'WEBEMIMOBILE_TOKEN';
CREDENTIAL_NAME = 'WEBEMIMOBILE_CREDENTIAL_ID';
KEY_TYPE_NAME = 'WEBEMIMOBILE_KEY_TYPE';
DEVICE_MANAGER_TOKEN_NAME = 'WEBEMIMOBILE_DEVICE_MANAGER_TOKEN';
type
TOnLoginSuccess = reference to procedure;
TOnLoginError = reference to procedure(AMsg: string);
TOnProfileSuccess = reference to procedure;
TOnProfileError = reference to procedure(AMsg: string);
TOnBeginSuccess = reference to procedure(AChallenge, AChallengeToken: string);
TOnDeviceSuccess = reference to procedure;
TOnDeviceError = reference to procedure(AMsg: string);
TOnGetDeviceUserOK = reference to procedure(AUsername, AAgency: string);
TAuthService = class
private
......@@ -25,22 +27,55 @@ type
procedure SetToken(AToken: string);
procedure DeleteToken;
procedure SetCredentialId(AId: string);
procedure SetKeyType(AType: string);
public
constructor Create; reintroduce;
destructor Destroy; override;
procedure Login(AUser, APassword, AAgency: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure BeginRegistration(APhoneNumber: string;
ASuccess: TOnBeginSuccess; AError: TOnDeviceError);
procedure CompleteRegistration(APhoneNumber, ACredentialId,
AAttestationObject, AClientDataJSON, AChallengeToken: string;
ASuccess: TOnDeviceSuccess; AError: TOnDeviceError);
function DeviceManagementMode: Boolean;
procedure LoginDeviceManager(AUser, APassword, AAgency: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
// JWT helpers
procedure Logout;
function GetToken: string;
function Authenticated: Boolean;
function TokenExpirationDate: TDateTime;
function TokenExpired: Boolean;
function TokenPayload: JS.TJSObject;
// Credential storage
function GetCredentialId: string;
function IsDeviceRegistered: Boolean;
function IsSimpleKey: Boolean;
procedure ClearCredentialId;
// WebAuthn registration — two-step
procedure BeginRegistration(APhoneNumber: string;
ASuccess: TOnBeginSuccess; AError: TOnDeviceError);
procedure CompleteRegistration(APhoneNumber, ACredentialId,
AAttestationObject, AClientDataJSON, AChallengeToken: string;
ASuccess: TOnDeviceSuccess; AError: TOnDeviceError);
// WebAuthn authentication — two-step (called from within Login flow)
procedure BeginAuthentication(ACredentialId: string;
ASuccess: TOnBeginSuccess; AError: TOnLoginError);
procedure LoginWithAssertion(AUser, APassword, AAgency, ACredentialId,
AChallengeToken, AAuthenticatorData, AClientDataJSON, ASignature: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
// Passkey-only auto-login (no password) — uses stored username on device record
procedure GetDeviceUser(ACredentialId: string; ASuccess: TOnGetDeviceUserOK);
procedure LoginAutomatic(ACredentialId, AChallengeToken,
AAuthenticatorData, AClientDataJSON, ASignature: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
// Simple-key registration and login
procedure CompleteRegistrationSimple(APhoneNumber, ADeviceKey, AChallengeToken: string;
ASuccess: TOnDeviceSuccess; AError: TOnDeviceError);
procedure LoginDeviceKey(ACredentialId, AChallengeToken: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure LoginPasswordAndSimpleKey(AUser, APassword, AAgency,
ACredentialId, AChallengeToken: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
end;
TJwtHelper = class
......@@ -65,20 +100,119 @@ var
function AuthService: TAuthService;
begin
if not Assigned(_AuthService) then
begin
_AuthService := TAuthService.Create;
end;
Result := _AuthService;
end;
{ TAuthService }
constructor TAuthService.Create;
begin
FClient := TXDataWebClient.Create(nil);
FClient.Connection := DMConnection.AuthConnection;
end;
destructor TAuthService.Destroy;
begin
FClient.Free;
inherited;
end;
// ---- JWT storage ----
procedure TAuthService.SetToken(AToken: string);
begin
if DeviceManagementMode then
window.sessionStorage.setItem(DEVICE_MANAGER_TOKEN_NAME, AToken)
else
window.localStorage.setItem(TOKEN_NAME, AToken);
end;
procedure TAuthService.DeleteToken;
begin
if DeviceManagementMode then
window.sessionStorage.removeItem(DEVICE_MANAGER_TOKEN_NAME)
else
window.localStorage.removeItem(TOKEN_NAME);
end;
function TAuthService.GetToken: string;
begin
if DeviceManagementMode then
Result := window.sessionStorage.getItem(DEVICE_MANAGER_TOKEN_NAME)
else
Result := window.localStorage.getItem(TOKEN_NAME);
end;
function TAuthService.Authenticated: Boolean;
begin
Result := not isNull(window.localStorage.getItem(TOKEN_NAME)) and
(window.localStorage.getItem(TOKEN_NAME) <> '');
Result := not isNull(GetToken) and (GetToken <> '');
end;
function TAuthService.DeviceManagementMode: Boolean;
begin
Result := TJSURLSearchParams.new(window.location.search).has('devices');
end;
procedure TAuthService.LoginDeviceManager(AUser, APassword, AAgency: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
begin
SetToken(JS.toString(JS.TJSObject(Response.Result).Properties['value']));
ASuccess;
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
FClient.RawInvoke('IAuthService.LoginDeviceManager', [AUser, APassword, AAgency], @OnLoad, @OnError);
end;
procedure TAuthService.Logout;
begin
DeleteToken;
end;
// ---- Credential ID storage ----
procedure TAuthService.SetCredentialId(AId: string);
begin
window.localStorage.setItem(CREDENTIAL_NAME, AId);
end;
procedure TAuthService.SetKeyType(AType: string);
begin
window.localStorage.setItem(KEY_TYPE_NAME, AType);
end;
procedure TAuthService.ClearCredentialId;
begin
window.localStorage.removeItem(CREDENTIAL_NAME);
window.localStorage.removeItem(KEY_TYPE_NAME);
end;
function TAuthService.IsSimpleKey: Boolean;
begin
Result := window.localStorage.getItem(KEY_TYPE_NAME) = 'simple';
end;
function TAuthService.GetCredentialId: string;
begin
Result := window.localStorage.getItem(CREDENTIAL_NAME);
end;
function TAuthService.IsDeviceRegistered: Boolean;
begin
Result := not isNull(window.localStorage.getItem(CREDENTIAL_NAME)) and
(window.localStorage.getItem(CREDENTIAL_NAME) <> '');
end;
// ---- WebAuthn registration ----
procedure TAuthService.BeginRegistration(APhoneNumber: string;
ASuccess: TOnBeginSuccess; AError: TOnDeviceError);
......@@ -131,6 +265,7 @@ procedure TAuthService.CompleteRegistration(APhoneNumber, ACredentialId,
else if status = 'ok' then
begin
SetCredentialId(credId);
SetKeyType('webauthn');
ASuccess;
end
else
......@@ -150,30 +285,90 @@ begin
);
end;
constructor TAuthService.Create;
begin
FClient := TXDataWebClient.Create(nil);
FClient.Connection := DMConnection.AuthConnection;
end;
// ---- WebAuthn authentication ----
procedure TAuthService.BeginAuthentication(ACredentialId: string;
ASuccess: TOnBeginSuccess; AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
var
resp: JS.TJSObject;
challenge, token, errMsg: string;
begin
resp := JS.TJSObject(Response.Result);
errMsg := JS.toString(resp.Properties['error']);
if errMsg <> '' then
begin
AError(errMsg);
Exit;
end;
challenge := JS.toString(resp.Properties['challenge']);
token := JS.toString(resp.Properties['challengeToken']);
ASuccess(challenge, token);
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
procedure TAuthService.DeleteToken;
begin
window.localStorage.removeItem(TOKEN_NAME);
FClient.RawInvoke(
'IAuthService.BeginAuthentication',
[ACredentialId],
@OnLoad, @OnError
);
end;
destructor TAuthService.Destroy;
procedure TAuthService.LoginWithAssertion(AUser, APassword, AAgency, ACredentialId,
AChallengeToken, AAuthenticatorData, AClientDataJSON, ASignature: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
var
Token: JS.TJSObject;
begin
Token := JS.TJSObject(Response.Result);
SetToken(JS.toString(Token.Properties['value']));
ASuccess;
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
FClient.Free;
inherited;
FClient.RawInvoke(
'IAuthService.Login',
[AUser, APassword, AAgency, ACredentialId,
AChallengeToken, AAuthenticatorData, AClientDataJSON, ASignature],
@OnLoad, @OnError
);
end;
function TAuthService.GetToken: string;
// ---- Passkey auto-login ----
procedure TAuthService.GetDeviceUser(ACredentialId: string; ASuccess: TOnGetDeviceUserOK);
procedure OnLoad(Response: TXDataClientResponse);
var
resp: JS.TJSObject;
begin
resp := JS.TJSObject(Response.Result);
ASuccess(
JS.toString(resp.Properties['username']),
JS.toString(resp.Properties['agency'])
);
end;
begin
Result := window.localStorage.getItem(TOKEN_NAME);
FClient.RawInvoke('IAuthService.GetDeviceUser', [ACredentialId], @OnLoad);
end;
procedure TAuthService.Login(AUser, APassword, AAgency: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
procedure TAuthService.LoginAutomatic(ACredentialId, AChallengeToken,
AAuthenticatorData, AClientDataJSON, ASignature: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
var
......@@ -190,33 +385,104 @@ procedure TAuthService.Login(AUser, APassword, AAgency: string; ASuccess: TOnLog
end;
begin
if (AUser = '') or (APassword = '') or (AAgency = '') then
FClient.RawInvoke(
'IAuthService.LoginAutomatic',
[ACredentialId, AChallengeToken, AAuthenticatorData, AClientDataJSON, ASignature],
@OnLoad, @OnError
);
end;
// ---- Simple-key registration and login ----
procedure TAuthService.CompleteRegistrationSimple(APhoneNumber, ADeviceKey, AChallengeToken: string;
ASuccess: TOnDeviceSuccess; AError: TOnDeviceError);
procedure OnLoad(Response: TXDataClientResponse);
var
resp: JS.TJSObject;
status, msg, credId: string;
begin
AError('Please enter a username, password, and agency');
Exit;
resp := JS.TJSObject(Response.Result);
status := JS.toString(resp.Properties['status']);
msg := JS.toString(resp.Properties['message']);
credId := JS.toString(resp.Properties['credentialId']);
if status = 'ok' then
begin
SetCredentialId(credId);
SetKeyType('simple');
ASuccess;
end
else
AError(msg);
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
FClient.RawInvoke(
'IAuthService.Login', [AUser, APassword, AAgency],
'IAuthService.CompleteRegistrationSimple',
[APhoneNumber, ADeviceKey, AChallengeToken],
@OnLoad, @OnError
);
end;
procedure TAuthService.Logout;
begin
DeleteToken;
end;
procedure TAuthService.LoginDeviceKey(ACredentialId, AChallengeToken: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
var
Token: JS.TJSObject;
begin
Token := JS.TJSObject(Response.Result);
SetToken(JS.toString(Token.Properties['value']));
ASuccess;
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
procedure TAuthService.SetToken(AToken: string);
begin
window.localStorage.setItem(TOKEN_NAME, AToken);
FClient.RawInvoke(
'IAuthService.LoginDeviceKey',
[ACredentialId, AChallengeToken],
@OnLoad, @OnError
);
end;
procedure TAuthService.SetCredentialId(AId: string);
procedure TAuthService.LoginPasswordAndSimpleKey(AUser, APassword, AAgency,
ACredentialId, AChallengeToken: string;
ASuccess: TOnLoginSuccess; AError: TOnLoginError);
procedure OnLoad(Response: TXDataClientResponse);
var
Token: JS.TJSObject;
begin
Token := JS.TJSObject(Response.Result);
SetToken(JS.toString(Token.Properties['value']));
ASuccess;
end;
procedure OnError(Error: TXDataClientError);
begin
AError(Format('%s: %s', [Error.ErrorCode, Error.ErrorMessage]));
end;
begin
window.localStorage.setItem(CREDENTIAL_NAME, AId);
FClient.RawInvoke(
'IAuthService.LoginPasswordAndSimpleKey',
[AUser, APassword, AAgency, ACredentialId, AChallengeToken],
@OnLoad, @OnError
);
end;
// ---- Token helpers ----
function TAuthService.TokenExpirationDate: TDateTime;
var
ExpirationDate: TJSDate;
......@@ -262,7 +528,7 @@ begin
Result := '';
asm
var Token = AToken.split('.');
if (Token.length = 3) {
if (Token.length === 3) {
Result = Token[1];
Result = atob(Result);
}
......
object FViewDeviceManager: TFViewDeviceManager
Width = 900
Height = 600
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
OnCreate = WebFormCreate
object pnlMessage: TWebPanel
Left = 8
Top = 8
Width = 200
Height = 33
ElementID = 'view.devmgr.message'
TabOrder = 0
object lblMessage: TWebLabel
Left = 8
Top = 8
Width = 42
Height = 13
Caption = 'Message'
ElementID = 'view.devmgr.message.label'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnCloseNotification: TWebButton
Left = 170
Top = 4
Width = 22
Height = 25
ElementID = 'view.devmgr.message.button'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnCloseNotificationClick
end
end
object edtNewDeviceName: TWebEdit
Left = 8
Top = 50
Width = 175
Height = 25
ElementID = 'view.devmgr.newname'
HeightPercent = 100.000000000000000000
TabOrder = 1
WidthPercent = 100.000000000000000000
end
object edtNewPhoneNumber: TWebEdit
Left = 192
Top = 50
Width = 155
Height = 25
ElementID = 'view.devmgr.newphone'
HeightPercent = 100.000000000000000000
TabOrder = 2
TextHint = '(303) 555-1234'
WidthPercent = 100.000000000000000000
end
object btnAddDevice: TWebButton
Left = 356
Top = 50
Width = 60
Height = 25
Caption = 'Add'
ElementID = 'view.devmgr.btnadd'
HeightPercent = 100.000000000000000000
TabOrder = 3
WidthPercent = 100.000000000000000000
OnClick = btnAddDeviceClick
end
object btnLogout: TWebButton
Left = 720
Top = 50
Width = 75
Height = 25
Caption = 'Log Out'
ElementID = 'view.devmgr.btnlogout'
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
OnClick = btnLogoutClick
end
object XDataWebClient: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 800
Top = 8
end
end
<div class="container-fluid p-3 h-100 d-flex flex-column">
<div class="d-flex align-items-center mb-3">
<h5 class="mb-0 me-auto">Device Management</h5>
<button id="view.devmgr.btnlogout" class="btn btn-outline-secondary btn-sm me-2" type="button">
Log Out
</button>
<button id="view.devmgr.btnrefresh"
class="btn btn-outline-secondary btn-sm"
onclick="document.dispatchEvent(new CustomEvent('devmgr-refresh'))">
Refresh
</button>
</div>
<!-- Notification bar -->
<div id="view.devmgr.message"
class="alert alert-danger d-flex align-items-start d-none mb-3"
role="alert">
<span id="view.devmgr.message.label" class="me-auto"></span>
<button id="view.devmgr.message.button"
type="button"
class="btn-close ms-2"
aria-label="Close"></button>
</div>
<!-- Add pending device -->
<div class="card mb-3">
<div class="card-body py-2">
<div class="d-flex align-items-center gap-2 flex-wrap">
<span class="fw-semibold text-nowrap small">Add Device:</span>
<input type="text"
id="view.devmgr.newname"
class="form-control form-control-sm"
placeholder="Device name"
style="max-width:180px;">
<input type="tel"
id="view.devmgr.newphone"
class="form-control form-control-sm"
placeholder="(303) 555-1234"
style="max-width:160px;">
<button id="view.devmgr.btnadd"
class="btn btn-primary btn-sm">Add</button>
</div>
</div>
</div>
<!-- Device table -->
<div class="table-responsive flex-grow-1">
<table class="table table-sm table-hover align-middle" id="view.devmgr.table">
<thead class="table-light sticky-top">
<tr>
<th style="min-width:130px;">Device Name</th>
<th style="min-width:120px;">Phone</th>
<th style="min-width:140px;">Username</th>
<th>Browser / User Agent</th>
<th style="min-width:135px;">Registered</th>
<th style="min-width:80px;">Status</th>
<th style="min-width:180px;">Actions</th>
</tr>
</thead>
<tbody id="view.devmgr.tbody">
</tbody>
</table>
<p id="view.devmgr.empty" class="text-muted d-none text-center py-4">
No devices found.
</p>
</div>
</div>
unit View.DeviceManager;
interface
uses
System.SysUtils, System.Classes, Web, JS, WEBLib.Graphics, WEBLib.Controls,
WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls,
WEBLib.ExtCtrls, XData.Web.Client, ConnectionModule;
type
TFViewDeviceManager = class(TWebForm)
XDataWebClient: TXDataWebClient;
pnlMessage: TWebPanel;
lblMessage: TWebLabel;
btnCloseNotification: TWebButton;
edtNewDeviceName: TWebEdit;
edtNewPhoneNumber: TWebEdit;
btnAddDevice: TWebButton;
btnLogout: TWebButton;
procedure btnLogoutClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject);
procedure btnCloseNotificationClick(Sender: TObject);
procedure btnAddDeviceClick(Sender: TObject);
private
procedure ShowNotification(const AMsg: string; AIsError: Boolean = True);
procedure HideNotification;
procedure ClearTable;
procedure AddDeviceRow(const ACredentialId, AName, APhoneNumber, AUsername,
AUserAgent, ARegisteredAt, AStatus: string);
[async] procedure LoadDevices;
[async] procedure RevokeDevice(const ACredentialId, AName: string);
[async] procedure UnrevokeDevice(const ACredentialId, AName: string);
[async] procedure DeletePendingDevice(const APhoneNumber, AName: string);
[async] procedure SendAppLink(const APhoneNumber, AName: string);
[async] procedure AddPendingDevice;
[async] procedure UpdateDeviceUsername(const ACredentialId, AUsername: string);
public
end;
var
FViewDeviceManager: TFViewDeviceManager;
implementation
uses
Auth.Service;
{$R *.dfm}
function FormatPhoneDisplay(const AE164: string): string;
var
digits: string;
begin
if Length(AE164) = 12 then
digits := Copy(AE164, 3, 10)
else
digits := AE164;
if Length(digits) = 10 then
Result := '(' + Copy(digits,1,3) + ') ' + Copy(digits,4,3) + '-' + Copy(digits,7,4)
else
Result := AE164;
end;
procedure TFViewDeviceManager.WebFormCreate(Sender: TObject);
begin
btnLogout.Visible := AuthService.DeviceManagementMode;
HideNotification;
LoadDevices;
asm
// Format phone input on-the-fly
var inp = document.getElementById('view.devmgr.newphone');
if (inp) {
inp.addEventListener('input', function() {
var digits = inp.value.replace(/\D/g, '');
if (digits.length > 10) digits = digits.slice(0, 10);
var fmt = '';
if (digits.length > 6)
fmt = '(' + digits.slice(0,3) + ') ' + digits.slice(3,6) + '-' + digits.slice(6);
else if (digits.length > 3)
fmt = '(' + digits.slice(0,3) + ') ' + digits.slice(3);
else if (digits.length > 0)
fmt = '(' + digits;
inp.value = fmt;
});
}
end;
end;
procedure TFViewDeviceManager.btnLogoutClick(Sender: TObject);
begin
AuthService.Logout;
window.location.reload(False);
end;
procedure TFViewDeviceManager.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
end;
procedure TFViewDeviceManager.ShowNotification(const AMsg: string; AIsError: Boolean);
begin
lblMessage.Caption := AMsg;
asm
var el = document.getElementById('view.devmgr.message');
if (el) {
el.classList.remove('alert-danger', 'alert-success');
el.classList.add(AIsError ? 'alert-danger' : 'alert-success');
el.classList.remove('d-none');
}
end;
end;
procedure TFViewDeviceManager.HideNotification;
begin
asm
var el = document.getElementById('view.devmgr.message');
if (el) el.classList.add('d-none');
end;
end;
procedure TFViewDeviceManager.ClearTable;
begin
asm
var tbody = document.getElementById('view.devmgr.tbody');
if (tbody) tbody.innerHTML = '';
var empty = document.getElementById('view.devmgr.empty');
if (empty) empty.classList.add('d-none');
end;
end;
procedure TFViewDeviceManager.AddDeviceRow(const ACredentialId, AName,
APhoneNumber, AUsername, AUserAgent, ARegisteredAt, AStatus: string);
var
tbody, tr, tdName, tdPhone, tdUser, tdAgent, tdReg, tdStatus, tdAction: TJSHTMLElement;
btn, btnSend, inp, saveBtn: TJSHTMLElement;
displayDate, displayPhone: string;
isPending, isRevoked, isActive: Boolean;
begin
tbody := TJSHTMLElement(document.getElementById('view.devmgr.tbody'));
if not Assigned(tbody) then Exit;
isPending := AStatus = 'pending';
isRevoked := AStatus = 'revoked';
isActive := AStatus = 'active';
displayPhone := FormatPhoneDisplay(APhoneNumber);
tr := TJSHTMLElement(document.createElement('tr'));
if isRevoked then tr.classList.add('table-secondary');
if isPending then tr.classList.add('table-warning');
// Device name
tdName := TJSHTMLElement(document.createElement('td'));
if AName <> '' then
tdName.innerText := AName
else
tdName.innerHTML := '<em class="text-muted">unnamed</em>';
tr.appendChild(tdName);
// Phone number
tdPhone := TJSHTMLElement(document.createElement('td'));
tdPhone.innerText := displayPhone;
tr.appendChild(tdPhone);
// Username — editable for active devices
tdUser := TJSHTMLElement(document.createElement('td'));
if isActive then
begin
tdUser.innerHTML :=
'<div class="d-flex gap-1 align-items-center">' +
'<input type="text" class="form-control form-control-sm devmgr-username-input" ' +
'style="max-width:110px;" value="' + AUsername + '" ' +
'placeholder="username">' +
'<button class="btn btn-outline-secondary btn-sm devmgr-username-save">Save</button>' +
'</div>';
inp := TJSHTMLElement(tdUser.querySelector('.devmgr-username-input'));
saveBtn := TJSHTMLElement(tdUser.querySelector('.devmgr-username-save'));
if Assigned(saveBtn) and Assigned(inp) then
saveBtn.addEventListener('click', procedure(Event: TJSMouseEvent)
begin
UpdateDeviceUsername(ACredentialId, string(TJSHTMLInputElement(inp).value));
end);
end
else if AUsername <> '' then
tdUser.innerText := AUsername
else
tdUser.innerHTML := '<em class="text-muted small">—</em>';
tr.appendChild(tdUser);
// User agent (truncated)
tdAgent := TJSHTMLElement(document.createElement('td'));
if not isPending then
begin
tdAgent.setAttribute('title', AUserAgent);
tdAgent.style.setProperty('max-width', '220px');
tdAgent.style.setProperty('overflow', 'hidden');
tdAgent.style.setProperty('text-overflow', 'ellipsis');
tdAgent.style.setProperty('white-space', 'nowrap');
tdAgent.innerText := AUserAgent;
end
else
tdAgent.innerHTML := '<em class="text-muted small">awaiting registration</em>';
tr.appendChild(tdAgent);
// Registered at
displayDate := ARegisteredAt;
if Length(displayDate) >= 19 then
displayDate := Copy(displayDate, 1, 19).Replace('T', ' ');
tdReg := TJSHTMLElement(document.createElement('td'));
if not isPending then
tdReg.innerText := displayDate
else
tdReg.innerHTML := '<em class="text-muted small">—</em>';
tr.appendChild(tdReg);
// Status badge
tdStatus := TJSHTMLElement(document.createElement('td'));
if isPending then
tdStatus.innerHTML := '<span class="badge bg-warning text-dark">Pending</span>'
else if isRevoked then
tdStatus.innerHTML := '<span class="badge bg-secondary">Revoked</span>'
else
tdStatus.innerHTML := '<span class="badge bg-success">Active</span>';
tr.appendChild(tdStatus);
// Actions
tdAction := TJSHTMLElement(document.createElement('td'));
tdAction.className := 'd-flex gap-1 flex-wrap';
if isPending then
begin
btn := TJSHTMLElement(document.createElement('button'));
btn.className := 'btn btn-outline-danger btn-sm';
btn.innerText := 'Cancel';
btn.addEventListener('click', procedure(Event: TJSMouseEvent)
begin
DeletePendingDevice(APhoneNumber, AName);
end);
tdAction.appendChild(btn);
end
else if isRevoked then
begin
btn := TJSHTMLElement(document.createElement('button'));
btn.className := 'btn btn-outline-success btn-sm';
btn.innerText := 'Unrevoke';
btn.addEventListener('click', procedure(Event: TJSMouseEvent)
begin
UnrevokeDevice(ACredentialId, AName);
end);
tdAction.appendChild(btn);
end
else
begin
btn := TJSHTMLElement(document.createElement('button'));
btn.className := 'btn btn-danger btn-sm';
btn.innerText := 'Revoke';
btn.addEventListener('click', procedure(Event: TJSMouseEvent)
begin
RevokeDevice(ACredentialId, AName);
end);
tdAction.appendChild(btn);
end;
// Send App Link for pending and active rows with a phone number
if (not isRevoked) and (APhoneNumber <> '') then
begin
btnSend := TJSHTMLElement(document.createElement('button'));
btnSend.className := 'btn btn-outline-primary btn-sm';
btnSend.innerText := 'Send Link';
btnSend.addEventListener('click', procedure(Event: TJSMouseEvent)
begin
SendAppLink(APhoneNumber, AName);
end);
tdAction.appendChild(btnSend);
end;
if tdAction.children.length = 0 then
tdAction.innerText := '—';
tr.appendChild(tdAction);
tbody.appendChild(tr);
end;
procedure TFViewDeviceManager.LoadDevices;
var
resp: TXDataClientResponse;
list: TJSObject;
data: TJSArray;
item: TJSObject;
i, count: Integer;
begin
ClearTable;
HideNotification;
try
resp := await(XDataWebClient.RawInvokeAsync('IApiService.GetDeviceList', []));
list := TJSObject(resp.Result);
data := TJSArray(list['data']);
count := Integer(list['count']);
if count = 0 then
begin
asm
var el = document.getElementById('view.devmgr.empty');
if (el) el.classList.remove('d-none');
end;
Exit;
end;
for i := 0 to data.Length - 1 do
begin
item := TJSObject(data[i]);
AddDeviceRow(
string(item['credential_id']),
string(item['device_name']),
string(item['phone_number']),
string(item['username']),
string(item['user_agent']),
string(item['registered_at']),
string(item['status'])
);
end;
except
on E: Exception do
ShowNotification('Failed to load devices: ' + E.Message);
end;
end;
procedure TFViewDeviceManager.RevokeDevice(const ACredentialId, AName: string);
var
resp: TXDataClientResponse;
res: TJSObject;
status: string;
begin
try
resp := await(XDataWebClient.RawInvokeAsync('IApiService.RevokeDevice', [ACredentialId]));
res := TJSObject(resp.Result);
status := string(res['status']);
if status = 'ok' then
begin
ShowNotification('Device "' + AName + '" has been revoked.', False);
LoadDevices;
end
else
ShowNotification(string(res['message']));
except
on E: Exception do
ShowNotification('Revoke failed: ' + E.Message);
end;
end;
procedure TFViewDeviceManager.DeletePendingDevice(const APhoneNumber, AName: string);
var
resp: TXDataClientResponse;
res: TJSObject;
status: string;
begin
try
resp := await(XDataWebClient.RawInvokeAsync('IApiService.DeletePendingDevice', [APhoneNumber]));
res := TJSObject(resp.Result);
status := string(res['status']);
if status = 'ok' then
begin
ShowNotification('Pending device "' + AName + '" removed.', False);
LoadDevices;
end
else
ShowNotification(string(res['message']));
except
on E: Exception do
ShowNotification('Delete failed: ' + E.Message);
end;
end;
procedure TFViewDeviceManager.SendAppLink(const APhoneNumber, AName: string);
var
resp: TXDataClientResponse;
res: TJSObject;
status: string;
begin
try
resp := await(XDataWebClient.RawInvokeAsync('IApiService.SendAppLink', [APhoneNumber]));
res := TJSObject(resp.Result);
status := string(res['status']);
if status = 'ok' then
ShowNotification('App link sent to "' + AName + '" via SMS.', False)
else
ShowNotification(string(res['message']));
except
on E: Exception do
ShowNotification('Send failed: ' + E.Message);
end;
end;
procedure TFViewDeviceManager.UnrevokeDevice(const ACredentialId, AName: string);
var
resp: TXDataClientResponse;
res: TJSObject;
status: string;
begin
try
resp := await(XDataWebClient.RawInvokeAsync('IApiService.UnrevokeDevice', [ACredentialId]));
res := TJSObject(resp.Result);
status := string(res['status']);
if status = 'ok' then
begin
ShowNotification('Device "' + AName + '" has been restored.', False);
LoadDevices;
end
else
ShowNotification(string(res['message']));
except
on E: Exception do
ShowNotification('Unrevoke failed: ' + E.Message);
end;
end;
procedure TFViewDeviceManager.btnAddDeviceClick(Sender: TObject);
begin
AddPendingDevice;
end;
procedure TFViewDeviceManager.UpdateDeviceUsername(const ACredentialId, AUsername: string);
var
resp: TXDataClientResponse;
res: TJSObject;
status: string;
begin
try
resp := await(XDataWebClient.RawInvokeAsync('IApiService.UpdateDeviceUsername', [ACredentialId, AUsername]));
res := TJSObject(resp.Result);
status := string(res['status']);
if status = 'ok' then
ShowNotification('Username updated.', False)
else
ShowNotification(string(res['message']));
except
on E: Exception do
ShowNotification('Update failed: ' + E.Message);
end;
end;
procedure TFViewDeviceManager.AddPendingDevice;
var
deviceName, phoneNumber: string;
resp: TXDataClientResponse;
res: TJSObject;
status: string;
begin
deviceName := Trim(edtNewDeviceName.Text);
phoneNumber := Trim(edtNewPhoneNumber.Text);
if deviceName = '' then
begin
ShowNotification('Please enter a device name.');
Exit;
end;
if phoneNumber = '' then
begin
ShowNotification('Please enter a phone number.');
Exit;
end;
try
resp := await(XDataWebClient.RawInvokeAsync('IApiService.AddPendingDevice', [deviceName, phoneNumber]));
res := TJSObject(resp.Result);
status := string(res['status']);
if status = 'ok' then
begin
edtNewDeviceName.Text := '';
edtNewPhoneNumber.Text := '';
ShowNotification('Device "' + deviceName + '" added — waiting for user to register.', False);
LoadDevices;
end
else
ShowNotification(string(res['message']));
except
on E: Exception do
ShowNotification('Add failed: ' + E.Message);
end;
end;
end.
......@@ -18,6 +18,19 @@ object FViewDeviceRegistration: TFViewDeviceRegistration
TextHint = '(303) 555-1234'
WidthPercent = 100.000000000000000000
end
object chkUseWebAuthn: TWebCheckBox
Left = 240
Top = 163
Width = 160
Height = 21
Caption = 'Use Passkey (WebAuthn)'
Checked = True
ElementID = 'view.devicereg.chkwebauthn'
HeightPercent = 100.000000000000000000
State = cbChecked
TabOrder = 1
WidthPercent = 100.000000000000000000
end
object btnRegister: TWebButton
Left = 240
Top = 190
......@@ -26,7 +39,7 @@ object FViewDeviceRegistration: TFViewDeviceRegistration
Caption = 'Register This Device'
ElementID = 'view.devicereg.btnregister'
HeightPercent = 100.000000000000000000
TabOrder = 1
TabOrder = 2
WidthPercent = 100.000000000000000000
OnClick = btnRegisterClick
end
......
......@@ -31,12 +31,18 @@
aria-label="Close"></button>
</div>
<p class="text-muted small mb-3">
<p id="view.devicereg.desc-webauthn" class="text-muted small mb-3">
This browser has not been registered for emiMobile access.
Enter the phone number your administrator registered for this device,
then click <strong>Register</strong>.
Your browser will prompt you to verify with a PIN, fingerprint, or security key.
</p>
<p id="view.devicereg.desc-simplekey" class="text-muted small mb-3 d-none">
This browser has not been registered for emiMobile access.
Enter the phone number your administrator registered for this device,
then click <strong>Register</strong>.
A secure key will be generated and stored in your browser.
</p>
<div class="mb-3">
<label class="form-label small text-muted">Phone number</label>
......@@ -54,6 +60,25 @@
style="max-width:100%; overflow:hidden; white-space:nowrap;"></p>
</div>
<div class="mb-3">
<div class="form-check">
<input class="form-check-input" type="checkbox"
id="view.devicereg.chkwebauthn" checked>
<label class="form-check-label small text-muted"
for="view.devicereg.chkwebauthn">
Use Passkey (WebAuthn)
</label>
</div>
<p id="view.devicereg.chk-webauthn-help"
class="text-muted mb-0" style="font-size:0.75rem; padding-left:1.5rem;">
Biometrics, PIN, or security key — hardware-backed.
</p>
<p id="view.devicereg.chk-simplekey-help"
class="text-muted mb-0 d-none" style="font-size:0.75rem; padding-left:1.5rem;">
Browser-stored key — no hardware required.
</p>
</div>
<button id="view.devicereg.btnregister"
class="btn btn-primary w-100">
Register This Device
......
......@@ -11,6 +11,7 @@ uses
type
TFViewDeviceRegistration = class(TWebForm)
edtPhoneNumber: TWebEdit;
chkUseWebAuthn: TWebCheckBox;
btnRegister: TWebButton;
pnlMessage: TWebPanel;
lblMessage: TWebLabel;
......@@ -25,6 +26,7 @@ type
procedure HideNotification;
procedure SetBusy(ABusy: Boolean);
procedure DoWebAuthnCreate(APhoneNumber, AChallenge, AChallengeToken: string);
procedure DoSimpleKeyCreate(APhoneNumber, AChallengeToken: string);
public
class procedure Display(ARegistrationProc: TSuccessProc);
end;
......@@ -77,6 +79,28 @@ begin
inp.value = formatted;
});
}
// Toggle description text when checkbox changes
var chk = document.getElementById('view.devicereg.chkwebauthn');
if (chk) {
chk.addEventListener('change', function() {
var waDesc = document.getElementById('view.devicereg.desc-webauthn');
var skDesc = document.getElementById('view.devicereg.desc-simplekey');
var waHelp = document.getElementById('view.devicereg.chk-webauthn-help');
var skHelp = document.getElementById('view.devicereg.chk-simplekey-help');
if (chk.checked) {
if (waDesc) waDesc.classList.remove('d-none');
if (skDesc) skDesc.classList.add('d-none');
if (waHelp) waHelp.classList.remove('d-none');
if (skHelp) skHelp.classList.add('d-none');
} else {
if (waDesc) waDesc.classList.add('d-none');
if (skDesc) skDesc.classList.remove('d-none');
if (waHelp) waHelp.classList.add('d-none');
if (skHelp) skHelp.classList.remove('d-none');
}
});
}
end;
end;
......@@ -84,9 +108,14 @@ procedure TFViewDeviceRegistration.SetBusy(ABusy: Boolean);
begin
asm
var btn = document.getElementById('view.devicereg.btnregister');
var chk = document.getElementById('view.devicereg.chkwebauthn');
if (btn) {
btn.disabled = ABusy;
btn.textContent = ABusy ? 'Waiting for authenticator...' : 'Register This Device';
if (ABusy) {
btn.textContent = (chk && chk.checked) ? 'Waiting for authenticator...' : 'Activating device...';
} else {
btn.textContent = 'Register This Device';
}
}
end;
end;
......@@ -94,10 +123,14 @@ end;
procedure TFViewDeviceRegistration.btnRegisterClick(Sender: TObject);
var
phoneNumber: string;
useWebAuthn: Boolean;
procedure OnBeginOK(AChallenge, AChallengeToken: string);
begin
DoWebAuthnCreate(phoneNumber, AChallenge, AChallengeToken);
if useWebAuthn then
DoWebAuthnCreate(phoneNumber, AChallenge, AChallengeToken)
else
DoSimpleKeyCreate(phoneNumber, AChallengeToken);
end;
procedure OnBeginError(AMsg: string);
......@@ -114,6 +147,7 @@ begin
Exit;
end;
useWebAuthn := chkUseWebAuthn.Checked;
SetBusy(True);
HideNotification;
......@@ -198,6 +232,46 @@ begin
end;
end;
procedure TFViewDeviceRegistration.DoSimpleKeyCreate(APhoneNumber, AChallengeToken: string);
var
phoneNumber, challengeToken, deviceKey: string;
procedure OnCompleteOK;
begin
FRegistrationProc;
end;
procedure OnCompleteError(AMsg: string);
begin
SetBusy(False);
ShowNotification(AMsg);
end;
begin
phoneNumber := APhoneNumber;
challengeToken := AChallengeToken;
deviceKey := '';
asm
var keyBytes = new Uint8Array(32);
crypto.getRandomValues(keyBytes);
var bin = String.fromCharCode.apply(null, keyBytes);
deviceKey = btoa(bin).replace(/\+/g, '-').replace(/\//g, '_').replace(/=/g, '');
end;
if deviceKey = '' then
begin
SetBusy(False);
ShowNotification('Failed to generate device key.');
Exit;
end;
AuthService.CompleteRegistrationSimple(
phoneNumber, deviceKey, challengeToken,
@OnCompleteOK, @OnCompleteError
);
end;
procedure TFViewDeviceRegistration.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
......
......@@ -109,6 +109,18 @@ object FViewLogin: TFViewLogin
DisplayText = 'BUF - Buffalo Police Department'
end>
end
object btnPasskeyLogin: TWebButton
Left = 240
Top = 244
Width = 121
Height = 25
Caption = 'Sign In with Passkey'
ElementID = 'view.login.btnpasskeylogin'
HeightPercent = 100.000000000000000000
TabOrder = 5
WidthPercent = 100.000000000000000000
OnClick = btnPasskeyLoginClick
end
object XDataWebClient: TXDataWebClient
Connection = DMConnection.AuthConnection
Left = 492
......
......@@ -29,6 +29,23 @@
aria-label="Close"></button>
</div>
<!-- Auto-login section (shown when device has a stored username) -->
<div id="view.login.autosection" class="d-none">
<p class="text-center text-muted mb-1 small">Signing in as</p>
<p id="view.login.autouserlabel"
class="text-center fw-semibold fs-5 mb-3"></p>
<button id="view.login.btnpasskeylogin"
class="btn btn-primary w-100 mb-2">
Sign In with Passkey
</button>
<div class="text-center">
<a id="view.login.switchmanual" href="#"
class="small text-muted">Use a different account</a>
</div>
</div>
<!-- Manual login section -->
<div id="view.login.manualsection">
<div class="mb-3">
<input id="view.login.edtusername"
class="form-control"
......@@ -36,18 +53,14 @@
placeholder="Username"
autofocus>
</div>
<div class="mb-3">
<div class="input-group">
<div class="input-group mb-3">
<input id="view.login.edtpassword"
class="form-control"
type="password"
placeholder="Password">
<button id="view.login.btnshowpassword"
class="btn btn-outline-secondary"
type="button">
Show
</button>
</div>
type="button">Show</button>
</div>
<div class="mb-3">
<select id="view.login.edtagency" class="form-select">
......@@ -59,6 +72,7 @@
Login
</button>
</div>
</div>
<div class="card-footer text-muted small d-flex justify-content-between">
<span>Please use your lems username &amp; password to login.</span>
<span id="view.login.version" class="opacity-75"></span>
......
unit View.Login;
unit View.Login;
interface
......@@ -15,21 +15,29 @@ type
edtPassword: TWebEdit;
btnShowPassword: TWebButton;
btnLogin: TWebButton;
btnPasskeyLogin: TWebButton;
pnlMessage: TWebPanel;
lblMessage: TWebLabel;
btnCloseNotification: TWebButton;
XDataWebClient: TXDataWebClient;
lucbAgency: TWebLookupComboBox;
procedure btnLoginClick(Sender: TObject);
procedure btnPasskeyLoginClick(Sender: TObject);
procedure btnShowPasswordClick(Sender: TObject);
procedure btnCloseNotificationClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject);
private
FLoginProc: TSuccessProc;
FMessage: string;
FAutoUsername: string;
FAutoAgency: string;
procedure ShowNotification(Notification: string);
procedure HideNotification;
procedure GetAgencyConfigList;
procedure SetBusy(ABusy: Boolean);
procedure DoWebAuthnGet(AUser, APassword, AAgency, ACredentialId,
AChallenge, AChallengeToken: string);
procedure DoPasskeyAutoLogin(ACredentialId, AChallenge, AChallengeToken: string);
public
class procedure Display(LoginProc: TSuccessProc); overload;
class procedure Display(LoginProc: TSuccessProc; AMsg: string); overload;
......@@ -65,42 +73,377 @@ begin
FViewLogin.FLoginProc := LoginProc;
end;
procedure TFViewLogin.WebFormCreate(Sender: TObject);
var
el: TJSElement;
credId: string;
procedure OnDeviceUser(AUsername, AAgency: string);
procedure OnAutoLoginOK;
begin
FLoginProc;
end;
procedure OnAutoLoginError(AMsg: string);
begin
asm
var autoSection = document.getElementById('view.login.autosection');
var manualSection = document.getElementById('view.login.manualsection');
if (autoSection) autoSection.classList.add('d-none');
if (manualSection) manualSection.classList.remove('d-none');
end;
ShowNotification(AMsg);
end;
procedure OnBeginForSimpleOK(AChallenge, AChallengeToken: string);
begin
AuthService.LoginDeviceKey(credId, AChallengeToken, @OnAutoLoginOK, @OnAutoLoginError);
end;
procedure OnBeginForSimpleError(AMsg: string);
begin
asm
var autoSection = document.getElementById('view.login.autosection');
var manualSection = document.getElementById('view.login.manualsection');
if (autoSection) autoSection.classList.add('d-none');
if (manualSection) manualSection.classList.remove('d-none');
end;
ShowNotification('Login Error: ' + AMsg);
end;
begin
FAutoUsername := AUsername;
FAutoAgency := AAgency;
if AUsername <> '' then
begin
asm
var autoSection = document.getElementById('view.login.autosection');
var manualSection = document.getElementById('view.login.manualsection');
var lbl = document.getElementById('view.login.autouserlabel');
if (autoSection) autoSection.classList.remove('d-none');
if (manualSection) manualSection.classList.add('d-none');
if (lbl) lbl.textContent = AUsername;
// "Use a different account" — pure JS show/hide
var lnk = document.getElementById('view.login.switchmanual');
if (lnk) {
lnk.addEventListener('click', function(e) {
e.preventDefault();
document.getElementById('view.login.autosection').classList.add('d-none');
document.getElementById('view.login.manualsection').classList.remove('d-none');
});
}
end;
if AuthService.IsSimpleKey then
begin
// Hide passkey button — simple-key auto-login needs no hardware interaction
asm
var btn = document.getElementById('view.login.btnpasskeylogin');
if (btn) btn.style.display = 'none';
end;
AuthService.BeginAuthentication(credId, @OnBeginForSimpleOK, @OnBeginForSimpleError);
end;
end;
end;
begin
GetAgencyConfigList;
el := Document.getElementById('view.login.version');
if Assigned(el) then
TJSHtmlElement(el).innerText := 'v' + TDMConnection.clientVersion;
GetAgencyConfigList();
if FMessage <> '' then
ShowNotification(FMessage)
else
HideNotification;
if AuthService.DeviceManagementMode then
begin
el := Document.getElementById('view.login.title');
if Assigned(el) then
TJSHtmlElement(el).innerText := 'Device Management Sign In';
Exit;
end;
credId := AuthService.GetCredentialId;
if credId <> '' then
AuthService.GetDeviceUser(credId, @OnDeviceUser);
end;
procedure TFViewLogin.SetBusy(ABusy: Boolean);
begin
asm
var btn = document.getElementById('view.login.btnlogin');
if (btn) {
btn.disabled = ABusy;
btn.textContent = ABusy ? 'Verifying...' : 'Login';
}
end;
end;
procedure TFViewLogin.btnLoginClick(Sender: TObject);
var
user, password, agency, credentialId: string;
procedure OnLoginOK;
begin
FLoginProc;
end;
procedure OnLoginError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
end;
procedure OnBeginOK(AChallenge, AChallengeToken: string);
begin
if AuthService.IsSimpleKey then
AuthService.LoginPasswordAndSimpleKey(
user, password, agency, credentialId, AChallengeToken,
@OnLoginOK, @OnLoginError)
else
DoWebAuthnGet(user, password, agency, credentialId, AChallenge, AChallengeToken);
end;
procedure OnBeginError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
end;
begin
user := edtUsername.Text;
password := edtPassword.Text;
agency := lucbAgency.Value;
if (user = '') or (password = '') or (agency = '') then
begin
ShowNotification('Please enter a username, password, and agency.');
Exit;
end;
if AuthService.DeviceManagementMode then
begin
SetBusy(True);
HideNotification;
AuthService.LoginDeviceManager(user, password, agency, @OnLoginOK, @OnLoginError);
Exit;
end;
credentialId := AuthService.GetCredentialId;
if credentialId = '' then
begin
ShowNotification('Device not registered. Please restart the app to register this device.');
Exit;
end;
SetBusy(True);
HideNotification;
AuthService.BeginAuthentication(credentialId, @OnBeginOK, @OnBeginError);
end;
procedure LoginSuccess;
procedure TFViewLogin.btnPasskeyLoginClick(Sender: TObject);
var
credId: string;
procedure OnLoginOK;
begin
FLoginProc;
end;
procedure LoginError(AMsg: string);
procedure OnLoginError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
asm
var autoSection = document.getElementById('view.login.autosection');
var manualSection = document.getElementById('view.login.manualsection');
if (autoSection) autoSection.classList.add('d-none');
if (manualSection) manualSection.classList.remove('d-none');
end;
end;
procedure OnBeginOK(AChallenge, AChallengeToken: string);
begin
if AuthService.IsSimpleKey then
AuthService.LoginDeviceKey(credId, AChallengeToken, @OnLoginOK, @OnLoginError)
else
DoPasskeyAutoLogin(credId, AChallenge, AChallengeToken);
end;
procedure OnBeginError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
end;
begin
AuthService.Login(
edtUsername.Text, edtPassword.Text, lucbAgency.Value,
@LoginSuccess,
@LoginError
credId := AuthService.GetCredentialId;
if credId = '' then
begin
ShowNotification('Device not registered. Please restart the app.');
Exit;
end;
SetBusy(True);
HideNotification;
AuthService.BeginAuthentication(credId, @OnBeginOK, @OnBeginError);
end;
procedure TFViewLogin.DoWebAuthnGet(AUser, APassword, AAgency, ACredentialId,
AChallenge, AChallengeToken: string);
var
user, password, agency, credentialId, challenge, challengeToken: string;
procedure OnLoginOK;
begin
FLoginProc;
end;
procedure OnLoginError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
end;
procedure OnAssertion(AAuthData, AClientDataJSON, ASignature: string);
begin
AuthService.LoginWithAssertion(
user, password, agency, credentialId, challengeToken,
AAuthData, AClientDataJSON, ASignature,
@OnLoginOK, @OnLoginError
);
end;
procedure OnWebAuthnError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
end;
begin
user := AUser;
password := APassword;
agency := AAgency;
credentialId := ACredentialId;
challenge := AChallenge;
challengeToken := AChallengeToken;
asm
(function() {
function b64urlToArr(b64) {
b64 = b64.replace(/-/g, '+').replace(/_/g, '/');
while (b64.length % 4) b64 += '=';
var bin = atob(b64);
var arr = new Uint8Array(bin.length);
for (var i = 0; i < bin.length; i++) arr[i] = bin.charCodeAt(i);
return arr;
}
function arrToB64url(buf) {
var bin = String.fromCharCode.apply(null, new Uint8Array(buf));
return btoa(bin).replace(/\+/g, '-').replace(/\//g, '_').replace(/=/g, '');
}
navigator.credentials.get({
publicKey: {
challenge: b64urlToArr(challenge),
rpId: window.location.hostname,
allowCredentials: [{
id: b64urlToArr(credentialId),
type: 'public-key'
}],
timeout: 60000,
userVerification: 'required'
}
}).then(function(assertion) {
var authData = arrToB64url(assertion.response.authenticatorData);
var cdJson = arrToB64url(assertion.response.clientDataJSON);
var sig = arrToB64url(assertion.response.signature);
OnAssertion(authData, cdJson, sig);
}).catch(function(err) {
OnWebAuthnError('WebAuthn error: ' + err.message);
});
})();
end;
end;
procedure TFViewLogin.DoPasskeyAutoLogin(ACredentialId, AChallenge, AChallengeToken: string);
var
credentialId, challenge, challengeToken: string;
procedure OnLoginOK;
begin
FLoginProc;
end;
procedure OnLoginError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
// If auto-login fails, fall back to manual form
asm
var autoSection = document.getElementById('view.login.autosection');
var manualSection = document.getElementById('view.login.manualsection');
if (autoSection) autoSection.classList.add('d-none');
if (manualSection) manualSection.classList.remove('d-none');
end;
end;
procedure OnAssertion(AAuthData, AClientDataJSON, ASignature: string);
begin
AuthService.LoginAutomatic(
credentialId, challengeToken,
AAuthData, AClientDataJSON, ASignature,
@OnLoginOK, @OnLoginError
);
end;
procedure OnWebAuthnError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Passkey Error: ' + AMsg);
end;
begin
credentialId := ACredentialId;
challenge := AChallenge;
challengeToken := AChallengeToken;
asm
(function() {
function b64urlToArr(b64) {
b64 = b64.replace(/-/g, '+').replace(/_/g, '/');
while (b64.length % 4) b64 += '=';
var bin = atob(b64);
var arr = new Uint8Array(bin.length);
for (var i = 0; i < bin.length; i++) arr[i] = bin.charCodeAt(i);
return arr;
}
function arrToB64url(buf) {
var bin = String.fromCharCode.apply(null, new Uint8Array(buf));
return btoa(bin).replace(/\+/g, '-').replace(/\//g, '_').replace(/=/g, '');
}
navigator.credentials.get({
publicKey: {
challenge: b64urlToArr(challenge),
rpId: window.location.hostname,
allowCredentials: [{ id: b64urlToArr(credentialId), type: 'public-key' }],
timeout: 60000,
userVerification: 'required'
}
}).then(function(assertion) {
var authData = arrToB64url(assertion.response.authenticatorData);
var cdJson = arrToB64url(assertion.response.clientDataJSON);
var sig = arrToB64url(assertion.response.signature);
OnAssertion(authData, cdJson, sig);
}).catch(function(err) {
OnWebAuthnError('WebAuthn error: ' + err.message);
});
})();
end;
end;
procedure TFViewLogin.btnShowPasswordClick(Sender: TObject);
begin
......@@ -124,8 +467,6 @@ procedure TFViewLogin.GetAgencyConfigList;
procedure OnLoad(Response: TXDataClientResponse);
var
jsResponse: TJSObject;
count: Integer;
returned: Integer;
jsArray: TJSArray;
jsObject: TJSObject;
agency: string;
......@@ -133,17 +474,14 @@ procedure TFViewLogin.GetAgencyConfigList;
i: Integer;
begin
jsResponse := TJSObject(Response.Result);
count := Integer(jsResponse['count']);
returned := Integer(jsResponse['returned']);
jsArray := TJSArray(TJSObject(Response.Result)['data']);
lucbAgency.LookupValues.Clear;
for i := 0 to jsArray.Length - 1 do
begin
jsObject := TJSObject( jsArray[i] );
agency := string( jsObject['agency'] );
name := string( jsObject['name'] );
lucbAgency.LookupValues.AddPair( agency, agency + ' - ' + name );
jsObject := TJSObject(jsArray[i]);
agency := string(jsObject['agency']);
name := string(jsObject['name']);
lucbAgency.LookupValues.AddPair(agency, agency + ' - ' + name);
end;
end;
......@@ -159,7 +497,6 @@ begin
);
end;
procedure TFViewLogin.ShowNotification(Notification: string);
begin
if Notification <> '' then
......@@ -169,13 +506,11 @@ begin
end;
end;
procedure TFViewLogin.HideNotification;
begin
pnlMessage.ElementHandle.classList.add('d-none');
end;
procedure TFViewLogin.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
......
......@@ -221,6 +221,21 @@ object FViewMain: TFViewMain
WidthPercent = 100.000000000000000000
OnClick = btnLogoutClick
end
object btnDevices: TWebButton
Left = 320
Top = 66
Width = 96
Height = 25
Caption = 'Devices'
ChildOrder = 17
ElementID = 'btn_devices'
ElementFont = efCSS
HeightStyle = ssAuto
HeightPercent = 100.000000000000000000
Visible = False
WidthPercent = 100.000000000000000000
OnClick = btnDevicesClick
end
object xdwcBadgeCounts: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 44
......
......@@ -36,6 +36,7 @@
<li><button id="btn_logout" type="button" class="dropdown-item">Logout</button></li>
</ul>
</div>
<button id="btn_devices" type="button" class="btn btn-outline-light btn-sm d-none">Devices</button>
</div>
</div>
</nav>
......
......@@ -33,6 +33,7 @@ type
pnlArchive: TWebPanel;
btnArchiveModalClose: TWebButton;
btnLogout: TWebButton;
btnDevices: TWebButton;
procedure WebFormCreate(Sender: TObject);
procedure mnuLogoutClick(Sender: TObject);
procedure lblLogoutClick(Sender: TObject);
......@@ -44,6 +45,7 @@ type
procedure btnDetailsModalCloseClick(Sender: TObject);
procedure btnArchiveModalCloseClick(Sender: TObject);
procedure btnLogoutClick(Sender: TObject);
procedure btnDevicesClick(Sender: TObject);
private
{ Private declarations }
FUserInfo: string;
......@@ -119,6 +121,7 @@ uses
View.EditUser,
View.UnitDetails,
View.ComplaintArchive,
View.DeviceManager,
Utils;
{$R *.dfm}
......@@ -147,8 +150,17 @@ begin
FBadgeRefreshPending := False;
FPendingWsBadgeCounts := nil;
if (not (JS.toBoolean(AuthService.TokenPayload.Properties['user_admin']))) then
lblUsers.Visible := false;
if JS.toBoolean(AuthService.TokenPayload.Properties['user_admin']) then
begin
// Show admin controls
btnDevices.Visible := True;
asm
var el = document.getElementById('btn_devices');
if (el) el.classList.remove('d-none');
end;
end
else
lblUsers.Visible := False;
Utils.HideSpinner('spinner');
......@@ -309,6 +321,11 @@ begin
FLogoutProc;
end;
procedure TFViewMain.btnDevicesClick(Sender: TObject);
begin
ShowForm(TFViewDeviceManager);
end;
procedure TFViewMain.btnMapClick(Sender: TObject);
begin
ShowForm(TFViewMap);
......
......@@ -69,6 +69,16 @@ html, body {
overflow: hidden;
}
/* iOS safe area: absorb status bar into top nav, home indicator into bottom nav */
@supports (padding-top: env(safe-area-inset-top)) {
#top_nav {
padding-top: calc(0.5rem + env(safe-area-inset-top));
}
#bottom_nav {
padding-bottom: calc(0.5rem + env(safe-area-inset-bottom));
}
}
@supports (-webkit-touch-callout: none) {
/* CSS specific to iOS devices */
span.card {
......
program wcEmiMobile;
program wcEmiMobile;
{$R *.dres}
uses
Vcl.Forms,
System.SysUtils,
XData.Web.Connection,
Auth.Service in 'Auth.Service.pas',
App.Types in 'App.Types.pas',
......@@ -27,18 +28,23 @@ uses
View.ComplaintArchive in 'View.ComplaintArchive.pas' {FViewComplaintArchive: TWebForm} {*.html},
uMapMarkerJs in 'uMapMarkerJs.pas',
Module.Websocket in 'Module.Websocket.pas' {dmWebsocket: TDataModule},
View.DeviceRegistration in 'View.DeviceRegistration.pas' {FViewDeviceRegistration: TWebForm} {*.html};
View.DeviceRegistration in 'View.DeviceRegistration.pas' {FViewDeviceRegistration: TWebForm} {*.html},
View.DeviceManager in 'View.DeviceManager.pas' {FViewDeviceManager: TWebForm} {*.html};
{$R *.res}
procedure DisplayLoginView(AMessage: string = ''); forward;
procedure DisplayDeviceRegistrationView; forward;
procedure DisplayMainView;
procedure ConnectProc;
begin
if Assigned(FViewLogin) then
FViewLogin.Free;
FreeAndNil(FViewLogin);
if AuthService.DeviceManagementMode then
FViewDeviceManager := TFViewDeviceManager.CreateNew
else
TFViewMain.Display(@DisplayLoginView);
end;
......@@ -53,11 +59,29 @@ procedure DisplayLoginView(AMessage: string);
begin
AuthService.Logout;
DMConnection.ApiConnection.Connected := False;
if Assigned(FViewDeviceManager) then
FreeAndNil(FViewDeviceManager);
if Assigned(FViewMain) then
FViewMain.Free;
TFViewLogin.Display(@DisplayMainView, AMessage);
end;
procedure DisplayDeviceRegistrationView;
procedure OnRegistered;
begin
// Device registered — proceed to login
if Assigned(FViewDeviceRegistration) then
FViewDeviceRegistration.Free;
TFViewLogin.Display(@DisplayMainView);
end;
begin
if Assigned(FViewDeviceRegistration) then
FViewDeviceRegistration.Free;
TFViewDeviceRegistration.Display(@OnRegistered);
end;
procedure UnauthorizedAccessProc(AMessage: string);
begin
DisplayLoginView(AMessage);
......@@ -65,6 +89,20 @@ end;
procedure StartApplication;
begin
if AuthService.DeviceManagementMode then
begin
DisplayLoginView;
Exit;
end;
// Step 1: device must be registered before login is allowed
if not AuthService.IsDeviceRegistered then
begin
DisplayDeviceRegistrationView;
Exit;
end;
// Step 2: normal JWT auth check
if (not AuthService.Authenticated) or AuthService.TokenExpired then
DisplayLoginView
else
......
......@@ -203,7 +203,10 @@
</DCCReference>
<DCCReference Include="View.DeviceRegistration.pas">
<Form>FViewDeviceRegistration</Form>
<FormType>dfm</FormType>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<DCCReference Include="View.DeviceManager.pas">
<Form>FViewDeviceManager</Form>
<DesignClass>TWebForm</DesignClass>
</DCCReference>
<None Include="index.html"/>
......
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