View Issue Details

IDProjectCategoryView StatusLast Update
0037727FPCFCLpublic2020-09-16 13:32
ReporterSoner Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status assignedResolutionopen 
Platformx64OSWindows 
Product Version3.3.1 
Summary0037727: logic error in fcl-web-fpwebfile.pp, it works only in *nix-osses.
DescriptionFollowing code works in "procedure RegisterFileLocation" only in linux/unix osses, because on windows the paths starts like this 'C:\' or '\\':
if Copy(D,1,1)<>'/' then
      D:=BaseDir+D;

I think this procedure has more logic errors because you cannot not serve a file like this:
localhost/index.html
You must register subfolder and serve files from subfolder like this:
localhost/somefolder/index.html

Steps To Reproducestart this application:
program fphttpappserver;

uses
  SysUtils, fphttpapp, fpwebfile;
begin
  RegisterFileLocation('files',ExtractFilePath(ParamStr(0))+DirectorySeparator+'html');
  {$ifdef WINDOWS}
  MimeTypesFile:=ExtractFilePath(ParamStr(0))+'mime.types';
  {$else}
  MimeTypesFile:='/etc/mime.types';
  {$endif}
  Application.Initialize;
  Application.Port:=80;
  Application.Title:='010101';
  Application.Run;
end.
Additional InformationI would change the code to this, because the function should not add application location as html folder, because it is security hole.

Procedure RegisterFileLocation(Const ALocation,ADirectory : String);
//Var
  //D,BaseDir : String;
begin
  if (ALocation='') then
    Raise HTTPError.Create(SErrNoLocation);
  if Pos('/',ALocation)<>0 then
    Raise HTTPError.Create(SErrInvalidLocation);
  if (Locations=Nil) then
    Locations:=TStringList.Create;
  if DefaultFileModuleClass=Nil then
    DefaultFileModuleClass:=TFPCustomFileModule;
  {BaseDir:=ExtractFilePath(ParamStr(0));
  if (ADirectory='') then
    Locations.Values[IncludeHTTPPathDelimiter(ALocation)]:=BaseDir
  else
    begin
    D:=ADirectory;
    if Copy(D,1,1)<>'/' then //<<-- WORKS ONLY IN LINUX/UNIX
      D:=BaseDir+D;
    if not DirectoryExists(D) then
      Raise HTTPError.CreateFmt(SErrInvalidDirectory,[D]);
    Locations.Values[IncludeHTTPPathDelimiter(ALocation)]:=IncludeTrailingPathDelimiter(D);
    end;}
  if not DirectoryExists(ADirectory) then
    Raise HTTPError.CreateFmt(SErrInvalidDirectory,[ADirectory]);
  Locations.Values[IncludeHTTPPathDelimiter(ALocation)]:=IncludeTrailingPathDelimiter(ADirectory);

  RegisterHTTPModule(ALocation,DefaultFileModuleClass,true);
end;
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

Soner

2020-09-10 11:52

reporter   ~0125457

Here is the source code:
https://svn.freepascal.org/svn/fpc/trunk/packages/fcl-web/src/base/fpwebfile.pp

Michael Van Canneyt

2020-09-10 12:02

administrator   ~0125458

Agreed on the Linuxism. What concerns location: this is by design. It is meant for additional locations.

But you can use the simplefilemodule to serve

localhost/index.html

if you register the module as default route:

TSimpleFileModule.RegisterDefaultRoute;

See examples/simpleserver.lpr.

Issue History

Date Modified Username Field Change
2020-09-10 11:51 Soner New Issue
2020-09-10 11:52 Soner Note Added: 0125457
2020-09-10 11:57 Michael Van Canneyt Assigned To => Michael Van Canneyt
2020-09-10 11:57 Michael Van Canneyt Status new => assigned
2020-09-10 12:02 Michael Van Canneyt Note Added: 0125458