httpcompiler.pp 22 KB

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