View Issue Details

IDProjectCategoryView StatusLast Update
0037727FPCFCLpublic2020-11-09 10:55
ReporterSoner Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Platformx64OSWindows 
Product Version3.3.1 
Fixed in 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 Revision47350
FPCOldBugId
FPCTarget3.2.2
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.

Michael Van Canneyt

2020-11-08 21:50

administrator   ~0126802

Fixed the linuxism.

Sven Barth

2020-11-08 23:33

manager   ~0126805

Please note that the way you fixed it with will fail in case of drive absolute paths.

Take a look at this example:

program texpand;

{$mode objfpc}{$H+}

uses
  SysUtils;

begin
  Writeln(ExpandFileName('C:\test'));
  Writeln(ExpandFilename('..\test'));
  Writeln(ExpandFileName('.\test'));
  Writeln(ExpandFileName('C:test'));
  Writeln(ExpandFileName('\test'));
end.


This will result in the following output if the current directory is 'C:\fpc\git' (especially note the output of the last and second to last):

C:\test
C:\fpc\test
C:\fpc\git\test
C:\fpc\git\test
C:\test


It might be better to check whether the path begins with '.' + DirSep or '..' + DirSep (sadly we don't have a IsRelative function or something like that for that...)

Michael Van Canneyt

2020-11-09 10:55

administrator   ~0126811

Testing on '.' or '..' is also not correct, since fpc/something/else is also relative.
We need an IsRelativePath() in sysutils.

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
2020-11-08 21:50 Michael Van Canneyt Status assigned => resolved
2020-11-08 21:50 Michael Van Canneyt Resolution open => fixed
2020-11-08 21:50 Michael Van Canneyt Fixed in Version => 3.3.1
2020-11-08 21:50 Michael Van Canneyt Fixed in Revision => 47350
2020-11-08 21:50 Michael Van Canneyt FPCTarget => 3.2.2
2020-11-08 21:50 Michael Van Canneyt Note Added: 0126802
2020-11-08 23:33 Sven Barth Note Added: 0126805
2020-11-09 10:55 Michael Van Canneyt Note Added: 0126811