Skip to content

E
emiMobile
Commit 9ccbd1b7 by Michael Brachmann
Options

webauthn and device registration

parent 448ace4a
Showing with 1865 additions and 65 deletions
emiMobileServer/Source/Api.Service.pas
......@@ -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,11 @@ 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;
end;
implementation
end.
emiMobileServer/Source/Api.ServiceImpl.pas
......@@ -5,7 +5,9 @@ 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;
type
......@@ -16,6 +18,8 @@ type
private
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
procedure RequireAdmin;
function OpenLemsConnection: TUniConnection;
public
function GetBadgeCounts: TJSONObject;
function GetComplaintList: TJSONObject;
......@@ -30,6 +34,8 @@ 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;
end;
implementation
......@@ -1167,6 +1173,221 @@ begin
end;
// ---------------------------------------------------------------------------
// Device Management
// ---------------------------------------------------------------------------
procedure TApiService.RequireAdmin;
var
ctx: THttpServerContext;
authHeader, b64payload, payload: string;
parts: TArray<string>;
padLen: Integer;
payloadObj: TJSONObject;
adminVal: TJSONValue;
isAdmin: Boolean;
begin
isAdmin := False;
try
// The JWT middleware has already validated the token signature.
// Decode the payload to read the user_admin claim.
// 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
adminVal := payloadObj.GetValue('user_admin');
isAdmin := Assigned(adminVal) and (adminVal is TJSONBool) and
TJSONBool(adminVal).AsBoolean;
finally
payloadObj.Free;
end;
end;
end;
end;
except
isAdmin := False;
end;
if not isAdmin then
raise EXDataHttpException.Create(403, 'Admin access required');
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, user_agent, ' +
' registered_at, revoked_at, revoked_by ' +
'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.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;
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 ' +
'WHERE credential_id = :CID AND revoked_at IS NULL';
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;
initialization
RegisterServiceType(TApiService);
......
emiMobileServer/Source/Auth.Service.pas
......@@ -39,13 +39,45 @@ type
data: TList<TAgencyConfigItem>;
end;
// Device record returned by GetDeviceList (Api.Service)
TDeviceItem = class
public
id: Integer;
credential_id: string;
device_name: string;
user_agent: string;
registered_at: string;
revoked_at: string;
revoked_by: 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;
[HttpGet] function GetAgenciesList(): TAgenciesList;
[HttpGet] function GetAgencyConfigList: TAgencyConfigList;
function VerifyVersion(ClientVersion: string): TJSONObject;
// WebAuthn registration — step 1: server returns challenge + rpId/rpName
function BeginRegistration(const DeviceName: string): TJSONObject;
// WebAuthn registration — step 2: client submits credential, server verifies + stores
function CompleteRegistration(const DeviceName, CredentialId,
AttestationObject, ClientDataJSON,
ChallengeToken: string): TJSONObject;
// WebAuthn authentication challenge — called before Login
function BeginAuthentication(const CredentialId: string): TJSONObject;
end;
implementation
......
emiMobileServer/Source/Common.Config.pas
......@@ -16,6 +16,8 @@ type
FMemoLogLevel: Integer;
FFileLogLevel: Integer;
FAuditEnabled: Boolean;
FRpId: string;
FRpName: string;
public
constructor Create;
property url: string read FUrl write FUrl;
......@@ -26,6 +28,9 @@ type
property auditEnabled: Boolean read FAuditEnabled write FAuditEnabled;
property memoLogLevel: Integer read FMemoLogLevel write FMemoLogLevel;
property fileLogLevel: Integer read FFileLogLevel write FFileLogLevel;
// 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;
end;
procedure LoadServerConfig;
......@@ -90,6 +95,8 @@ begin
memoLogLevel := 3;
fileLogLevel := 4;
auditEnabled := False;
rpId := 'localhost';
rpName := 'emiMobile';
Logger.Log(1, '--TServerConfig.Create - end');
end;
......
emiMobileServer/Source/Webauthn.Cbor.pas 0 → 100644
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.
emiMobileServer/Source/Webauthn.Crypto.pas 0 → 100644
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;
begin
Result := THashSHA2.GetHashBytes(AData);
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.
emiMobileServer/device_registrations.sql 0 → 100644
-- 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.';
webEMIMobile/Auth.Service.pas
......@@ -7,30 +7,53 @@ uses
XData.Web.Client;
const
TOKEN_NAME = 'WEBEMIMOBILE_TOKEN';
TOKEN_NAME = 'WEBEMIMOBILE_TOKEN';
CREDENTIAL_NAME = 'WEBEMIMOBILE_CREDENTIAL_ID';
type
TOnLoginSuccess = reference to procedure;
TOnLoginError = reference to procedure(AMsg: string);
TOnProfileSuccess = reference to procedure;
TOnProfileError = reference to procedure(AMsg: string);
TOnLoginError = reference to procedure(AMsg: string);
TOnBeginSuccess = reference to procedure(AChallenge, AChallengeToken: string);
TOnDeviceSuccess = reference to procedure;
TOnDeviceError = reference to procedure(AMsg: string);
TAuthService = class
private
FClient: TXDataWebClient;
procedure SetToken(AToken: string);
procedure DeleteToken;
procedure SetCredentialId(AId: string);
public
constructor Create; reintroduce;
destructor Destroy; override;
procedure Login(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 (WebAuthn) storage
function GetCredentialId: string;
function IsDeviceRegistered: Boolean;
procedure ClearCredentialId;
// WebAuthn registration — two-step
procedure BeginRegistration(ADeviceName: string;
ASuccess: TOnBeginSuccess; AError: TOnDeviceError);
procedure CompleteRegistration(ADeviceName, 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);
end;
TJwtHelper = class
......@@ -55,52 +78,95 @@ 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
window.localStorage.setItem(TOKEN_NAME, AToken);
end;
procedure TAuthService.DeleteToken;
begin
window.localStorage.removeItem(TOKEN_NAME);
end;
function TAuthService.GetToken: string;
begin
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) <> '');
end;
constructor TAuthService.Create;
procedure TAuthService.Logout;
begin
FClient := TXDataWebClient.Create(nil);
FClient.Connection := DMConnection.AuthConnection;
DeleteToken;
end;
procedure TAuthService.DeleteToken;
// ---- Credential ID storage ----
procedure TAuthService.SetCredentialId(AId: string);
begin
window.localStorage.removeItem(TOKEN_NAME);
window.localStorage.setItem(CREDENTIAL_NAME, AId);
end;
destructor TAuthService.Destroy;
procedure TAuthService.ClearCredentialId;
begin
FClient.Free;
inherited;
window.localStorage.removeItem(CREDENTIAL_NAME);
end;
function TAuthService.GetToken: string;
function TAuthService.GetCredentialId: string;
begin
Result := window.localStorage.getItem(TOKEN_NAME);
Result := window.localStorage.getItem(CREDENTIAL_NAME);
end;
procedure TAuthService.Login(AUser, APassword, AAgency: string; ASuccess: TOnLoginSuccess;
AError: TOnLoginError);
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(ADeviceName: string;
ASuccess: TOnBeginSuccess; AError: TOnDeviceError);
procedure OnLoad(Response: TXDataClientResponse);
var
Token: JS.TJSObject;
resp: JS.TJSObject;
challenge, token, errMsg: string;
begin
Token := JS.TJSObject(Response.Result);
SetToken(JS.toString(Token.Properties['value']));
ASuccess;
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);
......@@ -109,28 +175,115 @@ procedure TAuthService.Login(AUser, APassword, AAgency: string; ASuccess: TOnLog
end;
begin
if (AUser = '') or (APassword = '') or (AAgency = '') then
FClient.RawInvoke(
'IAuthService.BeginRegistration',
[ADeviceName],
@OnLoad, @OnError
);
end;
procedure TAuthService.CompleteRegistration(ADeviceName, ACredentialId,
AAttestationObject, AClientDataJSON, 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 = 'revoked' then
AError('Access denied: ' + msg)
else if status = 'ok' then
begin
SetCredentialId(credId);
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.CompleteRegistration',
[ADeviceName, ACredentialId, AAttestationObject, AClientDataJSON, AChallengeToken],
@OnLoad, @OnError
);
end;
procedure TAuthService.Logout;
// ---- 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;
begin
DeleteToken;
FClient.RawInvoke(
'IAuthService.BeginAuthentication',
[ACredentialId],
@OnLoad, @OnError
);
end;
procedure TAuthService.SetToken(AToken: string);
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
window.localStorage.setItem(TOKEN_NAME, AToken);
FClient.RawInvoke(
'IAuthService.Login',
[AUser, APassword, AAgency, ACredentialId,
AChallengeToken, AAuthenticatorData, AClientDataJSON, ASignature],
@OnLoad, @OnError
);
end;
// ---- Token helpers ----
function TAuthService.TokenExpirationDate: TDateTime;
var
ExpirationDate: TJSDate;
......@@ -176,7 +329,7 @@ begin
Result := '';
asm
var Token = AToken.split('.');
if (Token.length = 3) {
if (Token.length === 3) {
Result = Token[1];
Result = atob(Result);
}
......
webEMIMobile/View.DeviceManager.dfm 0 → 100644
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 = 48
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 XDataWebClient: TXDataWebClient
Connection = DMConnection.ApiConnection
Left = 800
Top = 8
end
end
webEMIMobile/View.DeviceManager.html 0 → 100644
<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">Registered Devices</h5>
<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>
<!-- 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:140px;">Device Name</th>
<th>Browser / User Agent</th>
<th style="min-width:135px;">Registered</th>
<th style="min-width:80px;">Status</th>
<th style="min-width:80px;">Action</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 registered.
</p>
</div>
</div>
webEMIMobile/View.DeviceManager.pas 0 → 100644
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;
procedure WebFormCreate(Sender: TObject);
procedure btnCloseNotificationClick(Sender: TObject);
private
procedure ShowNotification(const AMsg: string; AIsError: Boolean = True);
procedure HideNotification;
procedure ClearTable;
procedure AddDeviceRow(const ACredentialId, AName, AUserAgent,
ARegisteredAt, ARevokedAt: string);
[async] procedure LoadDevices;
[async] procedure RevokeDevice(const ACredentialId, AName: string);
public
end;
var
FViewDeviceManager: TFViewDeviceManager;
implementation
{$R *.dfm}
procedure TFViewDeviceManager.WebFormCreate(Sender: TObject);
begin
HideNotification;
LoadDevices;
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, AUserAgent,
ARegisteredAt, ARevokedAt: string);
var
tbody, tr, tdName, tdAgent, tdReg, tdStatus, tdAction: TJSHTMLElement;
btn: TJSHTMLElement;
isRevoked: Boolean;
displayDate: string;
begin
tbody := TJSHTMLElement(document.getElementById('view.devmgr.tbody'));
if not Assigned(tbody) then
Exit;
isRevoked := ARevokedAt <> '';
tr := TJSHTMLElement(document.createElement('tr'));
if isRevoked then
tr.classList.add('table-secondary');
// 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);
// User agent (truncated via CSS)
tdAgent := TJSHTMLElement(document.createElement('td'));
tdAgent.setAttribute('title', AUserAgent);
tdAgent.style.setProperty('max-width', '260px');
tdAgent.style.setProperty('overflow', 'hidden');
tdAgent.style.setProperty('text-overflow', 'ellipsis');
tdAgent.style.setProperty('white-space', 'nowrap');
tdAgent.innerText := AUserAgent;
tr.appendChild(tdAgent);
// Registered at — trim to seconds, replace T with space
displayDate := ARegisteredAt;
if Length(displayDate) >= 19 then
displayDate := Copy(displayDate, 1, 19).Replace('T', ' ');
tdReg := TJSHTMLElement(document.createElement('td'));
tdReg.innerText := displayDate;
tr.appendChild(tdReg);
// Status badge
tdStatus := TJSHTMLElement(document.createElement('td'));
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);
// Action button
tdAction := TJSHTMLElement(document.createElement('td'));
if not isRevoked then
begin
btn := TJSHTMLElement(document.createElement('button'));
btn.className := 'btn btn-danger btn-sm';
btn.innerText := 'Revoke';
// Capture token and name in a Delphi closure
btn.addEventListener('click', procedure(Event: TJSMouseEvent)
begin
RevokeDevice(ACredentialId, AName);
end);
tdAction.appendChild(btn);
end
else
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['user_agent']),
string(item['registered_at']),
string(item['revoked_at'])
);
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 + '" access has been revoked.', False);
LoadDevices;
end
else
ShowNotification(string(res['message']));
except
on E: Exception do
ShowNotification('Revoke failed: ' + E.Message);
end;
end;
end.
webEMIMobile/View.DeviceRegistration.dfm 0 → 100644
object FViewDeviceRegistration: TFViewDeviceRegistration
Width = 640
Height = 480
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
OnCreate = WebFormCreate
object edtDeviceName: TWebEdit
Left = 240
Top = 136
Width = 121
Height = 21
ElementID = 'view.devicereg.edtdevicename'
HeightPercent = 100.000000000000000000
TextHint = 'Device name (optional)'
WidthPercent = 100.000000000000000000
end
object btnRegister: TWebButton
Left = 240
Top = 190
Width = 121
Height = 25
Caption = 'Register This Device'
ElementID = 'view.devicereg.btnregister'
HeightPercent = 100.000000000000000000
TabOrder = 1
WidthPercent = 100.000000000000000000
OnClick = btnRegisterClick
end
object pnlMessage: TWebPanel
Left = 240
Top = 65
Width = 121
Height = 33
ElementID = 'view.devicereg.message'
TabOrder = 2
object lblMessage: TWebLabel
Left = 16
Top = 11
Width = 42
Height = 13
Caption = 'Message'
ElementID = 'view.devicereg.message.label'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
end
object btnCloseNotification: TWebButton
Left = 96
Top = 3
Width = 22
Height = 25
ElementID = 'view.devicereg.message.button'
HeightPercent = 100.000000000000000000
WidthPercent = 100.000000000000000000
OnClick = btnCloseNotificationClick
end
end
object XDataWebClient: TXDataWebClient
Connection = DMConnection.AuthConnection
Left = 492
Top = 102
end
end
webEMIMobile/View.DeviceRegistration.html 0 → 100644
<div class="container">
<nav class="navbar navbar-light bg-light border rounded-bottom"
style="--bs-border-color: #d6d6d6; --bs-border-radius: 0.25rem;">
<div class="container-fluid">
<a id="view.devicereg.apptitle"
class="navbar-brand text-secondary small"
href="index.html">
emiMobile
</a>
</div>
</nav>
<div class="row justify-content-center mt-4">
<div class="col-12 col-sm-10 col-md-8 col-lg-5 col-xl-4">
<div class="card shadow-sm">
<div class="card-header">
<h5 class="card-title mb-0 text-center">
Register This Device
</h5>
</div>
<div class="card-body">
<!-- Notification bar -->
<div id="view.devicereg.message"
class="alert alert-danger d-flex align-items-start d-none mb-3"
role="alert">
<span id="view.devicereg.message.label" class="me-auto"></span>
<button id="view.devicereg.message.button"
type="button"
class="btn-close ms-2"
aria-label="Close"></button>
</div>
<p class="text-muted small mb-3">
This browser has not been registered for emiMobile access.
Give the device a recognisable name, then click <strong>Register</strong>.
Your browser will prompt you to verify with a PIN, fingerprint, or security key.
An administrator can revoke access for any registered device at any time.
</p>
<div class="mb-3">
<label class="form-label small text-muted">Device name</label>
<input id="view.devicereg.edtdevicename"
class="form-control"
type="text"
placeholder="e.g. Dispatch Console, Patrol Laptop"
autofocus>
</div>
<div class="mb-3">
<p class="text-muted small mb-1">Browser</p>
<p id="view.devicereg.useragent"
class="text-muted small text-truncate"
style="max-width:100%; overflow:hidden; white-space:nowrap;"></p>
</div>
<button id="view.devicereg.btnregister"
class="btn btn-primary w-100">
Register This Device
</button>
</div>
<div class="card-footer text-muted small">
Registration is required once per browser. Clearing browser storage will require re-registration.
</div>
</div>
</div>
</div>
</div>
webEMIMobile/View.DeviceRegistration.pas 0 → 100644
unit View.DeviceRegistration;
interface
uses
System.SysUtils, System.Classes, WEBLib.Graphics, WEBLib.Controls, WEBLib.Forms, WEBLib.Dialogs,
Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls, WEBLib.JSON,
JS, XData.Web.Connection, WEBLib.ExtCtrls,
App.Types, ConnectionModule, XData.Web.Client;
type
TFViewDeviceRegistration = class(TWebForm)
edtDeviceName: TWebEdit;
btnRegister: TWebButton;
pnlMessage: TWebPanel;
lblMessage: TWebLabel;
btnCloseNotification: TWebButton;
XDataWebClient: TXDataWebClient;
procedure btnRegisterClick(Sender: TObject);
procedure btnCloseNotificationClick(Sender: TObject);
procedure WebFormCreate(Sender: TObject);
private
FRegistrationProc: TSuccessProc;
procedure ShowNotification(const AMsg: string; AIsError: Boolean = True);
procedure HideNotification;
procedure SetBusy(ABusy: Boolean);
procedure DoWebAuthnCreate(ADeviceName, AChallenge, AChallengeToken: string);
public
class procedure Display(ARegistrationProc: TSuccessProc);
end;
var
FViewDeviceRegistration: TFViewDeviceRegistration;
implementation
uses
Auth.Service,
View.ErrorPage;
{$R *.dfm}
class procedure TFViewDeviceRegistration.Display(ARegistrationProc: TSuccessProc);
begin
if Assigned(FViewDeviceRegistration) then
FViewDeviceRegistration.Free;
FViewDeviceRegistration := TFViewDeviceRegistration.CreateNew;
FViewDeviceRegistration.FRegistrationProc := ARegistrationProc;
end;
procedure TFViewDeviceRegistration.WebFormCreate(Sender: TObject);
var
userAgent: string;
begin
HideNotification;
userAgent := '';
asm
userAgent = navigator.userAgent;
end;
asm
var el = document.getElementById('view.devicereg.useragent');
if (el) el.textContent = userAgent;
end;
end;
procedure TFViewDeviceRegistration.SetBusy(ABusy: Boolean);
begin
asm
var btn = document.getElementById('view.devicereg.btnregister');
if (btn) {
btn.disabled = ABusy;
btn.textContent = ABusy ? 'Waiting for authenticator...' : 'Register This Device';
}
end;
end;
procedure TFViewDeviceRegistration.btnRegisterClick(Sender: TObject);
var
deviceName: string;
procedure OnBeginOK(AChallenge, AChallengeToken: string);
begin
DoWebAuthnCreate(deviceName, AChallenge, AChallengeToken);
end;
procedure OnBeginError(AMsg: string);
begin
SetBusy(False);
ShowNotification(AMsg);
end;
begin
deviceName := Trim(edtDeviceName.Text);
if deviceName = '' then
deviceName := 'Unnamed Device';
SetBusy(True);
HideNotification;
AuthService.BeginRegistration(deviceName, @OnBeginOK, @OnBeginError);
end;
procedure TFViewDeviceRegistration.DoWebAuthnCreate(
ADeviceName, AChallenge, AChallengeToken: string);
var
deviceName, challenge, challengeToken: string;
procedure OnCompleteOK;
begin
// Registration complete — proceed to login
FRegistrationProc;
end;
procedure OnCompleteError(AMsg: string);
begin
SetBusy(False);
ShowNotification(AMsg);
end;
procedure OnCredential(ACredentialId, AAttestationObject, AClientDataJSON: string);
begin
AuthService.CompleteRegistration(
deviceName, ACredentialId, AAttestationObject, AClientDataJSON, challengeToken,
@OnCompleteOK, @OnCompleteError
);
end;
procedure OnWebAuthnError(AMsg: string);
begin
SetBusy(False);
ShowNotification(AMsg);
end;
begin
deviceName := ADeviceName;
challenge := AChallenge;
challengeToken := AChallengeToken;
// Call navigator.credentials.create() via WebAuthn API
asm
(function() {
// Decode base64url challenge to Uint8Array
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;
}
// Encode ArrayBuffer to base64url
function arrToB64url(buf) {
var bin = String.fromCharCode.apply(null, new Uint8Array(buf));
return btoa(bin).replace(/\+/g, '-').replace(/\//g, '_').replace(/=/g, '');
}
// Random 16-byte user handle (not linked to user identity for platform keys)
var userId = new Uint8Array(16);
crypto.getRandomValues(userId);
navigator.credentials.create({
publicKey: {
challenge: b64urlToArr(challenge),
rp: { id: window.location.hostname, name: 'emiMobile' },
user: { id: userId, name: 'emimobile-user', displayName: 'emiMobile User' },
pubKeyCredParams: [{ alg: -7, type: 'public-key' }],
timeout: 60000,
attestation: 'none',
authenticatorSelection: {
userVerification: 'required',
residentKey: 'preferred'
}
}
}).then(function(cred) {
var credId = arrToB64url(cred.rawId);
var attObj = arrToB64url(cred.response.attestationObject);
var cdJson = arrToB64url(cred.response.clientDataJSON);
OnCredential(credId, attObj, cdJson);
}).catch(function(err) {
OnWebAuthnError('WebAuthn error: ' + err.message);
});
})();
end;
end;
procedure TFViewDeviceRegistration.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
end;
procedure TFViewDeviceRegistration.ShowNotification(const AMsg: string; AIsError: Boolean);
begin
if AMsg <> '' then
begin
lblMessage.Caption := AMsg;
asm
var el = document.getElementById('view.devicereg.message');
if (el) {
el.classList.remove('alert-danger', 'alert-warning');
el.classList.add(AIsError ? 'alert-danger' : 'alert-warning');
el.classList.remove('d-none');
}
end;
end;
end;
procedure TFViewDeviceRegistration.HideNotification;
begin
asm
var el = document.getElementById('view.devicereg.message');
if (el) el.classList.add('d-none');
end;
end;
end.
webEMIMobile/View.Login.pas
......@@ -28,6 +28,9 @@ type
procedure ShowNotification(Notification: string);
procedure HideNotification;
procedure GetAgencyConfigList;
procedure SetBusy(ABusy: Boolean);
procedure DoWebAuthnGet(AUser, APassword, AAgency, ACredentialId,
AChallenge, AChallengeToken: string);
public
class procedure Display(LoginProc: TSuccessProc); overload;
class procedure Display(LoginProc: TSuccessProc; AMsg: string); overload;
......@@ -63,46 +66,147 @@ begin
FViewLogin.FLoginProc := LoginProc;
end;
procedure TFViewLogin.WebFormCreate(Sender: TObject);
begin
// lblAppTitle.Caption := 'EM Systems - webCharms App ver 0.9.2.22';
GetAgencyConfigList();
GetAgencyConfigList;
if FMessage <> '' then
ShowNotification(FMessage)
else
HideNotification;
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 LoginSuccess;
procedure OnBeginOK(AChallenge, AChallengeToken: string);
begin
FLoginProc;
DoWebAuthnGet(user, password, agency, credentialId, AChallenge, AChallengeToken);
end;
procedure LoginError(AMsg: string);
procedure OnBeginError(AMsg: string);
begin
SetBusy(False);
ShowNotification('Login Error: ' + AMsg);
end;
begin
AuthService.Login(
edtUsername.Text, edtPassword.Text, lucbAgency.Value,
@LoginSuccess,
@LoginError
);
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;
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 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.GetAgencyConfigList;
procedure OnLoad(Response: TXDataClientResponse);
var
jsResponse: TJSObject;
count: Integer;
returned: Integer;
jsArray: TJSArray;
jsObject: TJSObject;
agency: string;
......@@ -110,17 +214,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']);
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;
......@@ -136,7 +237,6 @@ begin
);
end;
procedure TFViewLogin.ShowNotification(Notification: string);
begin
if Notification <> '' then
......@@ -146,13 +246,11 @@ begin
end;
end;
procedure TFViewLogin.HideNotification;
begin
pnlMessage.ElementHandle.hidden := True;
end;
procedure TFViewLogin.btnCloseNotificationClick(Sender: TObject);
begin
HideNotification;
......
webEMIMobile/View.Main.dfm
......@@ -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
......
webEMIMobile/View.Main.html
......@@ -15,6 +15,7 @@
<div class="d-flex align-items-center gap-2 ms-auto">
<span id="view.main.lblconnection" class="navbar-text text-light small"></span>
<button id="btn_devices" type="button" class="btn btn-outline-light btn-sm d-none">Devices</button>
<button id="btn_logout" type="button" class="btn btn-outline-light btn-sm">Logout</button>
</div>
</div>
......
webEMIMobile/View.Main.pas
......@@ -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;
......@@ -110,6 +112,7 @@ uses
View.EditUser,
View.UnitDetails,
View.ComplaintArchive,
View.DeviceManager,
Utils;
{$R *.dfm}
......@@ -134,8 +137,17 @@ begin
FUnitsRefreshTick := 0;
FComplaintsRefreshTick := 0;
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');
......@@ -278,6 +290,11 @@ begin
FLogoutProc;
end;
procedure TFViewMain.btnDevicesClick(Sender: TObject);
begin
ShowForm(TFViewDeviceManager);
end;
procedure TFViewMain.btnMapClick(Sender: TObject);
begin
ShowForm(TFViewMap);
......
webEMIMobile/webEmiMobile.dpr
......@@ -28,11 +28,14 @@ uses
uMapFilters in 'uMapFilters.pas',
View.ComplaintArchive in 'View.ComplaintArchive.pas' {FViewComplaintArchive: TWebForm} {*.html},
uMapMarkerJs in 'uMapMarkerJs.pas',
Module.Websocket in 'Module.Websocket.pas' {dmWebsocket: TDataModule};
Module.Websocket in 'Module.Websocket.pas' {dmWebsocket: TDataModule},
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;
......@@ -59,6 +62,22 @@ begin
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);
......@@ -71,6 +90,14 @@ begin
begin
if Success then
begin
// 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
......
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