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

unit PM.StaticFiles;

{
  Static file server with directory-traversal protection.
  Serves Z:\password-manager\ (index.html, js/, css/) from the loopback server,
  so the embedded TTMSFNCWebBrowser can navigate to http://127.0.0.1:PORT/index.html
  and the password-manager UI runs entirely inside the Delphi exe.

  Same pattern as DeskInsight's Forms/UAIWorkbench.HTTPServer.pas Monaco server.
}

interface

uses
  System.SysUtils, System.Classes, System.IOUtils, System.StrUtils,
  IdCustomHTTPServer;

type
  TStaticFileServer = class
  private
    FRootDir: string;
    function ResolveSafePath(const ARequestPath: string; out AFullPath: string): Boolean;
    function MimeTypeFor(const AExt: string): string;
  public
    constructor Create(const ARootDir: string);
    function TryServe(ARequest: TIdHTTPRequestInfo;
      AResponse: TIdHTTPResponseInfo): Boolean;
    property RootDir: string read FRootDir;
  end;

var
  StaticServer: TStaticFileServer;

procedure InitStaticServer(const ARootDir: string);
procedure DoneStaticServer;

implementation

constructor TStaticFileServer.Create(const ARootDir: string);
begin
  inherited Create;
  FRootDir := TPath.GetFullPath(IncludeTrailingPathDelimiter(ARootDir));
end;

function TStaticFileServer.ResolveSafePath(const ARequestPath: string;
  out AFullPath: string): Boolean;
var
  LRelative, LCandidate: string;
begin
  Result := False;
  AFullPath := '';
  LRelative := ARequestPath;

  // Normalize: '/' or '' -> index.html
  if (LRelative = '') or (LRelative = '/') then
    LRelative := '/index.html';

  // Strip leading slash, convert URL separators to OS separators
  if (Length(LRelative) > 0) and (LRelative[1] = '/') then
    Delete(LRelative, 1, 1);
  LRelative := StringReplace(LRelative, '/', PathDelim, [rfReplaceAll]);

  // Reject obvious traversal attempts (defense in depth — TPath.GetFullPath
  // resolves '..' but rejecting up front gives a clean 404)
  if (Pos('..', LRelative) > 0) or (Pos(':', LRelative) > 0) then Exit;

  LCandidate := TPath.GetFullPath(TPath.Combine(FRootDir, LRelative));

  // Critical check: the resolved path MUST be under FRootDir
  if not LCandidate.StartsWith(FRootDir, True) then Exit;
  if not TFile.Exists(LCandidate) then Exit;

  AFullPath := LCandidate;
  Result := True;
end;

function TStaticFileServer.MimeTypeFor(const AExt: string): string;
var
  LExt: string;
begin
  LExt := LowerCase(AExt);
  if (LExt = '.html') or (LExt = '.htm') then Exit('text/html; charset=utf-8');
  if LExt = '.js'   then Exit('application/javascript; charset=utf-8');
  if LExt = '.mjs'  then Exit('application/javascript; charset=utf-8');
  if LExt = '.css'  then Exit('text/css; charset=utf-8');
  if LExt = '.json' then Exit('application/json; charset=utf-8');
  if LExt = '.svg'  then Exit('image/svg+xml');
  if LExt = '.png'  then Exit('image/png');
  if LExt = '.jpg'  then Exit('image/jpeg');
  if LExt = '.jpeg' then Exit('image/jpeg');
  if LExt = '.gif'  then Exit('image/gif');
  if LExt = '.webp' then Exit('image/webp');
  if LExt = '.ico'  then Exit('image/x-icon');
  if LExt = '.woff' then Exit('font/woff');
  if LExt = '.woff2' then Exit('font/woff2');
  if LExt = '.ttf'  then Exit('font/ttf');
  if LExt = '.map'  then Exit('application/json');
  if LExt = '.txt'  then Exit('text/plain; charset=utf-8');
  Result := 'application/octet-stream';
end;

function TStaticFileServer.TryServe(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo): Boolean;
var
  LFullPath, LExt: string;
  LFS: TFileStream;
begin
  Result := False;
  if not SameText(ARequest.Command, 'GET') then Exit;
  if not ResolveSafePath(ARequest.Document, LFullPath) then Exit;

  LExt := ExtractFileExt(LFullPath);
  AResponse.ContentType := MimeTypeFor(LExt);

  // Stream the file — Indy will set Content-Length and free the stream.
  LFS := TFileStream.Create(LFullPath, fmOpenRead or fmShareDenyWrite);
  AResponse.ContentStream := LFS;
  AResponse.FreeContentStream := True;
  AResponse.ResponseNo := 200;
  Result := True;
end;

procedure InitStaticServer(const ARootDir: string);
begin
  if StaticServer = nil then
    StaticServer := TStaticFileServer.Create(ARootDir);
end;

procedure DoneStaticServer;
begin
  FreeAndNil(StaticServer);
end;

initialization
finalization
  DoneStaticServer;
end.