simpleserver.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2019 by the Free Pascal development team
  4. Sample HTTP server application
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}
  12. {$h+}
  13. { $DEFINE USEGNUTLS}
  14. { $DEFINE USEMICROHTTP}
  15. program simpleserver;
  16. {$IFDEF USEMICROHTTP}
  17. {$UNDEF USEGNUTLS}
  18. {$ENDIF}
  19. uses
  20. {$IFNDEF USEMICROHTTP}
  21. {$ifdef USEGNUTLS}
  22. gnutlssockets,
  23. {$else}
  24. opensslsockets,
  25. {$endif}
  26. custhttpapp,
  27. {$ELSE}
  28. {$ifdef unix}
  29. cthreads,
  30. {$endif}
  31. custmicrohttpapp,
  32. {$ENDIF}
  33. {$ifdef unix}
  34. baseunix,
  35. {$endif}
  36. sysutils,Classes, jsonparser, strutils, inifiles, sslbase, httproute, httpdefs, fpmimetypes, fpwebfile, fpwebproxy, webutil;
  37. Type
  38. { THTTPApplication }
  39. {$IFDEF USEMICROHTTP}
  40. TParentApp = TCustomMicroHTTPApplication;
  41. {$ELSE}
  42. TParentApp = TCustomHTTPApplication;
  43. {$ENDIF}
  44. { TMySimpleFileModule }
  45. TMySimpleFileModule = class(TSimpleFileModule)
  46. Public
  47. Procedure SendFile(const AFileName: String; AResponse: TResponse); override;
  48. end;
  49. THTTPApplication = Class(TParentApp)
  50. private
  51. FAPISecret : String;
  52. FBaseDir: string;
  53. FIndexPageName: String;
  54. FInterfaceAddress: String;
  55. FMimeFile: String;
  56. FNoIndexPage: Boolean;
  57. FQuiet: Boolean;
  58. FBackground : Boolean;
  59. FPassword : string;
  60. FEcho : Boolean;
  61. FMaxAge : Integer;
  62. FCrossOriginIsolation : Boolean;
  63. procedure AddProxy(const aProxyDef: String);
  64. procedure DoEcho(ARequest: TRequest; AResponse: TResponse);
  65. procedure DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
  66. procedure Doquit(ARequest: TRequest; AResponse: TResponse);
  67. procedure LoadMimeTypes;
  68. procedure ProcessOptions;
  69. procedure ReadConfigFile(const ConfigFile: string);
  70. procedure Usage(Msg: String);
  71. procedure Writeinfo;
  72. published
  73. procedure DoLog(EventType: TEventType; const Msg: String); override;
  74. Procedure DoRun; override;
  75. property Quiet : Boolean read FQuiet Write FQuiet;
  76. Property MimeFile : String Read FMimeFile Write FMimeFile;
  77. Property BaseDir : string Read FBaseDir Write FBaseDir;
  78. Property NoIndexPage : Boolean Read FNoIndexPage Write FNoIndexPage;
  79. Property IndexPageName : String Read FIndexPageName Write FIndexPageName;
  80. Property InterfaceAddress : String Read FInterfaceAddress Write FInterfaceAddress;
  81. end;
  82. Var
  83. Application : THTTPApplication;
  84. { TMySimpleFileModule }
  85. procedure TMySimpleFileModule.SendFile(const AFileName: String; AResponse: TResponse);
  86. begin
  87. AResponse.SetCustomHeader('Cross-Origin-Embedder-Policy','require-corp');
  88. AResponse.SetCustomHeader('Cross-Origin-Opener-Policy','same-origin');
  89. inherited SendFile(AFileName, AResponse);
  90. end;
  91. { THTTPApplication }
  92. procedure THTTPApplication.DoEcho(ARequest: TRequest; AResponse: TResponse);
  93. Var
  94. L : TStrings;
  95. begin
  96. L:=TStringList.Create;
  97. try
  98. L.AddStrings(['<!doctype html>',
  99. '<html>',
  100. '<head>',
  101. '<title>Echo request</title>',
  102. '</head>',
  103. '<body>'
  104. ]);
  105. DumpRequest(aRequest,L);
  106. L.AddStrings(['</body>','</html>']);
  107. AResponse.Content:=L.Text;
  108. AResponse.SendResponse;
  109. finally
  110. L.Free;
  111. end;
  112. end;
  113. procedure THTTPApplication.Doquit(ARequest: TRequest; AResponse: TResponse);
  114. Var
  115. PWD : String;
  116. begin
  117. PWD:=ARequest.QueryFields.Values['password'];
  118. if PWD='' then
  119. ARequest.ContentFields.Values['password'];
  120. if PWD=FPassword then
  121. begin
  122. AResponse.Content:='OK';
  123. AResponse.SendContent;
  124. Terminate;
  125. end
  126. else
  127. begin
  128. AResponse.Code:=403;
  129. AResponse.CodeText:='Forbidden';
  130. AResponse.SendContent;
  131. end;
  132. end;
  133. procedure THTTPApplication.DoLog(EventType: TEventType; const Msg: String);
  134. begin
  135. if Quiet then
  136. exit;
  137. if IsConsole then
  138. Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',EventType,'] ',Msg)
  139. else
  140. inherited DoLog(EventType, Msg);
  141. end;
  142. procedure THTTPApplication.DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
  143. Var
  144. Msg : String;
  145. begin
  146. if Quiet then
  147. exit;
  148. Msg:=Format('(Proxy redirect) location: %s, Method: %s, From: %s, to: %s',[aLocation,aMethod,aFromURl,atoURL]);
  149. if IsConsole then
  150. Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',etInfo,'] ',Msg)
  151. else
  152. inherited DoLog(etInfo, Msg);
  153. end;
  154. procedure THTTPApplication.Usage(Msg : String);
  155. begin
  156. if (Msg<>'') then
  157. Writeln('Error: ',Msg);
  158. Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
  159. Writeln('Where options is one or more of : ');
  160. Writeln('-A --api=path,secret Activate location API on path, using secret as accepted bearer token.');
  161. Writeln('-a --max-age=age Set max-age expiry header on returned file requests.');
  162. Writeln('-c --config=file Ini configuration file (default: simpleserver.ini)');
  163. {$ifdef unix}
  164. Writeln('-b --background fork to background');
  165. {$endif}
  166. Writeln('-d --directory=dir Base directory from which to serve files.');
  167. Writeln(' Default is current working directory: ',GetCurrentDir);
  168. Writeln('-e --echo Activate /echo URL.');
  169. Writeln('-h --help This help text');
  170. Writeln('-H --hostname=NAME Set hostname for self-signed SSL certificate');
  171. Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
  172. Writeln('-I --interface=IP Listen on this interface address only.');
  173. Writeln('-m --mimetypes=file Path of mime.types. Loaded in addition to OS known types');
  174. Writeln('-n --noindexpage Do not allow index page.');
  175. Writeln('-o --coi Enable Cross-Origin Isolation headers');
  176. Writeln('-p --port=NNNN TCP/IP port to listen on (default is 3000)');
  177. Writeln('-q --quiet Do not write diagnostic messages');
  178. Writeln('-Q --quit=PWD Register /quit URL. Send request with password variable equal to PWD to stop');
  179. Writeln('-s --ssl Use SSL');
  180. Writeln('-x --proxy=proxydef Add proxy definition. Definition is of form:');
  181. Writeln(' name:BaseURL');
  182. Writeln('');
  183. Writeln('Config file is ini file, section [Server]. Key names are long option names');
  184. Writeln('Proxies are defined in section [Proxy], Key is name, value is URL');
  185. Writeln('Locations are defined in section [Locations], Key is location name, value is path');
  186. Halt(Ord(Msg<>''));
  187. end;
  188. procedure THTTPApplication.LoadMimeTypes;
  189. begin
  190. MimeTypes.LoadKnownTypes;
  191. if MimeFile<>'' then
  192. begin
  193. MimeTypesFile:=MimeFile;
  194. if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
  195. begin
  196. Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
  197. MimeTypesFile:='';
  198. end;
  199. end;
  200. If MimeTypesFile<>'' then
  201. MimeTypes.LoadFromFile(MimeTypesFile);
  202. end;
  203. procedure THTTPApplication.AddProxy(const aProxyDef: String);
  204. Var
  205. P : Integer;
  206. N,URL : String;
  207. begin
  208. P:=Pos(':',aProxyDef);
  209. If P=0 then Raise
  210. EHTTP.CreateFmt('Invalid proxy definition: %s',[aProxyDef]);
  211. N:=Copy(aProxyDef,1,P-1);
  212. URL:=Copy(aProxyDef,P+1,Length(aProxyDef));
  213. ProxyManager.RegisterLocation(N,URL).AppendPathInfo:=True;
  214. end;
  215. procedure THTTPApplication.ReadConfigFile(const ConfigFile: string);
  216. Const
  217. SConfig = 'Server';
  218. SProxy = 'Proxy';
  219. SLocations = 'Locations';
  220. KeyPort = 'Port';
  221. KeyInterface = 'Interface';
  222. KeyDir = 'Directory';
  223. KeyIndexPage = 'IndexPage';
  224. KeyHostName = 'hostname';
  225. keyMimetypes = 'mimetypes';
  226. KeySSL = 'SSL';
  227. KeyQuiet = 'quiet';
  228. KeyQuit = 'quit';
  229. KeyEcho = 'echo';
  230. KeyNoIndexPage = 'noindexpage';
  231. KeyBackground = 'background';
  232. KeyMaxAge = 'MaxAge';
  233. KeyAPI = 'API';
  234. KeyCOI = 'CrossOriginIsolation';
  235. Var
  236. L : TStringList;
  237. P,U : String;
  238. I : Integer;
  239. begin
  240. if (ConfigFile='') or Not FileExists(ConfigFile) then exit;
  241. L:=Nil;
  242. With TMemIniFile.Create(ConfigFile) do
  243. try
  244. BaseDir:=ReadString(SConfig,KeyDir,BaseDir);
  245. Port:=ReadInteger(SConfig,KeyPort,Port);
  246. InterfaceAddress:=ReadString(SConfig,KeyInterface,InterfaceAddress);
  247. Quiet:=ReadBool(SConfig,KeyQuiet,Quiet);
  248. MimeFile:=ReadString(SConfig,keyMimetypes,MimeFile);
  249. NoIndexPage:=ReadBool(SConfig,KeyNoIndexPage,NoIndexPage);
  250. IndexPageName:=ReadString(SConfig,KeyIndexPage,IndexPageName);
  251. HostName:=ReadString(SConfig,KeyHostName,HostName);
  252. UseSSL:=ReadBool(SConfig,KeySSL,UseSSL);
  253. FBackground:=ReadBool(SConfig,Keybackground,FBackGround);
  254. FPassword:=ReadString(SConfig,KeyQuit,FPassword);
  255. FEcho:=ReadBool(SConfig,KeyEcho,FEcho);
  256. FMaxAge:=ReadInteger(SConfig,KeyMaxAge,FMaxAge);
  257. FAPISecret:=ReadString(SConfig,keyAPI,'');
  258. FCrossOriginIsolation:=ReadBool(SConfig,KeyCOI,FCrossOriginIsolation);
  259. L:=TstringList.Create;
  260. ReadSectionValues(SProxy,L,[]);
  261. For I:=0 to L.Count-1 do
  262. begin
  263. L.GetNameValue(I,P,U);
  264. if (P<>'') and (U<>'') then
  265. ProxyManager.RegisterLocation(P,U).AppendPathInfo:=true;
  266. end;
  267. L.Clear;
  268. ReadSectionValues(SLocations,L,[]);
  269. For I:=0 to L.Count-1 do
  270. begin
  271. L.GetNameValue(I,P,U);
  272. if (P<>'') and (U<>'') then
  273. RegisterFileLocation(P,U);
  274. end;
  275. finally
  276. L.Free;
  277. Free;
  278. end;
  279. end;
  280. procedure THTTPApplication.ProcessOptions;
  281. Var
  282. S : String;
  283. begin
  284. for S in GetOptionValues('x','proxy') do
  285. AddProxy(S);
  286. FAPISecret:=GetOptionValue('A','api');
  287. FEcho:=HasOption('e','echo');
  288. Quiet:=HasOption('q','quiet');
  289. FPassword:=GetOptionValue('Q','quit');
  290. Port:=StrToIntDef(GetOptionValue('p','port'),Port);
  291. LoadMimeTypes;
  292. if HasOption('d','directory') then
  293. BaseDir:=GetOptionValue('d','directory');
  294. UseSSL:=HasOption('s','ssl');
  295. if HasOption('H','hostname') then
  296. HostName:=GetOptionValue('H','hostname');
  297. if HasOption('n','noindexpage') then
  298. NoIndexPage:=True
  299. else
  300. IndexPageName:=GetOptionValue('i','indexpage');
  301. if HasOption('I','interface') then
  302. InterfaceAddress:=GetOptionValue('I','interface');
  303. FMaxAge:=StrToIntDef(GetOptionValue('a','max-age'),FMaxAge);
  304. FBackground:=HasOption('b','background');
  305. FCrossOriginIsolation:=hasOption('o','coi');
  306. end;
  307. procedure THTTPApplication.Writeinfo;
  308. Var
  309. I : Integer;
  310. begin
  311. Log(etInfo,'Listening on port %d, serving files from directory: %s (using SSL: %s)',[Port,BaseDir,BoolToStr(UseSSL,'true','false')]);
  312. For I:=0 to ProxyManager.LocationCount-1 do
  313. with ProxyManager.Locations[i] do
  314. Log(etInfo,'Proxy location /proxy/%s redirects to %s',[Path,URL]);
  315. if not NoIndexPage then
  316. Log(etInfo,'Using index page %s',[IndexPageName]);
  317. Log(etInfo,'Location REST API '+IfThen(FAPISecret<>'','','NOT ')+'activated.');
  318. end;
  319. procedure THTTPApplication.DoRun;
  320. Var
  321. S,ConfigFile : String;
  322. begin
  323. FMaxAge:=31557600;
  324. S:=Checkoptions('hqd:ni:p:sH:m:x:c:beQ:a:A:o',['help','quiet','noindexpage','directory:','port:','indexpage:','ssl','hostname:','mimetypes:','proxy:','config:','background','echo','quit:','max-age:','api:','coi']);
  325. if (S<>'') or HasOption('h','help') then
  326. usage(S);
  327. if HasOption('c','config') then
  328. ConfigFile:=GetOptionValue('c','config')
  329. else
  330. ConfigFile:='simpleserver.ini';
  331. ReadConfigFile(ConfigFile);
  332. ProcessOptions;
  333. if FBackground then
  334. begin
  335. {$ifdef unix}
  336. if FPFork>0 then Halt(0);
  337. {$else}
  338. Log(etError,'Background option not supported');
  339. {$endif}
  340. end;
  341. if FPassword<>'' then
  342. HTTPRouter.RegisterRoute('/quit',rmAll,@Doquit,False);
  343. if FEcho then
  344. HTTPRouter.RegisterRoute('/echo',rmAll,@DoEcho,False);
  345. if ProxyManager.LocationCount>0 then
  346. begin
  347. TProxyWebModule.RegisterModule('Proxy',True);
  348. ProxyManager.OnLog:=@DoProxyLog;
  349. end;
  350. DefaultCacheControlMaxAge:=FMaxAge; // one year by default
  351. if BaseDir='' then
  352. BaseDir:=GetCurrentDir;
  353. if (BaseDir<>'') then
  354. BaseDir:=IncludeTrailingPathDelimiter(BaseDir);
  355. if FAPISecret<>'' then
  356. TFPWebFileLocationAPIModule.RegisterFileLocationAPI(ExtractWord(1,FAPISecret,[',']),ExtractWord(2,FAPISecret,[',']));
  357. if FCrossOriginIsolation then
  358. TSimpleFileModule.DefaultSimpleFileModuleClass:=TMySimpleFileModule;
  359. TSimpleFileModule.RegisterDefaultRoute;
  360. TSimpleFileModule.BaseDir:=BaseDir;
  361. TSimpleFileModule.OnLog:=@Log;
  362. If not NoIndexPage then
  363. begin
  364. if (IndexPageName='') then
  365. IndexPageName:='index.html';
  366. TSimpleFileModule.IndexPageName:=IndexPageName;
  367. end;
  368. if not Quiet then
  369. WriteInfo;
  370. if InterfaceAddress<>'' then
  371. HTTPHandler.Address:=InterfaceAddress;
  372. inherited;
  373. end;
  374. begin
  375. Application:=THTTPApplication.Create(Nil);
  376. Application.Initialize;
  377. Application.Run;
  378. Application.Free;
  379. end.