Password-Manager/delphi-backend/Source/PM.UserPrefs.pas

unit PM.UserPrefs;

{
  Device-bound key/value prefs persisted across launches.

  Problem solved: the HTTP server binds an ephemeral port that changes on
  every start (49152-65535). localStorage is keyed by origin (scheme+host
  +port) so a different port = a fresh localStorage = anything persisted
  there is lost between launches. For prefs that must survive a reboot
  (remembered username, etc.) we persist them via this unit instead.

  Storage: %LOCALAPPDATA%\PMServer\prefs.bin
  Format:  DPAPI-encrypted UTF-8 JSON object {"key":"value",....
  Scope:   current Windows user (same threat model as PM.QuickUnlock).
}

interface

uses
  System.SysUtils, System.Classes, System.IOUtils, System.JSON,
  Winapi.Windows;

function GetPref(const AKey: string): string;
procedure SetPref(const AKey, AValue: string);

implementation

type
  TDataBlob = record
    cbData: DWORD;
    pbData: PByte;
  end;
  PDataBlob = ^TDataBlob;

function CryptProtectData(pDataIn: PDataBlob; szDataDescr: PWideChar;
  pOptionalEntropy: PDataBlob; pvReserved: Pointer; pPromptStruct: Pointer;
  dwFlags: DWORD; pDataOut: PDataBlob): BOOL; stdcall;
  external 'crypt32.dll' name 'CryptProtectData';

function CryptUnprotectData(pDataIn: PDataBlob; ppszDataDescr: PPWideChar;
  pOptionalEntropy: PDataBlob; pvReserved: Pointer; pPromptStruct: Pointer;
  dwFlags: DWORD; pDataOut: PDataBlob): BOOL; stdcall;
  external 'crypt32.dll' name 'CryptUnprotectData';

function LocalFree(hMem: HLOCAL): HLOCAL; stdcall;
  external 'kernel32.dll' name 'LocalFree';

function StorageDir: string;
begin
  Result := TPath.Combine(GetEnvironmentVariable('LOCALAPPDATA'), 'PMServer');
end;

function StorageFile: string;
begin
  Result := TPath.Combine(StorageDir, 'prefs.bin');
end;

procedure EnsureStorageDir;
begin
  if not TDirectory.Exists(StorageDir) then
    TDirectory.CreateDirectory(StorageDir);
end;

function LoadAll: TJSONObject;
var
  LEncrypted: TBytes;
  LIn, LOut: TDataBlob;
  LStream: TFileStream;
  LPlain: string;
  LValue: TJSONValue;
begin
  // Default to an empty object; every error path just Exits with this.
  // Only the success path replaces it with the parsed JSON.
  Result := TJSONObject.Create;

  if not TFile.Exists(StorageFile) then Exit;

  try
    LStream := TFileStream.Create(StorageFile, fmOpenRead or fmShareDenyWrite);
    try
      SetLength(LEncrypted, LStream.Size);
      if Length(LEncrypted) > 0 then
        LStream.ReadBuffer(LEncrypted[0], LStream.Size);
    finally
      LStream.Free;
    end;
  except
    Exit;
  end;

  if Length(LEncrypted) = 0 then Exit;

  LIn.cbData  := Length(LEncrypted);
  LIn.pbData  := @LEncrypted[0];
  LOut.pbData := nil;
  LOut.cbData := 0;

  if not CryptUnprotectData(@LIn, nil, nil, nil, nil, 0, @LOut) then Exit;
  try
    SetString(LPlain, PAnsiChar(LOut.pbData), LOut.cbData);
    LValue := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(LPlain), 0);
    if LValue is TJSONObject then
    begin
      // Replace the default empty object with the parsed one.
      Result.Free;
      Result := TJSONObject(LValue);
    end
    else if LValue <> nil then
      LValue.Free;
  finally
    if LOut.pbData <> nil then LocalFree(HLOCAL(LOut.pbData));
  end;
end;

procedure SaveAll(AObj: TJSONObject);
var
  LBytes: TBytes;
  LIn, LOut: TDataBlob;
  LStream: TFileStream;
  LJsonStr: string;
begin
  LJsonStr := AObj.ToJSON;
  LBytes   := TEncoding.UTF8.GetBytes(LJsonStr);
  if Length(LBytes) = 0 then Exit;

  LIn.cbData  := Length(LBytes);
  LIn.pbData  := @LBytes[0];
  LOut.pbData := nil;
  LOut.cbData := 0;

  if not CryptProtectData(@LIn, nil, nil, nil, nil, 0, @LOut) then Exit;
  try
    EnsureStorageDir;
    LStream := TFileStream.Create(StorageFile, fmCreate);
    try
      LStream.WriteBuffer(LOut.pbData^, LOut.cbData);
    finally
      LStream.Free;
    end;
  finally
    if LOut.pbData <> nil then LocalFree(HLOCAL(LOut.pbData));
  end;
end;

function GetPref(const AKey: string): string;
var
  LObj: TJSONObject;
  LValue: TJSONValue;
begin
  Result := '';
  LObj := LoadAll;
  try
    if LObj = nil then Exit;
    LValue := LObj.GetValue(AKey);
    if LValue <> nil then
      Result := LValue.Value;
  finally
    LObj.Free;
  end;
end;

procedure SetPref(const AKey, AValue: string);
var
  LObj: TJSONObject;
  LExisting: TJSONValue;
begin
  LObj := LoadAll;
  try
    if LObj = nil then LObj := TJSONObject.Create;
    LExisting := LObj.GetValue(AKey);
    if LExisting <> nil then
      LObj.RemovePair(AKey).Free;
    LObj.AddPair(AKey, AValue);
    SaveAll(LObj);
  finally
    LObj.Free;
  end;
end;

end.