paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 13:59:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added switch so the server can act as simple file server

Browse Source 
git-svn-id: trunk@41270 -
This commit is contained in:
michael 2019-02-09 18:33:39 +00:00
parent d6b39276bb
commit 76f577ccbf
1 changed files with 55 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
utils/pas2js/httpcompiler.pp
View File

@ -89,7 +89,10 @@ Type
FDW : TDirWatcher;
FStatusList : TFPObjectList;
FCompiles : TCompiles;
FServeOnly : Boolean;
procedure AddToStatus(O: TJSONObject);
function HandleCompileOptions(aDir: String): Boolean;
function ProcessOptions: Boolean;
Procedure ReportBuilding(AItem : TCompileItem);
Procedure ReportBuilt(AItem : TCompileItem);
Procedure AddToStatus(AEntry : TDirectoryEntry; AEvents : TFileEvents);
@ -108,6 +111,7 @@ Type
Property ProjectFile : String Read FProjectFile Write FProjectFile;
Property ConfigFile : String Read FConfigFile Write FConfigFile;
Property BaseDir : String Read FBaseDir;
Property ServeOnly : Boolean Read FServeOnly;
end;
Implementation
@ -255,6 +259,7 @@ begin
Writeln('-q --quiet Do not write diagnostic messages');
Writeln('-w --watch Watch directory for changes');
Writeln('-c --compile[=proj] Recompile project if pascal files change. Default project is app.lpr');
Writeln('-s --simpleserver Only serve files, do not enable compilation.');
Halt(Ord(Msg<>''));
{AllowWriteln-}
end;
@ -474,32 +479,16 @@ begin
AResponse.SendResponse;
end;
procedure THTTPCompilerApplication.DoRun;
Var
S,IndexPage,D : String;
Function THTTPCompilerApplication.HandleCompileOptions(aDir : String) : Boolean;
begin
S:=Checkoptions('hqd:ni:p:wP::c',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:']);
if (S<>'') or HasOption('h','help') then
usage(S);
Quiet:=HasOption('q','quiet');
Result:=False;
Watch:=HasOption('w','watch');
Port:=StrToIntDef(GetOptionValue('p','port'),3000);
D:=GetOptionValue('d','directory');
if D='' then
D:=GetCurrentDir;
Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
{$ifdef unix}
MimeTypesFile:='/etc/mime.types';
{$else}
MimeTypesFile:=ExtractFilePath(System.ParamStr(0))+'mime.types';
{$endif}
if Hasoption('P','project') then
begin
ProjectFile:=GetOptionValue('P','project');
if ProjectFile='' then
ProjectFile:=IncludeTrailingPathDelimiter(D)+'app.lpr';
ProjectFile:=IncludeTrailingPathDelimiter(aDir)+'app.lpr';
If Not FileExists(ProjectFile) then
begin
Terminate;
@ -516,11 +505,41 @@ begin
begin
if (ProjectFile='') then
Log(etWarning,'No project file specified, disabling watch.') ;
StartWatch(D);
StartWatch(aDir);
end;
Result:=True;
end;
Function THTTPCompilerApplication.ProcessOptions : Boolean;
Var
S,IndexPage,D : String;
begin
Result:=False;
S:=Checkoptions('shqd:ni:p:wP::c',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:','simpleserver']);
if (S<>'') or HasOption('h','help') then
usage(S);
FServeOnly:=HasOption('s','serve-only');
Quiet:=HasOption('q','quiet');
Port:=StrToIntDef(GetOptionValue('p','port'),3000);
D:=GetOptionValue('d','directory');
if D='' then
D:=GetCurrentDir;
{$ifdef unix}
MimeTypesFile:='/etc/mime.types';
{$else}
MimeTypesFile:=ExtractFilePath(System.ParamStr(0))+'mime.types';
{$endif}
FBaseDir:=D;
if not ServeOnly then
if not HandleCompileOptions(D) then
exit(False);
TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
TSimpleFileModule.OnLog:=@Log;
Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
if ServeOnly then
Log(etInfo,'Compile requests will be ignored.');
If not HasOption('n','noindexpage') then
begin
IndexPage:=GetOptionValue('i','indexpage');
@ -529,8 +548,22 @@ begin
Log(etInfo,'Using index page %s',[IndexPage]);
TSimpleFileModule.IndexPageName:=IndexPage;
end;
httprouter.RegisterRoute('$sys/compile',rmPost,@DoRecompile);
httprouter.RegisterRoute('$sys/status',rmGet,@DoStatusRequest);
Result:=True;
end;
procedure THTTPCompilerApplication.DoRun;
begin
If not ProcessOptions then
begin
Terminate;
exit;
end;
if not ServeOnly then
begin
httprouter.RegisterRoute('$sys/compile',rmPost,@DoRecompile);
httprouter.RegisterRoute('$sys/status',rmGet,@DoStatusRequest);
end;
TSimpleFileModule.RegisterDefaultRoute;
inherited;
end;