spiegel-keyman/common/windows/delphi/web/Keyman.System.HttpServer.Base.pas
Marc Durdin 6eefb3a771 fix(developer): EncodeURL was not handling spaces
Fixes #7810.

This addresses a regression introduced in #7631, where URL parameters
with spaces would be encoded into `+` instead of `%20`. Looking a bit
deeper at the Delphi `TNetEncoding.URL.Encode` function I realised that
it was entirely inadequate. Some guy named Marc Durdin wrote a blog a
good few years ago about the problem, and that's what I ended up using.

This encoding issue caused filenames with spaces (by default, project
paths in Developer have spaces) to give a 404 when editing a touch
layout, which meant that the touch keyboards could not be saved.

Also fixes KEYMAN-DEVELOPER-74, where the + encoding caused multiple
entries to appear in the filename cache.

Amusing to Google this problem, find solid answer on SO, which pointed
to my very own blog. Embarrassing that my own code didn't already
include my own fix.

A secondary issue is also fixed here, where request parameters were
double-decoded for formencoded POST requests. The fix for broken URL
encodings was only required for GET requests.

This also showed up in KEYMAN-DEVELOPER-74, with double-encoded paths
being registered as source files.
2022-11-26 07:09:53 +07:00

136 lines
3.5 KiB
ObjectPascal

unit Keyman.System.HttpServer.Base;
interface
uses
System.Classes,
IdContext,
IdCustomHTTPServer,
IdHTTPServer;
type
TBaseHttpResponder = class
private
protected
function IncludesParentFolderReference(const path: string): Boolean;
procedure RespondFile(AFileName: string; AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure Respond404(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure RespondStream(stream: TStream; const AFileName: string;
AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
end;
function CrackUTF8ZeroExtendedString(CommandType: THTTPCommandType; const p: string): string;
implementation
uses
IdGlobalProtocols,
System.SysUtils;
function CrackUTF8ZeroExtendedString(CommandType: THTTPCommandType; const p: string): string;
var
s: RawByteString;
i: Integer;
begin
if CommandType = hcPOST then
begin
// POSTed data is decoded correctly
Exit(p);
end;
// Indy's UTF8 handling of URLs is *completely* broken.
// We may need to check this with updated versions of Delphi
{$IFNDEF VER330}
ERROR! Check if this is still needed with Delphi update
{$ENDIF}
SetLength(s, p.Length);
for i := 1 to p.Length do
begin
s[i] := AnsiChar(Ord(p[i]));
end;
Result := UTF8ToString(s);
end;
{ TBaseHttpResponder }
function TBaseHttpResponder.IncludesParentFolderReference(
const path: string): Boolean;
begin
Result := path.Contains('../') or path.Contains('..\');
end;
procedure TBaseHttpResponder.Respond404(
AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ResponseText := 'File not found';
end;
procedure TBaseHttpResponder.RespondFile(AFileName: string;
AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
// Serve the file
if DirectoryExists(AFileName) then
begin
AFileName := IncludeTrailingPathDelimiter(AFileName) + 'index.html';
end;
if not FileExists(AFileName) then
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ResponseText := 'File not found';
Exit;
end;
if AResponseInfo.ContentType = '' then
begin
AResponseInfo.HTTPServer.MIMETable.LoadTypesFromOS := False;
AResponseInfo.ContentType := AResponseInfo.HTTPServer.MIMETable.GetFileMIMEType(AFileName);
end;
AResponseInfo.CharSet := 'UTF-8';
AResponseInfo.ContentLength := FileSizeByName(AFileName);
//AResponseInfo.LastModified := GetFileDate(doc);
AResponseInfo.WriteHeader;
AContext.Connection.IOHandler.WriteFile(AFileName);
end;
procedure TBaseHttpResponder.RespondStream(stream: TStream;
const AFileName: string;
AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
// Serve a memory stream
if not Assigned(stream) then
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ResponseText := 'File not found';
Exit;
end;
if AResponseInfo.ContentType = '' then
begin
AResponseInfo.HTTPServer.MIMETable.LoadTypesFromOS := False;
AResponseInfo.ContentType := AResponseInfo.HTTPServer.MIMETable.GetFileMIMEType(AFileName);
end;
AResponseInfo.CharSet := 'UTF-8';
AResponseInfo.ContentLength := stream.Size;
//AResponseInfo.LastModified := GetFileDate(doc);
AResponseInfo.WriteHeader;
AContext.Connection.IOHandler.Write(stream);
end;
end.