httpcompiler.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816
  1. unit httpcompiler;
  2. {$mode objfpc}
  3. {$H+}
  4. interface
  5. uses
  6. {$ifdef unix}baseunix,{$endif}
  7. sysutils, classes, fpjson, contnrs, syncobjs, fpmimetypes, custhttpapp, inifiles,
  8. fpwebproxy, webutil, fpwebfile, httproute, httpdefs, dirwatch, Pas2JSFSCompiler,
  9. Pas2JSCompilerCfg;
  10. Const
  11. nErrTooManyThreads = -1;
  12. Type
  13. TDirWatcher = Class;
  14. THTTPCompilerApplication = Class;
  15. { TCompileItem }
  16. TCompileItem = Class(TCollectionItem)
  17. private
  18. FBaseDir: string;
  19. FConfigFile: String;
  20. FFileName: string;
  21. FOutput : TStrings;
  22. FOptions : TStrings;
  23. FSuccess: Boolean;
  24. FThread: TThread;
  25. function GetOptions: TStrings;
  26. function GetOutput: TStrings;
  27. Public
  28. Destructor Destroy; override;
  29. Property BaseDir : string Read FBaseDir Write FBaseDir;
  30. Property FileName : string Read FFileName Write FFileName;
  31. Property ConfigFile: String Read FConfigFile Write FConfigFile;
  32. Property Options : TStrings Read GetOptions;
  33. Property Output : TStrings Read GetOutput;
  34. Property Thread : TThread Read FThread;
  35. Property Success : Boolean Read FSuccess;
  36. end;
  37. { TCompiles }
  38. TCompiles = Class(TCollection)
  39. private
  40. function GetC(AIndex : Integer): TCompileItem;
  41. Public
  42. Property Compiles[AIndex : Integer] : TCompileItem Read GetC; default;
  43. end;
  44. { TCompileThread }
  45. TCompileThread = class(TThread)
  46. private
  47. FApp : THTTPCompilerApplication;
  48. FItem: TCompileItem;
  49. procedure DoCompilerLog(Sender: TObject; const Msg: String);
  50. procedure SetItem(AValue: TCompileItem);
  51. Public
  52. Constructor create(App : THTTPCompilerApplication; aItem : TCompileItem);
  53. Procedure Execute; override;
  54. Property Item : TCompileItem read FItem write SetItem;
  55. end;
  56. { TDirWatcher }
  57. TDirWatcher = Class(TComponent)
  58. Private
  59. FApp : THTTPCompilerApplication;
  60. FDW : TDirWatch;
  61. procedure DoChange(Sender: TObject; aEntry: TDirectoryEntry; AEvents: TFileEvents);
  62. Public
  63. Constructor Create(App : THTTPCompilerApplication; ADir : String);overload;
  64. Destructor Destroy; override;
  65. end;
  66. { THTTPCompilerApplication }
  67. THTTPCompilerApplication = Class(TCustomHTTPApplication)
  68. private
  69. FAPI: String;
  70. FBaseDir: String;
  71. FConfigFile: String;
  72. FIndexPageName: String;
  73. FNoIndexPage: Boolean;
  74. FProjectFile: String;
  75. FStatusLock : TCriticalSection;
  76. FQuiet: Boolean;
  77. FWatch: Boolean;
  78. FDW : TDirWatcher;
  79. FStatusList : TFPObjectList;
  80. FCompiles : TCompiles;
  81. FServeOnly : Boolean;
  82. FMimeFile : String;
  83. FBackground:boolean;
  84. FPassword:String;
  85. FEcho:Boolean;
  86. FMaxAge: integer;
  87. FInterfaceAddress : String;
  88. procedure AddToStatus(O: TJSONObject);
  89. procedure DoEcho(ARequest: TRequest; AResponse: TResponse);
  90. procedure DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
  91. procedure Doquit(ARequest: TRequest; AResponse: TResponse);
  92. function HandleCompileOptions(aDir: String): Boolean;
  93. function ProcessOptions: Boolean;
  94. procedure ReadConfigFile(const ConfigFile: string);
  95. Procedure ReportBuilding(AItem : TCompileItem);
  96. Procedure ReportBuilt(AItem : TCompileItem);
  97. Procedure AddToStatus(AEntry : TDirectoryEntry; AEvents : TFileEvents);
  98. procedure DoStatusRequest(ARequest: TRequest; AResponse: TResponse);
  99. procedure DoRecompile(ARequest: TRequest; AResponse: TResponse);
  100. function ScheduleCompile(const aProjectFile: String; Options : TStrings = Nil): Integer;
  101. procedure StartWatch(ADir: String);
  102. protected
  103. procedure Usage(Msg: String); virtual;
  104. function GetDefaultMimeTypesFile: string; virtual;
  105. procedure LoadDefaultMimeTypes; virtual;
  106. public
  107. Constructor Create(AOWner : TComponent); override;
  108. Destructor Destroy; override;
  109. procedure DoLog(EventType: TEventType; const Msg: String); override;
  110. Procedure DoRun; override;
  111. Property API : String Read FAPI Write FAPI;
  112. property Quiet : Boolean read FQuiet Write FQuiet;
  113. Property Watch : Boolean Read FWatch Write FWatch;
  114. Property ProjectFile : String Read FProjectFile Write FProjectFile;
  115. Property ConfigFile : String Read FConfigFile Write FConfigFile;
  116. Property BaseDir : String Read FBaseDir;
  117. Property ServeOnly : Boolean Read FServeOnly;
  118. Property MimeFile : String Read FMimeFile;
  119. Property NoIndexPage : Boolean Read FNoIndexPage Write FNoIndexPage;
  120. Property IndexPageName : String Read FIndexPageName Write FIndexPageName;
  121. Property InterfaceAddress : String Read FInterfaceAddress Write FInterfaceAddress;
  122. end;
  123. Implementation
  124. uses strutils;
  125. { TCompileThread }
  126. procedure TCompileThread.SetItem(AValue: TCompileItem);
  127. begin
  128. if FItem=AValue then Exit;
  129. FItem:=AValue;
  130. end;
  131. procedure TCompileThread.DoCompilerLog(Sender: TObject; const Msg: String);
  132. begin
  133. If Assigned(Item) then
  134. Item.Output.Add(Msg);
  135. end;
  136. constructor TCompileThread.create(App: THTTPCompilerApplication; aItem: TCompileItem);
  137. begin
  138. FItem:=aItem;
  139. FApp:=App;
  140. FreeOnTerminate:=True;
  141. inherited create(False);
  142. end;
  143. procedure TCompileThread.Execute;
  144. Var
  145. C : TPas2JSFSCompiler;
  146. L : TStrings;
  147. begin
  148. L:=Nil;
  149. C:=TPas2JSFSCompiler.Create;
  150. Try
  151. C.ConfigSupport:=TPas2JSFileConfigSupport.Create(C);
  152. FApp.ReportBuilding(Item);
  153. L:=TStringList.Create;
  154. L.Assign(Item.Options);
  155. if (Item.ConfigFile<>'') then
  156. L.Add('@'+Item.ConfigFile);
  157. L.Add(Item.FileName);
  158. C.Log.OnLog:=@DoCompilerLog;
  159. try
  160. C.Run(ParamStr(0),Item.BaseDir,L,True);
  161. Item.FSuccess:=True;
  162. except
  163. On E : Exception do
  164. Item.Output.Add(Format('Error %s compiling %s: %s',[E.ClassName,Item.FileName,E.Message]));
  165. end;
  166. FApp.ReportBuilt(Item);
  167. Finally
  168. C.Free;
  169. L.Free;
  170. end;
  171. Item.FThread:=Nil;
  172. end;
  173. { TCompiles }
  174. function TCompiles.GetC(AIndex : Integer): TCompileItem;
  175. begin
  176. Result:=Items[Aindex] as TCompileItem;
  177. end;
  178. { TCompileItem }
  179. function TCompileItem.GetOutput: TStrings;
  180. begin
  181. If (FOutput=Nil) then
  182. FOutput:=TStringList.Create;
  183. Result:=FOutput;
  184. end;
  185. function TCompileItem.GetOptions: TStrings;
  186. begin
  187. If (FOptions=Nil) then
  188. FOptions:=TStringList.Create;
  189. Result:=FOptions;
  190. end;
  191. destructor TCompileItem.Destroy;
  192. begin
  193. FreeAndNil(FOutput);
  194. FreeAndNil(FOptions);
  195. inherited Destroy;
  196. end;
  197. { TDirWatcher }
  198. procedure TDirWatcher.DoChange(Sender: TObject; aEntry: TDirectoryEntry; AEvents: TFileEvents);
  199. begin
  200. if Assigned(FApp) then
  201. FApp.AddToStatus(AEntry,AEvents);
  202. end;
  203. constructor TDirWatcher.Create(App: THTTPCompilerApplication; ADir: String);
  204. begin
  205. Inherited create(APP);
  206. FApp:=App;
  207. FDW:=TDirwatch.Create(Self);
  208. FDW.AddWatch(ADir,allEvents);
  209. FDW.OnChange:=@DoChange;
  210. TThread.ExecuteInThread(@FDW.StartWatch);
  211. end;
  212. destructor TDirWatcher.Destroy;
  213. begin
  214. FApp:=Nil;
  215. FDW.Terminate;
  216. FreeAndNil(FDW);
  217. inherited Destroy;
  218. end;
  219. { THTTPCompilerApplication }
  220. procedure THTTPCompilerApplication.DoLog(EventType: TEventType; const Msg: String);
  221. begin
  222. {AllowWriteln}
  223. if Quiet then
  224. exit;
  225. if IsConsole then
  226. Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',EventType,'] ',Msg)
  227. else
  228. inherited DoLog(EventType, Msg);
  229. {AllowWriteln-}
  230. end;
  231. procedure THTTPCompilerApplication.Usage(Msg : String);
  232. begin
  233. {AllowWriteln}
  234. if (Msg<>'') then
  235. Writeln('Error: ',Msg);
  236. Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
  237. Writeln('Where options is one or more of : ');
  238. Writeln('-A --api=location,secret Enable location management API.');
  239. Writeln('-c --compile[=proj] Recompile project if pascal files change. Default project is app.lpr');
  240. Writeln('-d --directory=dir Base directory from which to serve files.');
  241. Writeln(' Default is current working directory: ',GetCurrentDir);
  242. Writeln('-h --help This help text');
  243. Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
  244. Writeln('-I --interface=IP Listen on this interface address only.');
  245. Writeln('-m --mimetypes=file Set Filename for loading mimetypes. Default is ',GetDefaultMimeTypesFile);
  246. Writeln('-n --noindexpage Do not allow index page.');
  247. Writeln('-p --port=NNNN TCP/IP port to listen on (default is 3000)');
  248. Writeln('-q --quiet Do not write diagnostic messages');
  249. Writeln('-s --simpleserver Only serve files, do not enable compilation.');
  250. Writeln('-w --watch Watch directory for changes');
  251. Halt(Ord(Msg<>''));
  252. {AllowWriteln-}
  253. end;
  254. function THTTPCompilerApplication.GetDefaultMimeTypesFile: string;
  255. begin
  256. {$ifdef unix}
  257. Result:='/etc/mime.types';
  258. {$ifdef darwin}
  259. if not FileExists(Result) then
  260. Result:='/private/etc/apache2/mime.types';
  261. {$endif}
  262. {$else}
  263. Result:=ExtractFilePath(System.ParamStr(0))+'mime.types';
  264. {$endif}
  265. end;
  266. procedure THTTPCompilerApplication.LoadDefaultMimeTypes;
  267. begin
  268. MimeTypes.LoadKnownTypes;
  269. // To be sure
  270. MimeTypes.AddType('application/xhtml+xml','xhtml;xht');
  271. MimeTypes.AddType('text/html','html;htm');
  272. MimeTypes.AddType('text/plain','txt');
  273. MimeTypes.AddType('application/javascript','js');
  274. MimeTypes.AddType('text/plain','map');
  275. MimeTypes.AddType('application/json','json');
  276. MimeTypes.AddType('image/png','png');
  277. MimeTypes.AddType('image/jpeg','jpeg;jpg');
  278. MimeTypes.AddType('image/gif','gif');
  279. MimeTypes.AddType('image/jp2','jp2');
  280. MimeTypes.AddType('image/tiff','tiff;tif');
  281. MimeTypes.AddType('application/pdf','pdf');
  282. MimeTypes.AddType('text/css','css');
  283. end;
  284. constructor THTTPCompilerApplication.Create(AOWner: TComponent);
  285. begin
  286. inherited Create(AOWner);
  287. FStatusLock:=TCriticalSection.Create;
  288. FStatusList:=TFPObjectList.Create(False);
  289. FCompiles:=TCompiles.Create(TCompileItem);
  290. end;
  291. destructor THTTPCompilerApplication.Destroy;
  292. begin
  293. FStatusLock.Enter;
  294. try
  295. FreeAndNil(FCompiles);
  296. FreeAndNil(FStatusList);
  297. finally
  298. FStatusLock.Leave;
  299. end;
  300. FreeAndNil(FStatusLock);
  301. inherited Destroy;
  302. end;
  303. procedure THTTPCompilerApplication.StartWatch(ADir : String);
  304. begin
  305. FDW:=TDirWatcher.Create(Self,ADir);
  306. end;
  307. procedure THTTPCompilerApplication.ReportBuilding(AItem: TCompileItem);
  308. Var
  309. O : TJSONObject;
  310. begin
  311. O:=TJSONObject.Create(['action','building','compileID',AItem.ID,'project',AItem.FileName,'config',AItem.ConfigFile]);
  312. AddToStatus(O);
  313. end;
  314. procedure THTTPCompilerApplication.ReportBuilt(AItem: TCompileItem);
  315. Var
  316. O : TJSONObject;
  317. A : TJSONArray;
  318. I : Integer;
  319. begin
  320. A:=TJSONArray.Create;
  321. For I:=0 to AItem.Output.Count-1 do
  322. A.Add(AItem.Output[i]);
  323. O:=TJSONObject.Create(['action','built','compileID',AItem.ID,'project',AItem.FileName,'config',AItem.ConfigFile,'output',A,'success',AItem.Success]);
  324. AddToStatus(O);
  325. end;
  326. procedure THTTPCompilerApplication.AddToStatus(O : TJSONObject);
  327. begin
  328. FStatusLock.Enter;
  329. try
  330. {$ifdef VerboseHTTPCompiler}
  331. Writeln('Adding to status ',Assigned(O),' : ',O.ClassName);
  332. {$endif}
  333. FStatusList.Add(O);
  334. finally
  335. FStatusLock.Leave;
  336. end;
  337. end;
  338. procedure THTTPCompilerApplication.AddToStatus(AEntry: TDirectoryEntry; AEvents: TFileEvents);
  339. Var
  340. O : TJSONObject;
  341. FN : String;
  342. begin
  343. Log(etDebug,'File change detected: %s (%s)',[AEntry.name,FileEventsToStr(AEvents)]);
  344. O:=TJSONObject.Create(['action','file','name',AEntry.name,'events',FileEventsToStr(AEvents)]);
  345. if Pos(ExtractFileExt(AEntry.Name),'.lpr.pas.pp.inc.dpr')>0 then
  346. FN:=AEntry.Name;
  347. if (FN<>'') then
  348. O.Add('recompile',true);
  349. AddToStatus(O);
  350. if (FN<>'') then
  351. begin
  352. Log(etDebug,'File change forces recompile: %s',[AEntry.name]);
  353. ScheduleCompile('',Nil);
  354. end;
  355. end;
  356. procedure THTTPCompilerApplication.DoStatusRequest(ARequest : TRequest; AResponse : TResponse);
  357. Var
  358. R,O : TJSONObject;
  359. A : TJSONArray;
  360. I : integer;
  361. begin
  362. Log(etDebug,'Status request from: %s',[ARequest.RemoteAddress]);
  363. R:=Nil;
  364. try
  365. FStatusLock.Enter;
  366. try
  367. if (FStatusList.Count=0) then
  368. R:=TJSONObject.Create(['ping',True])
  369. else
  370. begin
  371. {$ifdef VerboseHTTPCompiler}
  372. Writeln(FStatusList[0].ClassName);
  373. {$endif}
  374. O:=FStatusList[0] as TJSONObject;
  375. FStatusList.Delete(0);
  376. if O.Get('action','')<>'file' then
  377. R:=O
  378. else
  379. begin
  380. // If first event is file event, then add and delete all file events in list.
  381. A:=TJSONArray.Create([O]);
  382. O.Delete('action');
  383. R:=TJSONObject.Create(['action','sync','files',A]);
  384. For I:=FStatusList.Count-1 downto 0 do
  385. begin
  386. O:=FStatusList[I] as TJSONObject;
  387. if (O.Get('action','')='file') then
  388. begin
  389. A.Add(O);
  390. O.Delete('action');
  391. FStatusList.Delete(I);
  392. end;
  393. end;
  394. end
  395. end;
  396. finally
  397. FStatusLock.Leave;
  398. end;
  399. AResponse.ContentType:='application/json';
  400. AResponse.Content:=R.AsJSON;
  401. AResponse.SendResponse;
  402. finally
  403. R.Free;
  404. end;
  405. end;
  406. function THTTPCompilerApplication.ScheduleCompile(const aProjectFile: String;
  407. Options: TStrings): Integer;
  408. Var
  409. CI : TCompileItem;
  410. I,TC : Integer;
  411. begin
  412. TC:=0;
  413. For I:=0 to FCompiles.Count-1 do
  414. if Assigned(FCompiles[I].THread) then
  415. Inc(TC);
  416. if TC>10 then
  417. begin
  418. Log(etError,'Refusing compile of file "%s" using config file "%s"',[AProjectFile, ConfigFile]);
  419. Exit(nErrTooManyThreads);
  420. end;
  421. CI:=FCompiles.Add as TCompileItem;
  422. Log(etInfo,'Scheduling compile ID %d of file "%s" using config file "%s"',[CI.ID,AProjectFile, ConfigFile]);
  423. CI.BaseDir:=BaseDir;
  424. CI.FileName:=AProjectFile;
  425. CI.ConfigFile:=ConfigFile;
  426. if Assigned(Options) then
  427. CI.Options.Assign(Options);
  428. TCompileThread.Create(Self,CI);
  429. Result:=CI.ID;
  430. end;
  431. procedure THTTPCompilerApplication.DoRecompile(ARequest: TRequest; AResponse: TResponse);
  432. Var
  433. ID : Integer;
  434. PF,CL : String;
  435. Options: TStrings;
  436. begin
  437. PF:=ARequest.ContentFields.Values['ProjectFile'];
  438. CL:=ARequest.ContentFields.Values['CompileOptions'];
  439. if PF='' then
  440. PF:=ProjectFile;
  441. If (PF='') then
  442. begin
  443. AResponse.ContentType:='application/json';
  444. AResponse.Content:='{ "success" : false, "message": "no project file set or provided" }';
  445. AResponse.Code:=404;
  446. AResponse.CodeText:='No project file';
  447. end
  448. else
  449. begin
  450. Options:=Nil;
  451. try
  452. if CL<>'' then
  453. begin
  454. Options:=TStringList.Create;
  455. Options.Text:=Cl;
  456. end;
  457. ID:=ScheduleCompile(PF,Options);
  458. finally
  459. FreeAndNil(Options);
  460. end;
  461. if ID=nErrTooManyThreads then
  462. begin
  463. AResponse.Code:=403;
  464. AResponse.CodeText:='Too many compiles';
  465. AResponse.ContentType:='application/json';
  466. AResponse.Content:='{ "success" : false, "message": "Too many compiles running" }';
  467. end
  468. else
  469. begin
  470. AResponse.Code:=200;
  471. AResponse.ContentType:='application/json';
  472. AResponse.Content:=Format('{ "success" : true, "file": "%s", "commandLine" : "%s", "compileID": %d }',[StringToJSONString(PF),StringToJSONString(CL),ID]);
  473. end
  474. end;
  475. AResponse.SendResponse;
  476. end;
  477. function THTTPCompilerApplication.HandleCompileOptions(aDir: String): Boolean;
  478. begin
  479. Result:=False;
  480. Watch:=HasOption('w','watch');
  481. if Hasoption('P','project') then
  482. begin
  483. ProjectFile:=GetOptionValue('P','project');
  484. if ProjectFile='' then
  485. ProjectFile:=IncludeTrailingPathDelimiter(aDir)+'app.lpr';
  486. If Not FileExists(ProjectFile) then
  487. begin
  488. Terminate;
  489. Log(etError,'Project file "%s" does not exist, aborting.',[ProjectFile]);
  490. Exit;
  491. end;
  492. ConfigFile:=GetOptionValue('c','config');
  493. if (ConfigFile='') then
  494. ConfigFile:=ChangeFileExt(Projectfile,'.cfg');
  495. if not FileExists(ConfigFile) then
  496. ConfigFile:='';
  497. end;
  498. if Watch then
  499. begin
  500. if (ProjectFile='') then
  501. Log(etWarning,'No project file specified, disabling watch.') ;
  502. StartWatch(aDir);
  503. end;
  504. Result:=True;
  505. end;
  506. procedure THTTPCompilerApplication.DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
  507. Var
  508. Msg : String;
  509. begin
  510. if Quiet then
  511. exit;
  512. Msg:=Format('(Proxy redirect) location: %s, Method: %s, From: %s, to: %s',[aLocation,aMethod,aFromURl,atoURL]);
  513. if IsConsole then
  514. Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',etInfo,'] ',Msg)
  515. else
  516. inherited DoLog(etInfo, Msg);
  517. end;
  518. procedure THTTPCompilerApplication.DoEcho(ARequest: TRequest; AResponse: TResponse);
  519. Var
  520. L : TStrings;
  521. begin
  522. L:=TStringList.Create;
  523. try
  524. L.AddStrings(['<!doctype html>',
  525. '<html>',
  526. '<head>',
  527. '<title>Echo request</title>',
  528. '</head>',
  529. '<body>'
  530. ]);
  531. DumpRequest(aRequest,L);
  532. L.AddStrings(['</body>','</html>']);
  533. AResponse.Content:=L.Text;
  534. AResponse.SendResponse;
  535. finally
  536. L.Free;
  537. end;
  538. end;
  539. procedure THTTPCompilerApplication.Doquit(ARequest: TRequest; AResponse: TResponse);
  540. Var
  541. PWD : String;
  542. begin
  543. PWD:=ARequest.QueryFields.Values['password'];
  544. if PWD='' then
  545. ARequest.ContentFields.Values['password'];
  546. if PWD=FPassword then
  547. begin
  548. AResponse.Content:='OK';
  549. AResponse.SendContent;
  550. Terminate;
  551. end
  552. else
  553. begin
  554. AResponse.Code:=403;
  555. AResponse.CodeText:='Forbidden';
  556. AResponse.SendContent;
  557. end;
  558. end;
  559. procedure THTTPCompilerApplication.ReadConfigFile(Const ConfigFile : string);
  560. Const
  561. SConfig = 'Server';
  562. SProxy = 'Proxy';
  563. SLocations = 'Locations';
  564. KeyPort = 'Port';
  565. KeyInterface = 'Interface';
  566. KeyDir = 'Directory';
  567. KeyIndexPage = 'IndexPage';
  568. KeyHostName = 'hostname';
  569. keyMimetypes = 'mimetypes';
  570. KeySSL = 'SSL';
  571. KeyQuiet = 'quiet';
  572. KeyQuit = 'quit';
  573. KeyEcho = 'echo';
  574. KeyNoIndexPage = 'noindexpage';
  575. KeyBackground = 'background';
  576. KeyMaxAge = 'MaxAge';
  577. KeyAPI = 'API';
  578. Var
  579. L : TStringList;
  580. P,U : String;
  581. I : Integer;
  582. begin
  583. if (ConfigFile='') or Not FileExists(ConfigFile) then exit;
  584. L:=Nil;
  585. With TMemIniFile.Create(ConfigFile) do
  586. try
  587. FBaseDir:=ReadString(SConfig,KeyDir,BaseDir);
  588. Port:=ReadInteger(SConfig,KeyPort,Port);
  589. InterfaceAddress:=ReadString(SConfig,KeyInterface,InterfaceAddress);
  590. Quiet:=ReadBool(SConfig,KeyQuiet,Quiet);
  591. FMimeFile:=ReadString(SConfig,keyMimetypes,MimeFile);
  592. NoIndexPage:=ReadBool(SConfig,KeyNoIndexPage,NoIndexPage);
  593. IndexPageName:=ReadString(SConfig,KeyIndexPage,IndexPageName);
  594. HostName:=ReadString(SConfig,KeyHostName,HostName);
  595. UseSSL:=ReadBool(SConfig,KeySSL,UseSSL);
  596. FBackground:=ReadBool(SConfig,Keybackground,FBackGround);
  597. FPassword:=ReadString(SConfig,KeyQuit,FPassword);
  598. FEcho:=ReadBool(SConfig,KeyEcho,FEcho);
  599. FMaxAge:=ReadInteger(SConfig,KeyMaxAge,FMaxAge);
  600. FAPI:=ReadString(SConfig,keyAPI,'');
  601. L:=TstringList.Create;
  602. ReadSectionValues(SProxy,L,[]);
  603. For I:=0 to L.Count-1 do
  604. begin
  605. L.GetNameValue(I,P,U);
  606. if (P<>'') and (U<>'') then
  607. ProxyManager.RegisterLocation(P,U).AppendPathInfo:=true;
  608. end;
  609. L.Clear;
  610. ReadSectionValues(SLocations,L,[]);
  611. For I:=0 to L.Count-1 do
  612. begin
  613. L.GetNameValue(I,P,U);
  614. if (P<>'') and (U<>'') then
  615. RegisterFileLocation(P,U);
  616. end;
  617. finally
  618. L.Free;
  619. Free;
  620. end;
  621. end;
  622. function THTTPCompilerApplication.ProcessOptions: Boolean;
  623. Var
  624. IndexPage,D : String;
  625. begin
  626. Result:=False;
  627. if HasOption('A','api') then
  628. FAPI:=GetOptionValue('A','api');
  629. FServeOnly:=FServeOnly or HasOption('s','serve-only');
  630. Quiet:=Quiet or HasOption('q','quiet');
  631. if (Port=0) or HasOption('p','port') then
  632. Port:=StrToIntDef(GetOptionValue('p','port'),3000);
  633. if HasOption('d','directory') then
  634. D:=GetOptionValue('d','directory');
  635. if D='' then
  636. D:=GetCurrentDir;
  637. if HasOption('m','mimetypes') then
  638. MimeTypesFile:=GetOptionValue('m','mimetypes');
  639. if MimeTypesFile='' then
  640. begin
  641. MimeTypesFile:=GetDefaultMimeTypesFile;
  642. if not FileExists(MimeTypesFile) then
  643. begin
  644. MimeTypesFile:='';
  645. LoadDefaultMimeTypes;
  646. end;
  647. end
  648. else if not FileExists(MimeTypesFile) then
  649. Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
  650. FBaseDir:=D;
  651. if not ServeOnly then
  652. if not HandleCompileOptions(D) then
  653. exit(False);
  654. TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
  655. TSimpleFileModule.OnLog:=@Log;
  656. Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
  657. if ServeOnly then
  658. Log(etInfo,'Compile requests will be ignored.');
  659. NoIndexPage:=NoIndexPage or HasOption('n','noindexpage');
  660. if HasOption('i','indexpage') then
  661. IndexPage:=GetOptionValue('i','indexpage');
  662. if HasOption('I','interface') then
  663. InterfaceAddress:=GetOptionValue('I','interface');
  664. If not NoIndexPage then
  665. begin
  666. if (IndexPage='') then
  667. IndexPage:='index.html';
  668. Log(etInfo,'Using index page %s',[IndexPage]);
  669. TSimpleFileModule.IndexPageName:=IndexPage;
  670. end;
  671. Result:=True;
  672. end;
  673. procedure THTTPCompilerApplication.DoRun;
  674. Var
  675. S : String;
  676. begin
  677. S:=Checkoptions('shqd:ni:p:wP::cm:A:',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:','simpleserver','mimetypes:','api:']);
  678. if (S<>'') or HasOption('h','help') then
  679. usage(S);
  680. if HasOption('c','config') then
  681. ConfigFile:=GetOptionValue('c','config')
  682. else
  683. ConfigFile:='compileserver.ini';
  684. ReadConfigFile(ConfigFile);
  685. If not ProcessOptions then
  686. begin
  687. Terminate;
  688. exit;
  689. end;
  690. if FBackground then
  691. begin
  692. {$ifdef unix}
  693. if FPFork>0 then Halt(0);
  694. {$else}
  695. Log(etError,'Background option not supported');
  696. {$endif}
  697. end;
  698. // Handle options
  699. if FPassword<>'' then
  700. HTTPRouter.RegisterRoute('/quit',rmAll,@Doquit,False);
  701. if FEcho then
  702. HTTPRouter.RegisterRoute('/echo',rmAll,@DoEcho,False);
  703. if ProxyManager.LocationCount>0 then
  704. begin
  705. TProxyWebModule.RegisterModule('Proxy',True);
  706. ProxyManager.OnLog:=@DoProxyLog;
  707. end;
  708. DefaultCacheControlMaxAge:=FMaxAge; // one year by default
  709. if not ServeOnly then
  710. begin
  711. httprouter.RegisterRoute('$sys/compile',rmPost,@DoRecompile);
  712. httprouter.RegisterRoute('$sys/status',rmGet,@DoStatusRequest);
  713. end;
  714. if FAPI<>'' then
  715. {$IF FPC_FULLVERSION > 30300}
  716. TFPWebFileLocationAPIModule.RegisterFileLocationAPI(ExtractWord(1,FAPI,[',']),ExtractWord(2,FAPI,[',']));
  717. {$ELSE}
  718. Log(etError,'API support missing, Compile with fpc 3.3.1+');
  719. {$ENDIF}
  720. TSimpleFileModule.RegisterDefaultRoute;
  721. if InterfaceAddress<>'' then
  722. HTTPHandler.Address:=InterfaceAddress;
  723. inherited;
  724. end;
  725. end.