69fb2b10dd
username is no longer stored cleartext. New columns username_enc/username_iv (AES-GCM under the vault key, same as encrypted_password). Search/sort/render stay client-side, so the field is decrypted at loadEntries into e.username in memory — everything downstream is unchanged. Full-strength random-IV AES-GCM (no searchable/deterministic encryption) precisely because search is client-side. Server (PM.Handler.Entries / .Auth / PM.Database): - Schema: vault_entries.username_enc, username_iv. - GET returns them; POST/PUT/bulk-import read + persist them; master-pw rotation re-encrypts them under the new key (UPDATE + loop). - ?q= server search drops `username LIKE` (ciphertext won't match; frontend searches client-side anyway). Client (app.js / app.import.js): - loadEntries/loadTrash decrypt username_enc → e.username (fallback to cleartext for un-migrated rows). - withEncryptedUsername(obj): write choke point — encrypts obj.username into username_enc/username_iv and blanks the cleartext. Wraps every POST/PUT body: saveEntry, soSave, duplicateEntry, moveEntryToFolder, addTagToEntry, batchMove/AddTag, encryptImportEntry (import + sync-apply). - doChangeMasterPassword re-encrypts username under the new key. - migrateUsernamesAtRest(): one-time sweep at enterApp, PUT-re-ships rows that still carry cleartext username so the DB gets scrubbed (bumps updated_at once; plaintext unchanged so devices converge). site/title/tags stay cleartext (same pattern later — see memory note). +1 merge test (username encrypted on import). 65/65. NOT compiled/tested at runtime (Delphi) — large multi-handler change; rebuild BuildAssets + PMServer and test create/edit/rotate/import/sync + verify the DB shows no cleartext username. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
1240 lines
46 KiB
ObjectPascal
1240 lines
46 KiB
ObjectPascal
unit PM.Handler.Auth;
|
|
|
|
(*
|
|
/register POST body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
|
|
/login POST body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
|
|
/logout POST auth + csrf -> {message}
|
|
/reauth POST auth + csrf + body{masterPassword} -> {message}
|
|
|
|
Hashing strategy:
|
|
- Delphi creates new accounts with PBKDF2-SHA256 100k iterations (hash_algo='pbkdf2'),
|
|
same format as PHP hash_pbkdf2. PHP can verify these too.
|
|
- For login, we read hash_algo:
|
|
pbkdf2 -> verify natively
|
|
bcrypt -> reject with clear message (bcrypt verify not implemented yet)
|
|
*)
|
|
|
|
interface
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils, System.JSON, System.Classes, System.Generics.Collections,
|
|
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
|
|
IdCustomHTTPServer,
|
|
PM.Router, PM.JSON, PM.Database, PM.Crypto,
|
|
PM.Session, PM.RateLimit, PM.Audit;
|
|
|
|
const
|
|
// Legacy iteration count from the initial 2025 release. Kept around to
|
|
// verify pre-migration login attempts (each user row records its own
|
|
// value in users.kdf_iterations). New code paths should reference
|
|
// PBKDF2_ITERATIONS_TARGET instead.
|
|
PBKDF2_ITERATIONS = 100000;
|
|
// Current target. New accounts hash at this strength; legacy accounts
|
|
// are transparently upgraded at next login (see HandleLogin/HandleReauth).
|
|
// Value picked per OWASP 2023 PBKDF2-SHA256 recommendation.
|
|
PBKDF2_ITERATIONS_TARGET = 600000;
|
|
|
|
// ---- Hash algorithm markers (users.hash_algo) ----
|
|
// 'pbkdf2' : LEGACY. Stored hash = PBKDF2(pw, salt, iters) raw hex.
|
|
// Catastrophic at rest: those same bytes ARE the AES
|
|
// key the client uses to encrypt entries. A stolen
|
|
// vault.db hands the attacker the key directly.
|
|
// 'pbkdf2-sha256' : CURRENT. Stored hash = SHA256(PBKDF2(pw, salt, iters)).
|
|
// One-way wrap. vault.db at rest no longer contains
|
|
// the AES key. Server still sees pw transiently
|
|
// during /login to compute the comparison.
|
|
HASH_ALGO_LEGACY = 'pbkdf2';
|
|
HASH_ALGO_CURRENT = 'pbkdf2-sha256';
|
|
// 'pbkdf2-sha256-v2' : DECOUPLED. Same stored form as CURRENT
|
|
// (SHA256 of the client verifier), but the client's transmitted
|
|
// verifier is now SHA256(keyHex + domain) instead of keyHex — so the
|
|
// /login body no longer carries the raw AES vault key. Used by new
|
|
// registrations and by every master-pw change. Existing accounts stay
|
|
// on their current algo until they rotate (no forced migration).
|
|
// Verification is identical to CURRENT (VerifierToStoredHash wraps any
|
|
// non-legacy verifier in SHA256), so no new verify branch is needed.
|
|
HASH_ALGO_DECOUPLED = 'pbkdf2-sha256-v2';
|
|
// 'argon2id-v2' : DECOUPLED verifier (same SHA256 wrap as -sha256-v2), but
|
|
// the CLIENT derives the key with Argon2id (memory-hard) instead of
|
|
// PBKDF2. The server NEVER runs Argon2 — it only stores/echoes the params
|
|
// (argon2_m/t/p) so the client knows how to derive, and SHA256-wraps the
|
|
// 64-hex verifier exactly as for any other -v2 scheme. New registrations
|
|
// and master-pw changes land here; existing accounts stay on their algo
|
|
// until they rotate. Verify path is unchanged (VerifierToStoredHash).
|
|
HASH_ALGO_ARGON2 = 'argon2id-v2';
|
|
|
|
// Argon2 parameter sanity bounds — reject client-supplied params outside
|
|
// these so a hostile/buggy client can't set a 1-iteration or multi-GiB KDF.
|
|
ARGON2_M_MIN = 8; // KiB
|
|
ARGON2_M_MAX = 1048576; // 1 GiB
|
|
ARGON2_T_MIN = 1;
|
|
ARGON2_T_MAX = 16;
|
|
ARGON2_P_MIN = 1;
|
|
ARGON2_P_MAX = 16;
|
|
|
|
DEFAULT_FOLDERS: array[0..4] of string = ('All', 'Social', 'Banking', 'Work', 'Personal');
|
|
|
|
type
|
|
TArgon2Params = record
|
|
M, T, P: Integer;
|
|
Valid: Boolean; // True only when all three are within bounds
|
|
end;
|
|
|
|
// Read + bounds-check the optional {argon2:{m,t,p}} object from a request
|
|
// body. Valid=False when the object is absent or any field is out of range.
|
|
function ReadArgon2Params(ABody: TJSONObject): TArgon2Params;
|
|
var
|
|
LArg: TJSONObject;
|
|
begin
|
|
Result.M := 0; Result.T := 0; Result.P := 0; Result.Valid := False;
|
|
LArg := ABody.GetValue<TJSONObject>('argon2'); // nil when absent
|
|
if LArg = nil then Exit;
|
|
Result.M := LArg.GetValue<Integer>('m', 0);
|
|
Result.T := LArg.GetValue<Integer>('t', 0);
|
|
Result.P := LArg.GetValue<Integer>('p', 0);
|
|
Result.Valid :=
|
|
(Result.M >= ARGON2_M_MIN) and (Result.M <= ARGON2_M_MAX) and
|
|
(Result.T >= ARGON2_T_MIN) and (Result.T <= ARGON2_T_MAX) and
|
|
(Result.P >= ARGON2_P_MIN) and (Result.P <= ARGON2_P_MAX);
|
|
end;
|
|
|
|
// Attach an {argon2:{m,t,p}} object to a response when the params are set
|
|
// (m>0). No-op for PBKDF2 accounts so their responses are byte-identical.
|
|
procedure AppendArgon2Params(AObj: TJSONObject; AM, AT, AP: Integer);
|
|
var
|
|
LArg: TJSONObject;
|
|
begin
|
|
if AM <= 0 then Exit;
|
|
LArg := TJSONObject.Create;
|
|
LArg.AddPair('m', TJSONNumber.Create(AM));
|
|
LArg.AddPair('t', TJSONNumber.Create(AT));
|
|
LArg.AddPair('p', TJSONNumber.Create(AP));
|
|
AObj.AddPair('argon2', LArg);
|
|
end;
|
|
|
|
// Auth-hash computation for the current scheme. Wraps PBKDF2 output in
|
|
// SHA-256 so the stored value is no longer usable as the AES decryption
|
|
// key. Use this everywhere we write or verify a hash under
|
|
// HASH_ALGO_CURRENT — register, login, reauth, and migrate-kdf all
|
|
// go through here for consistency.
|
|
function ComputeAuthHashCurrent(const APwd, ASalt: string; AIters: Integer): string;
|
|
begin
|
|
Result := SHA256Hex(PBKDF2_SHA256_Hex(APwd, ASalt, AIters));
|
|
end;
|
|
|
|
// ===== Zero-knowledge verifier path ==========================================
|
|
// In the verifier flow the CLIENT computes PBKDF2(pw, salt, iters) and sends
|
|
// the resulting hex (the "verifier") instead of the plaintext master pw. The
|
|
// server then either:
|
|
// - hashes the verifier with SHA-256 and compares to stored (CURRENT algo)
|
|
// - compares the verifier directly to stored (LEGACY algo, where the
|
|
// stored value IS the PBKDF2 hex)
|
|
// Either way the server never sees the master pw plaintext.
|
|
//
|
|
// IsValidVerifier guards against malformed input — accept only lowercase or
|
|
// uppercase hex of 64 chars (32 bytes of PBKDF2-SHA-256 output).
|
|
function IsValidVerifier(const AVerifier: string): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
if Length(AVerifier) <> 64 then Exit;
|
|
for I := 1 to 64 do
|
|
if not CharInSet(AVerifier[I], ['0'..'9', 'a'..'f', 'A'..'F']) then Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
// Returns the stored-hash representation of a verifier under a given algo.
|
|
// Useful for both verification (compare to stored) and persistence (write
|
|
// after a successful pw change).
|
|
function VerifierToStoredHash(const AVerifier, AAlgo: string): string;
|
|
begin
|
|
if SameText(AAlgo, HASH_ALGO_LEGACY) then
|
|
Result := AVerifier // legacy stores PBKDF2 hex directly
|
|
else
|
|
Result := SHA256Hex(AVerifier);
|
|
end;
|
|
|
|
// Constant-time verifier check. Returns False if the verifier is malformed
|
|
// or the algo string is unsupported, otherwise compares per-algo.
|
|
function CheckVerifier(const AVerifier, AStoredHash, AAlgo: string): Boolean;
|
|
begin
|
|
Result := False;
|
|
if not IsValidVerifier(AVerifier) then Exit;
|
|
Result := ConstantTimeEquals(VerifierToStoredHash(AVerifier, AAlgo), AStoredHash);
|
|
end;
|
|
|
|
procedure EnsureDefaultFolders(AUserId: Integer);
|
|
var
|
|
LQ: TFDQuery;
|
|
I: Integer;
|
|
begin
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'INSERT OR IGNORE INTO folders (user_id, name) VALUES (:uid, :name)';
|
|
for I := Low(DEFAULT_FOLDERS) to High(DEFAULT_FOLDERS) do
|
|
begin
|
|
LQ.ParamByName('uid').AsInteger := AUserId;
|
|
LQ.ParamByName('name').AsString := DEFAULT_FOLDERS[I];
|
|
LQ.ExecSQL;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure SendAuthSuccess(AResponse: TIdHTTPResponseInfo;
|
|
AUserId: Integer; const AToken, ASalt, ACSRFToken: string;
|
|
AKdfIterations: Integer; ANeedsMigration: Boolean);
|
|
var
|
|
LObj, LMig: TJSONObject;
|
|
begin
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('message', 'OK');
|
|
LObj.AddPair('token', AToken);
|
|
LObj.AddPair('userId', TJSONNumber.Create(AUserId));
|
|
LObj.AddPair('salt', ASalt);
|
|
LObj.AddPair('csrfToken', ACSRFToken);
|
|
// kdfIterations is the iteration count the client must use when deriving
|
|
// the AES-GCM key for THIS session — matches the count under which the
|
|
// existing entries are encrypted. If the server signals migration, the
|
|
// client should re-encrypt with the new target and call /migrate-kdf.
|
|
LObj.AddPair('kdfIterations', TJSONNumber.Create(AKdfIterations));
|
|
if ANeedsMigration then
|
|
begin
|
|
LMig := TJSONObject.Create;
|
|
LMig.AddPair('target', TJSONNumber.Create(PBKDF2_ITERATIONS_TARGET));
|
|
LObj.AddPair('kdfMigration', LMig);
|
|
end;
|
|
TJSONHelper.SendJSON(AResponse, LObj);
|
|
end;
|
|
|
|
// ===== /register =============================================================
|
|
|
|
procedure HandleRegister(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LBody: TJSONObject;
|
|
LUser, LPwd, LVerifier, LSalt, LHash, LToken, LCSRF, LIP, LReqAlgo: string;
|
|
LKdfIters: Integer;
|
|
LArgon: TArgon2Params;
|
|
LQ: TFDQuery;
|
|
LUserId: Integer;
|
|
begin
|
|
LIP := GetClientIP(ARequest);
|
|
if CheckRateLimit(LIP) >= 5 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
|
|
Exit;
|
|
end;
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LUser := Trim(LBody.GetValue<string>('username', ''));
|
|
LPwd := LBody.GetValue<string>('masterPassword', '');
|
|
// Zero-knowledge register: client generates the salt + verifier locally
|
|
// so the master pw never leaves the client. Optional — clients that
|
|
// still send masterPassword get the legacy server-side derivation.
|
|
LVerifier := LBody.GetValue<string>('verifier', '');
|
|
LSalt := LBody.GetValue<string>('salt', '');
|
|
LKdfIters := LBody.GetValue<Integer>('kdfIterations', PBKDF2_ITERATIONS_TARGET);
|
|
// Optional: client declares an Argon2id KDF. hashAlgo='argon2id-v2' +
|
|
// argon2:{m,t,p}. Absent → defaults to the PBKDF2 decoupled scheme.
|
|
LReqAlgo := LBody.GetValue<string>('hashAlgo', '');
|
|
LArgon := ReadArgon2Params(LBody);
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
// Username length always required. Master pw length only matters when the
|
|
// client is sending plaintext — under the verifier flow the server has no
|
|
// way to check pw length (it never sees it), so we trust the client to
|
|
// enforce client-side.
|
|
if Length(LUser) < 3 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Username min 3 chars');
|
|
Exit;
|
|
end;
|
|
if (LVerifier = '') and (Length(LPwd) < 8) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Master password min 8 chars');
|
|
Exit;
|
|
end;
|
|
if (LVerifier <> '') and (not IsValidVerifier(LVerifier)) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Malformed verifier');
|
|
Exit;
|
|
end;
|
|
if (LVerifier <> '') and (Length(LSalt) <> 64) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400,
|
|
'Client-supplied salt must be 64 hex chars');
|
|
Exit;
|
|
end;
|
|
if (LVerifier <> '') and ((LKdfIters < 100000) or (LKdfIters > 5000000)) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400,
|
|
'kdfIterations out of allowed range');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text := 'SELECT id FROM users WHERE username = :u';
|
|
LQ.ParamByName('u').AsString := LUser;
|
|
LQ.Open;
|
|
if not LQ.IsEmpty then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 409, 'Username exists');
|
|
Exit;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
// New ZK registrations land on the DECOUPLED scheme; the plaintext
|
|
// fallback (legacy clients) stays on CURRENT. VerifierToStoredHash
|
|
// wraps both the same way (SHA256), so only the stored algo LABEL
|
|
// differs — it's what tells the client which verifier formula to use.
|
|
var LRegAlgo := HASH_ALGO_CURRENT;
|
|
// argon2_m/t/p persisted only for Argon2id accounts; 0 = PBKDF2.
|
|
var LArgM := 0; var LArgT := 0; var LArgP := 0;
|
|
if LVerifier <> '' then
|
|
begin
|
|
// ZK path: use the client-supplied salt + iters + verifier as-is.
|
|
// If the client declared Argon2id (with valid params), land on that
|
|
// scheme and record the params; otherwise the PBKDF2 decoupled scheme.
|
|
if SameText(LReqAlgo, HASH_ALGO_ARGON2) and LArgon.Valid then
|
|
begin
|
|
LRegAlgo := HASH_ALGO_ARGON2;
|
|
LArgM := LArgon.M; LArgT := LArgon.T; LArgP := LArgon.P;
|
|
end
|
|
else
|
|
LRegAlgo := HASH_ALGO_DECOUPLED;
|
|
LHash := VerifierToStoredHash(LVerifier, LRegAlgo);
|
|
end
|
|
else
|
|
begin
|
|
// Legacy plaintext path: server generates salt + derives.
|
|
LSalt := RandomHex(32);
|
|
LKdfIters := PBKDF2_ITERATIONS_TARGET;
|
|
LHash := ComputeAuthHashCurrent(LPwd, LSalt, LKdfIters);
|
|
end;
|
|
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'INSERT INTO users (username, password_hash, salt, hash_algo, kdf_iterations, ' +
|
|
' argon2_m, argon2_t, argon2_p) ' +
|
|
'VALUES (:u, :h, :s, :algo, :it, :am, :at, :ap)';
|
|
LQ.ParamByName('algo').AsString := LRegAlgo;
|
|
LQ.ParamByName('u').AsString := LUser;
|
|
LQ.ParamByName('h').AsString := LHash;
|
|
LQ.ParamByName('s').AsString := LSalt;
|
|
LQ.ParamByName('it').AsInteger := LKdfIters;
|
|
LQ.ParamByName('am').AsInteger := LArgM;
|
|
LQ.ParamByName('at').AsInteger := LArgT;
|
|
LQ.ParamByName('ap').AsInteger := LArgP;
|
|
LQ.ExecSQL;
|
|
LUserId := DB.Connection.GetLastAutoGenValue('users');
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
EnsureDefaultFolders(LUserId);
|
|
CreateSession(LUserId, LToken, LCSRF);
|
|
LogAudit(LUserId, 'register', LIP);
|
|
// No migration ever needed for fresh accounts.
|
|
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF, LKdfIters, False);
|
|
end;
|
|
|
|
// ===== /login ================================================================
|
|
|
|
procedure HandleLogin(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LBody: TJSONObject;
|
|
LUser, LPwd, LVerifier, LSalt, LStoredHash, LAlgo, LToken, LCSRF, LIP: string;
|
|
LUserId, LKdfIters: Integer;
|
|
LQ: TFDQuery;
|
|
LComputed: string;
|
|
LValid: Boolean;
|
|
begin
|
|
LIP := GetClientIP(ARequest);
|
|
if CheckRateLimit(LIP) >= 10 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
|
|
Exit;
|
|
end;
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LUser := Trim(LBody.GetValue<string>('username', ''));
|
|
LPwd := LBody.GetValue<string>('masterPassword', '');
|
|
LVerifier := LBody.GetValue<string>('verifier', '');
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
// Per-username lockout check — runs BEFORE touching the users table, so
|
|
// attackers can't probe account existence via timing differences between
|
|
// "locked" and "not found" responses.
|
|
if RejectIfAccountLocked(AResponse, LUser) then Exit;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT id, password_hash, salt, hash_algo, kdf_iterations ' +
|
|
'FROM users WHERE username = :u';
|
|
LQ.ParamByName('u').AsString := LUser;
|
|
LQ.Open;
|
|
if LQ.IsEmpty then
|
|
begin
|
|
// Unknown username — still record the failure against this username
|
|
// so attackers can't enumerate accounts by observing which usernames
|
|
// can be locked vs not. TCriticalSection is reentrant for the same
|
|
// thread, so calling RecordAttempt/RecordFailedAccountAttempt from
|
|
// inside our DB.Lock block is safe (they re-acquire the same lock).
|
|
RecordAttempt(LIP);
|
|
RecordFailedAccountAttempt(LUser, LIP);
|
|
TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
|
|
Exit;
|
|
end;
|
|
LUserId := LQ.FieldByName('id').AsInteger;
|
|
LStoredHash := LQ.FieldByName('password_hash').AsString;
|
|
LSalt := LQ.FieldByName('salt').AsString;
|
|
LAlgo := LQ.FieldByName('hash_algo').AsString;
|
|
LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger;
|
|
if LAlgo = '' then LAlgo := 'pbkdf2';
|
|
// Legacy rows predating the kdf_iterations column have NULL → 0 here;
|
|
// treat as the original 100k value used by api.php and early Delphi.
|
|
if LKdfIters <= 0 then LKdfIters := PBKDF2_ITERATIONS;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
LValid := False;
|
|
if LVerifier <> '' then
|
|
begin
|
|
// Zero-knowledge path: client already computed PBKDF2(pw, salt, iters)
|
|
// and sent us the hex. Server only does the SHA-256 wrap (CURRENT) or
|
|
// direct compare (LEGACY). Master pw never leaves the client.
|
|
LValid := CheckVerifier(LVerifier, LStoredHash, LAlgo);
|
|
end
|
|
else if SameText(LAlgo, HASH_ALGO_LEGACY) then
|
|
begin
|
|
// Legacy plaintext path: stored hash is raw PBKDF2 hex (= AES key bytes).
|
|
// Verify by direct comparison. Kept for compatibility with any client
|
|
// that hasn't been upgraded to send a verifier yet.
|
|
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, LKdfIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end
|
|
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
|
|
begin
|
|
// Current plaintext path: stored hash is SHA-256 of the PBKDF2 output.
|
|
LComputed := ComputeAuthHashCurrent(LPwd, LSalt, LKdfIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end
|
|
else if SameText(LAlgo, 'bcrypt') then
|
|
begin
|
|
// Not implemented in Delphi backend yet
|
|
RecordAttempt(LIP);
|
|
RecordFailedAccountAttempt(LUser, LIP);
|
|
LogAudit(LUserId, 'failed_login_bcrypt', LIP);
|
|
TJSONHelper.SendError(AResponse, 501,
|
|
'This account was created with bcrypt (PHP). The Delphi backend does ' +
|
|
'not verify bcrypt yet. Register a new account here, or login via PHP.');
|
|
Exit;
|
|
end;
|
|
|
|
if not LValid then
|
|
begin
|
|
RecordAttempt(LIP);
|
|
RecordFailedAccountAttempt(LUser, LIP);
|
|
LogAudit(LUserId, 'failed_login', LIP);
|
|
TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
|
|
Exit;
|
|
end;
|
|
|
|
ClearAttempts(LIP);
|
|
ClearAccountLockout(LUser);
|
|
DeleteAllUserSessions(LUserId);
|
|
EnsureDefaultFolders(LUserId);
|
|
CreateSession(LUserId, LToken, LCSRF);
|
|
LogAudit(LUserId, 'login', LIP);
|
|
// Signal migration whenever EITHER:
|
|
// - the user's iteration count is below the target (KDF bump needed), OR
|
|
// - the user is on the LEGACY 'pbkdf2' scheme (stored hash = raw key hex;
|
|
// upgrade to SHA256-wrapped to remove the AES-key-in-vault.db flaw).
|
|
// NOTE: we deliberately do NOT signal for 'pbkdf2-sha256' or the newer
|
|
// 'pbkdf2-sha256-v2' (decoupled) — those are already SHA256-wrapped at
|
|
// rest, and forcing sha256 → v2 is out of scope (v2 is adopted only on
|
|
// register / master-pw change, never force-migrated at login).
|
|
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF, LKdfIters,
|
|
(LKdfIters < PBKDF2_ITERATIONS_TARGET) or
|
|
SameText(LAlgo, HASH_ALGO_LEGACY));
|
|
end;
|
|
|
|
// ===== /logout ===============================================================
|
|
|
|
procedure HandleLogout(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId: Integer;
|
|
LToken, LAuth: string;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LAuth := ARequest.RawHeaders.Values['Authorization'];
|
|
if LAuth.StartsWith('Bearer ', True) then
|
|
begin
|
|
LToken := Copy(LAuth, 8, MaxInt);
|
|
DeleteSessionByTokenHash(SHA256Hex(LToken));
|
|
end;
|
|
|
|
LogAudit(LUserId, 'logout', GetClientIP(ARequest));
|
|
TJSONHelper.SendOK(AResponse, 'Logged out');
|
|
end;
|
|
|
|
// ===== /reauth ===============================================================
|
|
|
|
procedure HandleReauth(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId, LKdfIters: Integer;
|
|
LBody: TJSONObject;
|
|
LUser, LPwd, LVerifier, LStoredHash, LSalt, LAlgo, LIP, LComputed: string;
|
|
LQ: TFDQuery;
|
|
LValid: Boolean;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LIP := GetClientIP(ARequest);
|
|
if CheckRateLimit(LIP) >= 5 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
|
|
Exit;
|
|
end;
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LPwd := LBody.GetValue<string>('masterPassword', '');
|
|
LVerifier := LBody.GetValue<string>('verifier', '');
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
// Pull username too — needed for the per-account lockout calls.
|
|
LQ.SQL.Text :=
|
|
'SELECT username, password_hash, salt, hash_algo, kdf_iterations ' +
|
|
'FROM users WHERE id = :uid';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.Open;
|
|
if LQ.IsEmpty then
|
|
begin
|
|
RecordAttempt(LIP);
|
|
TJSONHelper.SendError(AResponse, 401, 'User not found');
|
|
Exit;
|
|
end;
|
|
LUser := LQ.FieldByName('username').AsString;
|
|
LStoredHash := LQ.FieldByName('password_hash').AsString;
|
|
LSalt := LQ.FieldByName('salt').AsString;
|
|
LAlgo := LQ.FieldByName('hash_algo').AsString;
|
|
LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger;
|
|
if LAlgo = '' then LAlgo := 'pbkdf2';
|
|
if LKdfIters <= 0 then LKdfIters := PBKDF2_ITERATIONS;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
// Check account lockout AFTER we have the username. Even though the user
|
|
// is already authenticated by their session token, the master-pw re-prompt
|
|
// is itself brute-forceable (e.g. attacker hijacked a session and now tries
|
|
// to escalate by guessing the master pw to unlock the JS crypto key).
|
|
if RejectIfAccountLocked(AResponse, LUser) then Exit;
|
|
|
|
LValid := False;
|
|
if LVerifier <> '' then
|
|
LValid := CheckVerifier(LVerifier, LStoredHash, LAlgo)
|
|
else if SameText(LAlgo, HASH_ALGO_LEGACY) then
|
|
begin
|
|
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, LKdfIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end
|
|
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
|
|
begin
|
|
LComputed := ComputeAuthHashCurrent(LPwd, LSalt, LKdfIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end;
|
|
|
|
if not LValid then
|
|
begin
|
|
RecordAttempt(LIP);
|
|
RecordFailedAccountAttempt(LUser, LIP);
|
|
LogAudit(LUserId, 'failed_reauth', LIP);
|
|
TJSONHelper.SendError(AResponse, 401, 'Invalid password');
|
|
Exit;
|
|
end;
|
|
|
|
ClearAttempts(LIP);
|
|
ClearAccountLockout(LUser);
|
|
LogAudit(LUserId, 'reauth', LIP);
|
|
|
|
// Return KDF state so the client can detect legacy accounts that haven't
|
|
// been migrated yet — unlock from a locked state goes through reauth, not
|
|
// login, so we need the same migration signaling here. Migration triggers
|
|
// on KDF iter mismatch OR hash format mismatch (same rule as HandleLogin).
|
|
begin
|
|
var LObj := TJSONObject.Create;
|
|
LObj.AddPair('message', 'OK');
|
|
LObj.AddPair('kdfIterations', TJSONNumber.Create(LKdfIters));
|
|
// Same rule as HandleLogin: only KDF-bump or LEGACY format triggers
|
|
// migration. sha256 / v2 accounts are left as-is (v2 must not be
|
|
// force-downgraded to sha256 by migrate-kdf).
|
|
if (LKdfIters < PBKDF2_ITERATIONS_TARGET) or
|
|
SameText(LAlgo, HASH_ALGO_LEGACY) then
|
|
begin
|
|
var LMig := TJSONObject.Create;
|
|
LMig.AddPair('target', TJSONNumber.Create(PBKDF2_ITERATIONS_TARGET));
|
|
LObj.AddPair('kdfMigration', LMig);
|
|
end;
|
|
TJSONHelper.SendJSON(AResponse, LObj);
|
|
end;
|
|
end;
|
|
|
|
// ===== /migrate-kdf ==========================================================
|
|
// Atomic transition from an old PBKDF2 iteration count to the current target.
|
|
// Client side: derive both old and new AES keys, decrypt each entry with old,
|
|
// re-encrypt with new, then POST the new ciphertext blob to this endpoint
|
|
// along with the master password (so we can recompute the new server hash).
|
|
// Server side: verify the master pw with the old hash, then in a single
|
|
// transaction: update users.password_hash to the new PBKDF2 output, set
|
|
// kdf_iterations to TARGET, and replace each entry's encrypted_password/iv.
|
|
// All-or-nothing: if anything fails, the user stays on the old config.
|
|
procedure HandleMigrateKdf(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId, LOldIters, I: Integer;
|
|
LBody, LEntry: TJSONObject;
|
|
LEntries: TJSONArray;
|
|
LUser, LPwd, LOldVerifier, LNewVerifier, LSalt, LStoredHash, LAlgo, LIP,
|
|
LComputed, LNewHash: string;
|
|
LQ: TFDQuery;
|
|
LValid: Boolean;
|
|
LEntryId: Integer;
|
|
LEncPwd, LIv: string;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LIP := GetClientIP(ARequest);
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LPwd := LBody.GetValue<string>('masterPassword', '');
|
|
// ZK path: client provides PBKDF2 hex at the OLD iter count (oldVerifier,
|
|
// for current-hash verification) AND at the new TARGET iter count
|
|
// (newVerifier, for the post-migration stored hash).
|
|
LOldVerifier := LBody.GetValue<string>('oldVerifier', '');
|
|
LNewVerifier := LBody.GetValue<string>('newVerifier', '');
|
|
LEntries := LBody.GetValue<TJSONArray>('entries');
|
|
if LEntries = nil then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Missing entries array');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
// Step 1: load current user state.
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT username, password_hash, salt, hash_algo, kdf_iterations ' +
|
|
'FROM users WHERE id = :uid';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.Open;
|
|
if LQ.IsEmpty then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 401, 'User not found');
|
|
Exit;
|
|
end;
|
|
LUser := LQ.FieldByName('username').AsString;
|
|
LStoredHash := LQ.FieldByName('password_hash').AsString;
|
|
LSalt := LQ.FieldByName('salt').AsString;
|
|
LAlgo := LQ.FieldByName('hash_algo').AsString;
|
|
LOldIters := LQ.FieldByName('kdf_iterations').AsInteger;
|
|
if LAlgo = '' then LAlgo := 'pbkdf2';
|
|
if LOldIters <= 0 then LOldIters := PBKDF2_ITERATIONS;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
// Idempotency: nothing to do if BOTH iter count is at target AND
|
|
// hash format is current. Previously we short-circuited on iter
|
|
// count alone, which would have skipped the hash-format upgrade for
|
|
// users who migrated KDF before this commit landed.
|
|
if (LOldIters >= PBKDF2_ITERATIONS_TARGET) and
|
|
SameText(LAlgo, HASH_ALGO_CURRENT) then
|
|
begin
|
|
TJSONHelper.SendOK(AResponse, 'Already at target');
|
|
Exit;
|
|
end;
|
|
|
|
// Step 2: verify the master pw against the CURRENT (old) hash. Prefer
|
|
// the ZK verifier path; fall back to plaintext for legacy clients.
|
|
LValid := False;
|
|
if LOldVerifier <> '' then
|
|
LValid := CheckVerifier(LOldVerifier, LStoredHash, LAlgo)
|
|
else if SameText(LAlgo, HASH_ALGO_LEGACY) then
|
|
begin
|
|
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, LOldIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end
|
|
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
|
|
begin
|
|
LComputed := ComputeAuthHashCurrent(LPwd, LSalt, LOldIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end;
|
|
if not LValid then
|
|
begin
|
|
RecordFailedAccountAttempt(LUser, LIP);
|
|
LogAudit(LUserId, 'failed_migrate_kdf', LIP);
|
|
TJSONHelper.SendError(AResponse, 401, 'Invalid password');
|
|
Exit;
|
|
end;
|
|
|
|
// Step 3: compute the new password hash under the current scheme
|
|
// (SHA-256 wrap) at the target iter count. ZK path takes the
|
|
// newVerifier (PBKDF2 at the target iters, computed client-side) and
|
|
// just wraps it; plaintext path runs PBKDF2 server-side.
|
|
if LNewVerifier <> '' then
|
|
begin
|
|
if not IsValidVerifier(LNewVerifier) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Malformed newVerifier');
|
|
Exit;
|
|
end;
|
|
LNewHash := VerifierToStoredHash(LNewVerifier, HASH_ALGO_CURRENT);
|
|
end
|
|
else
|
|
LNewHash := ComputeAuthHashCurrent(LPwd, LSalt, PBKDF2_ITERATIONS_TARGET);
|
|
|
|
// Step 4: atomic transaction — update user hash AND every entry's
|
|
// ciphertext together. Any failure rolls back, leaving the user on
|
|
// the legacy config (safe to retry next login).
|
|
DB.Connection.StartTransaction;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
// Update hash, iter count, AND hash_algo all in one row update.
|
|
// hash_algo := HASH_ALGO_CURRENT is what completes the migration
|
|
// away from the "stored hash IS the AES key" architectural flaw.
|
|
LQ.SQL.Text :=
|
|
'UPDATE users SET password_hash = :h, kdf_iterations = :it, ' +
|
|
' hash_algo = :algo ' +
|
|
'WHERE id = :uid';
|
|
LQ.ParamByName('h').AsString := LNewHash;
|
|
LQ.ParamByName('it').AsInteger := PBKDF2_ITERATIONS_TARGET;
|
|
LQ.ParamByName('algo').AsString := HASH_ALGO_CURRENT;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ExecSQL;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'UPDATE vault_entries ' +
|
|
'SET encrypted_password = :ep, iv = :iv, updated_at = CURRENT_TIMESTAMP ' +
|
|
'WHERE id = :id AND user_id = :uid';
|
|
|
|
for I := 0 to LEntries.Count - 1 do
|
|
begin
|
|
LEntry := LEntries.Items[I] as TJSONObject;
|
|
LEntryId := LEntry.GetValue<Integer>('id', 0);
|
|
LEncPwd := LEntry.GetValue<string>('encrypted_password', '');
|
|
LIv := LEntry.GetValue<string>('iv', '');
|
|
if (LEntryId <= 0) or (LEncPwd = '') or (LIv = '') then
|
|
raise Exception.CreateFmt('Invalid entry payload at index %d', [I]);
|
|
|
|
LQ.ParamByName('id').AsInteger := LEntryId;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('ep').AsString := LEncPwd;
|
|
LQ.ParamByName('iv').AsString := LIv;
|
|
LQ.ExecSQL;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
DB.Connection.Commit;
|
|
except
|
|
DB.Connection.Rollback;
|
|
raise;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
LogAudit(LUserId, Format('migrate_kdf %d->%d', [LOldIters, PBKDF2_ITERATIONS_TARGET]), LIP);
|
|
TJSONHelper.SendOK(AResponse, 'Migration complete');
|
|
end;
|
|
|
|
// ===== POST /change-master-password ==========================================
|
|
// Body: {
|
|
// currentMasterPassword, // verified against current stored hash
|
|
// newMasterPassword, // basis for new hash + new client AES key
|
|
// newSalt, // 64-char hex, client-generated
|
|
// entries: [{ id, encrypted_password, iv, totp_secret?, totp_iv? }, ...]
|
|
// // entries re-encrypted client-side with the
|
|
// // new key (derived from new pw + new salt)
|
|
// }
|
|
//
|
|
// All-or-nothing transaction: verifies current, then in one tx updates the
|
|
// user row (hash + salt + iter count + algo) AND every entry's ciphertext.
|
|
// On any failure the user stays on the old config — they can retry without
|
|
// data loss.
|
|
//
|
|
// Side effects:
|
|
// - Invalidates ALL other sessions so a leaked old token can't keep
|
|
// working past the pw change.
|
|
// - Writes an audit_log entry.
|
|
//
|
|
// The /migrate-kdf endpoint exists for the same "re-encrypt all entries"
|
|
// pattern when the master pw stays the same; this endpoint differs by
|
|
// rotating the salt + pw too.
|
|
procedure HandleChangeMasterPassword(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId, I: Integer;
|
|
LBody, LEntry, LObj: TJSONObject;
|
|
LEntries: TJSONArray;
|
|
LUser, LCurPwd, LNewPwd, LCurVerifier, LNewVerifier, LNewSalt,
|
|
LStoredHash, LOldSalt, LAlgo, LIP, LComputed, LNewHash, LReqAlgo: string;
|
|
LOldIters: Integer;
|
|
LArgon: TArgon2Params;
|
|
LQ: TFDQuery;
|
|
LValid: Boolean;
|
|
LEntryId: Integer;
|
|
LEncPwd, LIv, LTotpSec, LTotpIv: string;
|
|
LNewToken, LNewCsrf: string;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LIP := GetClientIP(ARequest);
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LCurPwd := LBody.GetValue<string>('currentMasterPassword', '');
|
|
LNewPwd := LBody.GetValue<string>('newMasterPassword', '');
|
|
LNewSalt := LBody.GetValue<string>('newSalt', '');
|
|
// ZK path: verifier for the OLD pw (PBKDF2 over OLD salt + iters) and
|
|
// for the NEW pw (PBKDF2 over the new salt at target iters).
|
|
LCurVerifier := LBody.GetValue<string>('currentVerifier', '');
|
|
LNewVerifier := LBody.GetValue<string>('newVerifier', '');
|
|
// Optional: rotate onto Argon2id. hashAlgo='argon2id-v2' + argon2:{m,t,p}.
|
|
LReqAlgo := LBody.GetValue<string>('hashAlgo', '');
|
|
LArgon := ReadArgon2Params(LBody);
|
|
LEntries := LBody.GetValue<TJSONArray>('entries');
|
|
|
|
// Input validation. Either plaintext OR verifier must be present; we
|
|
// can't enforce min-length on the new pw in the ZK path (we don't see it).
|
|
if (LCurPwd = '') and (LCurVerifier = '') then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Missing current credentials');
|
|
Exit;
|
|
end;
|
|
if (LNewPwd = '') and (LNewVerifier = '') then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Missing new credentials');
|
|
Exit;
|
|
end;
|
|
if (LNewPwd <> '') and (Length(LNewPwd) < 8) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400,
|
|
'New master password must be at least 8 characters');
|
|
Exit;
|
|
end;
|
|
if Length(LNewSalt) <> 64 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Invalid newSalt length');
|
|
Exit;
|
|
end;
|
|
if (LNewVerifier <> '') and (not IsValidVerifier(LNewVerifier)) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Malformed newVerifier');
|
|
Exit;
|
|
end;
|
|
if LEntries = nil then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Missing entries array');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
// Step 1: load current state.
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT username, password_hash, salt, hash_algo, kdf_iterations ' +
|
|
'FROM users WHERE id = :uid';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.Open;
|
|
if LQ.IsEmpty then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 401, 'User not found');
|
|
Exit;
|
|
end;
|
|
LUser := LQ.FieldByName('username').AsString;
|
|
LStoredHash := LQ.FieldByName('password_hash').AsString;
|
|
LOldSalt := LQ.FieldByName('salt').AsString;
|
|
LAlgo := LQ.FieldByName('hash_algo').AsString;
|
|
LOldIters := LQ.FieldByName('kdf_iterations').AsInteger;
|
|
if LAlgo = '' then LAlgo := HASH_ALGO_LEGACY;
|
|
if LOldIters <= 0 then LOldIters := PBKDF2_ITERATIONS;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
// Lockout protection on the pw change itself (same threat model as
|
|
// /login — attacker with a hijacked session shouldn't be able to
|
|
// brute-force the current pw to swap it for one they know).
|
|
if RejectIfAccountLocked(AResponse, LUser) then Exit;
|
|
|
|
// Step 2: verify the CURRENT master pw — prefer verifier path.
|
|
LValid := False;
|
|
if LCurVerifier <> '' then
|
|
LValid := CheckVerifier(LCurVerifier, LStoredHash, LAlgo)
|
|
else if SameText(LAlgo, HASH_ALGO_LEGACY) then
|
|
begin
|
|
LComputed := PBKDF2_SHA256_Hex(LCurPwd, LOldSalt, LOldIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end
|
|
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
|
|
begin
|
|
LComputed := ComputeAuthHashCurrent(LCurPwd, LOldSalt, LOldIters);
|
|
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
|
end;
|
|
if not LValid then
|
|
begin
|
|
RecordFailedAccountAttempt(LUser, LIP);
|
|
LogAudit(LUserId, 'failed_change_password', LIP);
|
|
TJSONHelper.SendError(AResponse, 401, 'Current password is incorrect');
|
|
Exit;
|
|
end;
|
|
|
|
// Step 3: compute the new auth hash. ZK path: just wrap the
|
|
// client-supplied newVerifier (rotating onto the DECOUPLED scheme).
|
|
// Plaintext: derive server-side (stays CURRENT).
|
|
var LNewAlgo := HASH_ALGO_CURRENT;
|
|
var LNewArgM := 0; var LNewArgT := 0; var LNewArgP := 0;
|
|
if LNewVerifier <> '' then
|
|
begin
|
|
// ZK rotation: Argon2id if the client declared it (valid params),
|
|
// else the PBKDF2 decoupled scheme. Both SHA256-wrap the verifier.
|
|
if SameText(LReqAlgo, HASH_ALGO_ARGON2) and LArgon.Valid then
|
|
begin
|
|
LNewAlgo := HASH_ALGO_ARGON2;
|
|
LNewArgM := LArgon.M; LNewArgT := LArgon.T; LNewArgP := LArgon.P;
|
|
end
|
|
else
|
|
LNewAlgo := HASH_ALGO_DECOUPLED;
|
|
LNewHash := VerifierToStoredHash(LNewVerifier, LNewAlgo);
|
|
end
|
|
else
|
|
LNewHash := ComputeAuthHashCurrent(LNewPwd, LNewSalt, PBKDF2_ITERATIONS_TARGET);
|
|
|
|
// Step 4: atomic transaction — user row + every entry's ciphertext.
|
|
DB.Connection.StartTransaction;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'UPDATE users SET ' +
|
|
' password_hash = :h, ' +
|
|
' salt = :s, ' +
|
|
' kdf_iterations = :it, ' +
|
|
' hash_algo = :algo, ' +
|
|
' argon2_m = :am, ' +
|
|
' argon2_t = :at, ' +
|
|
' argon2_p = :ap ' +
|
|
'WHERE id = :uid';
|
|
LQ.ParamByName('h').AsString := LNewHash;
|
|
LQ.ParamByName('s').AsString := LNewSalt;
|
|
LQ.ParamByName('it').AsInteger := PBKDF2_ITERATIONS_TARGET;
|
|
LQ.ParamByName('algo').AsString := LNewAlgo;
|
|
LQ.ParamByName('am').AsInteger := LNewArgM;
|
|
LQ.ParamByName('at').AsInteger := LNewArgT;
|
|
LQ.ParamByName('ap').AsInteger := LNewArgP;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ExecSQL;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'UPDATE vault_entries SET ' +
|
|
' encrypted_password = :ep, iv = :iv, ' +
|
|
' totp_secret = :ts, totp_iv = :tiv, ' +
|
|
' custom_fields = :cf, custom_fields_iv = :cfiv, ' +
|
|
' username_enc = :uenc, username_iv = :uiv, ' +
|
|
' updated_at = CURRENT_TIMESTAMP ' +
|
|
'WHERE id = :id AND user_id = :uid';
|
|
|
|
for I := 0 to LEntries.Count - 1 do
|
|
begin
|
|
LEntry := LEntries.Items[I] as TJSONObject;
|
|
LEntryId := LEntry.GetValue<Integer>('id', 0);
|
|
LEncPwd := LEntry.GetValue<string>('encrypted_password', '');
|
|
LIv := LEntry.GetValue<string>('iv', '');
|
|
LTotpSec := LEntry.GetValue<string>('totp_secret', '');
|
|
LTotpIv := LEntry.GetValue<string>('totp_iv', '');
|
|
var LCf := LEntry.GetValue<string>('custom_fields', '');
|
|
var LCfIv := LEntry.GetValue<string>('custom_fields_iv', '');
|
|
var LUEnc := LEntry.GetValue<string>('username_enc', '');
|
|
var LUIv := LEntry.GetValue<string>('username_iv', '');
|
|
if (LEntryId <= 0) or (LEncPwd = '') or (LIv = '') then
|
|
raise Exception.CreateFmt('Invalid entry payload at index %d', [I]);
|
|
|
|
LQ.ParamByName('id').AsInteger := LEntryId;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('ep').AsString := LEncPwd;
|
|
LQ.ParamByName('iv').AsString := LIv;
|
|
// TOTP / custom_fields are optional per entry — clear when
|
|
// empty so existing-NULL rows don't get stomped with empty strings.
|
|
LQ.ParamByName('ts').DataType := ftMemo;
|
|
LQ.ParamByName('tiv').DataType := ftMemo;
|
|
LQ.ParamByName('cf').DataType := ftMemo;
|
|
LQ.ParamByName('cfiv').DataType := ftMemo;
|
|
if LTotpSec.IsEmpty then LQ.ParamByName('ts').Clear
|
|
else LQ.ParamByName('ts').Value := LTotpSec;
|
|
if LTotpIv = '' then LQ.ParamByName('tiv').Clear
|
|
else LQ.ParamByName('tiv').Value := LTotpIv;
|
|
if LCf = '' then LQ.ParamByName('cf').Clear
|
|
else LQ.ParamByName('cf').Value := LCf;
|
|
if LCfIv = '' then LQ.ParamByName('cfiv').Clear
|
|
else LQ.ParamByName('cfiv').Value := LCfIv;
|
|
LQ.ParamByName('uenc').DataType := ftMemo;
|
|
LQ.ParamByName('uiv').DataType := ftMemo;
|
|
if LUEnc = '' then LQ.ParamByName('uenc').Clear
|
|
else LQ.ParamByName('uenc').Value := LUEnc;
|
|
if LUIv = '' then LQ.ParamByName('uiv').Clear
|
|
else LQ.ParamByName('uiv').Value := LUIv;
|
|
LQ.ExecSQL;
|
|
end;
|
|
// Password history is encrypted with the OLD vault key — we
|
|
// don't ship the plaintext server-side to re-encrypt it under
|
|
// the new key. Drop the history rows so a future "Show history"
|
|
// doesn't surface undecryptable garbage. The user accepts this
|
|
// as a consequence of rotating their master password.
|
|
LQ.SQL.Text :=
|
|
'DELETE FROM entries_password_history WHERE user_id = :uid';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ExecSQL;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
DB.Connection.Commit;
|
|
except
|
|
DB.Connection.Rollback;
|
|
raise;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ExecSQL;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
DeleteAllUserSessions(LUserId);
|
|
// Immediately mint a fresh session for the calling client so the
|
|
// very next request doesn't bounce with ESessionRejected. The user
|
|
// hasn't logged out — they rotated their key, the UI session is
|
|
// still legitimate.
|
|
CreateSession(LUserId, LNewToken, LNewCsrf);
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
ClearAccountLockout(LUser);
|
|
LogAudit(LUserId, 'change_master_password', LIP);
|
|
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('message', 'Master password changed');
|
|
LObj.AddPair('salt', LNewSalt);
|
|
LObj.AddPair('kdfIterations', TJSONNumber.Create(PBKDF2_ITERATIONS_TARGET));
|
|
LObj.AddPair('token', LNewToken);
|
|
LObj.AddPair('csrf', LNewCsrf);
|
|
TJSONHelper.SendJSON(AResponse, LObj);
|
|
end;
|
|
|
|
// ===== POST /login/challenge =================================================
|
|
// First leg of the zero-knowledge login: client posts the username, server
|
|
// returns the salt + KDF iteration count needed to compute the verifier on
|
|
// the client side. The actual login then sends the verifier (not the master
|
|
// pw) to POST /login.
|
|
//
|
|
// User existence: this endpoint DOES leak user existence (404 vs 200) — same
|
|
// as the existing /login through timing (PBKDF2 cost runs only on valid
|
|
// users). Closing that hole properly requires returning a deterministic fake
|
|
// salt for unknown users, which itself leaks via stability under retry. v1
|
|
// accepts the timing leak in /login and the explicit leak here as equivalent.
|
|
//
|
|
// Rate-limited per IP via the existing login_attempts table. No per-account
|
|
// lockout fires here — that lives in /login proper, on actual verifier
|
|
// mismatches.
|
|
procedure HandleLoginChallenge(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LBody, LObj: TJSONObject;
|
|
LUser, LSalt, LIP, LAlgo: string;
|
|
LKdfIters, LArgM, LArgT, LArgP: Integer;
|
|
LQ: TFDQuery;
|
|
begin
|
|
LIP := GetClientIP(ARequest);
|
|
if CheckRateLimit(LIP) >= 20 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
|
|
Exit;
|
|
end;
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LUser := Trim(LBody.GetValue<string>('username', ''));
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
if LUser = '' then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Username required');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT salt, kdf_iterations, hash_algo, argon2_m, argon2_t, argon2_p ' +
|
|
'FROM users WHERE username = :u';
|
|
LQ.ParamByName('u').AsString := LUser;
|
|
LQ.Open;
|
|
if LQ.IsEmpty then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Unknown user');
|
|
Exit;
|
|
end;
|
|
LSalt := LQ.FieldByName('salt').AsString;
|
|
LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger;
|
|
LAlgo := LQ.FieldByName('hash_algo').AsString;
|
|
LArgM := LQ.FieldByName('argon2_m').AsInteger;
|
|
LArgT := LQ.FieldByName('argon2_t').AsInteger;
|
|
LArgP := LQ.FieldByName('argon2_p').AsInteger;
|
|
if LAlgo = '' then LAlgo := HASH_ALGO_LEGACY;
|
|
if LKdfIters <= 0 then LKdfIters := PBKDF2_ITERATIONS;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('salt', LSalt);
|
|
LObj.AddPair('kdfIterations', TJSONNumber.Create(LKdfIters));
|
|
// Echo back the hash_algo so the client can choose the right wrap path
|
|
// (legacy vs -v2) and KDF. For Argon2id accounts, also echo the params
|
|
// the client must feed to the KDF.
|
|
LObj.AddPair('hashAlgo', LAlgo);
|
|
AppendArgon2Params(LObj, LArgM, LArgT, LArgP);
|
|
TJSONHelper.SendJSON(AResponse, LObj);
|
|
end;
|
|
|
|
initialization
|
|
Router.Register('POST', '/login/challenge', HandleLoginChallenge);
|
|
Router.Register('POST', '/register', HandleRegister);
|
|
Router.Register('POST', '/login', HandleLogin);
|
|
Router.Register('POST', '/logout', HandleLogout);
|
|
Router.Register('POST', '/reauth', HandleReauth);
|
|
Router.Register('POST', '/migrate-kdf', HandleMigrateKdf);
|
|
Router.Register('POST', '/change-master-password', HandleChangeMasterPassword);
|
|
|
|
end.
|