* Add .ini config file possibility, plus simple proxy server config

git-svn-id: trunk@42985 -

packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -4,13 +4,16 @@
 program simpleserver;
 
 uses
-  sysutils,
+  sysutils,Classes,
 {$ifdef USEGNUTLS}
   gnutlssockets,
 {$else}
   opensslsockets,
 {$endif}
-  sslbase,custhttpapp, fpmimetypes, fpwebfile;
+  {$ifdef unix}
+  baseunix,
+  {$endif}
+  inifiles, sslbase,httpdefs, custhttpapp, fpmimetypes, fpwebfile, fpwebproxy;
 
 Type
 
@@ -18,13 +21,27 @@ Type
 
   THTTPApplication = Class(TCustomHTTPApplication)
   private
+    FBaseDir: string;
+    FIndexPageName: String;
+    FMimeFile: String;
+    FNoIndexPage: Boolean;
     FQuiet: Boolean;
+    FBackground : Boolean;
+    procedure AddProxy(const aProxyDef: String);
+    procedure DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
     procedure LoadMimeTypes;
+    procedure ProcessOptions;
+    procedure ReadConfigFile(const ConfigFile: string);
     procedure Usage(Msg: String);
+    procedure Writeinfo;
   published
     procedure DoLog(EventType: TEventType; const Msg: String); override;
     Procedure DoRun; override;
     property Quiet : Boolean read FQuiet Write FQuiet;
+    Property MimeFile : String Read FMimeFile Write FMimeFile;
+    Property BaseDir : string Read FBaseDir Write FBaseDir;
+    Property NoIndexPage : Boolean Read FNoIndexPage Write FNoIndexPage;
+    Property IndexPageName : String Read FIndexPageName Write FIndexPageName;
   end;
 
 Var
@@ -42,6 +59,21 @@ begin
     inherited DoLog(EventType, Msg);
 end;
 
+procedure THTTPApplication.DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
+
+Var
+  Msg : String;
+
+begin
+  if Quiet then
+    exit;
+  Msg:=Format('(Proxy redirect) location: %s, Method: %s, From: %s, to: %s',[aLocation,aMethod,aFromURl,atoURL]);
+  if IsConsole then
+    Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',etInfo,'] ',Msg)
+  else
+    inherited DoLog(etInfo, Msg);
+end;
+
 procedure THTTPApplication.Usage(Msg : String);
 
 begin
@@ -49,6 +81,10 @@ begin
     Writeln('Error: ',Msg);
   Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
   Writeln('Where options is one or more of : ');
+  Writeln('-c --config=file    Ini configuration file (default: simpleserver.ini)');
+{$ifdef unix}
+  Writeln('-b --background     fork to background');
+{$endif}
   Writeln('-d --directory=dir  Base directory from which to serve files.');
   Writeln('                    Default is current working directory: ',GetCurrentDir);
   Writeln('-h --help           This help text');
@@ -59,6 +95,11 @@ begin
   Writeln('-q --quiet          Do not write diagnostic messages');
   Writeln('-s --ssl            Use SSL');
   Writeln('-H --hostname=NAME  set hostname for self-signed SSL certificate');
+  Writeln('-x --proxy=proxydef Add proxy definition. Definition is of form:');
+  Writeln('                    name:BaseURL');
+  Writeln('');
+  Writeln('Config file is ini file, section [Server]. Key names are long option names');
+  Writeln('Proxies are defined in section [Proxy], Key is name, value is URL');
   Halt(Ord(Msg<>''));
 end;
 
@@ -66,9 +107,9 @@ procedure THTTPApplication.LoadMimeTypes;
 
 begin
   MimeTypes.LoadKnownTypes;
-  if HasOption('m','mimetypes') then
+  if MimeFile<>'' then
     begin
-    MimeTypesFile:=GetOptionValue('m','mimetypes');
+    MimeTypesFile:=MimeFile;
     if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
       begin
       Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
@@ -79,40 +120,157 @@ begin
     MimeTypes.LoadFromFile(MimeTypesFile);  
 end;
 
-procedure THTTPApplication.DoRun;
+procedure THTTPApplication.AddProxy(Const aProxyDef : String);
 
 Var
-  S,IndexPage,D : String;
+  P : Integer;
+  N,URL : String;
 
 begin
-  S:=Checkoptions('hqd:ni:p:sH:m:',['help','quiet','noindexpage','directory:','port:','indexpage:','ssl','hostname:','mimetypes:']);
-  if (S<>'') or HasOption('h','help') then
-    usage(S);
+  P:=Pos(':',aProxyDef);
+  If P=0 then Raise
+    EHTTP.CreateFmt('Invalid proxy definition: %s',[aProxyDef]);
+  N:=Copy(aProxyDef,1,P-1);
+  URL:=Copy(aProxyDef,P+1,Length(aProxyDef));
+  ProxyManager.RegisterLocation(N,URL);
+end;
+
+
+procedure THTTPApplication.ReadConfigFile(Const ConfigFile : string);
+
+Const
+  SConfig  = 'Server';
+  SProxy = 'Proxy';
+  KeyPort  = 'Port';
+  KeyDir   = 'Directory';
+  KeyIndexPage = 'IndexPage';
+  KeyHostName = 'hostname';
+  keyMimetypes = 'mimetypes';
+  KeySSL = 'SSL';
+  KeyQuiet = 'quiet';
+  KeyNoIndexPage = 'noindexpage';
+  KeyBackground = 'background';
+
+Var
+  L : TStringList;
+  P,U : String;
+  I : Integer;
+
+begin
+  if (ConfigFile='') or Not FileExists(ConfigFile) then exit;
+  L:=Nil;
+  With TMemIniFile.Create(ConfigFile) do
+    try
+      BaseDir:=ReadString(SConfig,KeyDir,BaseDir);
+      Port:=ReadInteger(SConfig,KeyPort,Port);
+      Quiet:=ReadBool(SConfig,KeyQuiet,Quiet);
+      MimeFile:=ReadString(SConfig,keyMimetypes,MimeFile);
+      NoIndexPage:=ReadBool(SConfig,KeyNoIndexPage,NoIndexPage);
+      IndexPageName:=ReadString(SConfig,KeyIndexPage,IndexPageName);
+      HostName:=ReadString(SConfig,KeyHostName,HostName);
+      UseSSL:=ReadBool(SConfig,KeySSL,UseSSL);
+      FBackground:=ReadBool(SConfig,Keybackground,FBackGround);
+
+      L:=TstringList.Create;
+      ReadSectionValues(SProxy,L,[]);
+      For I:=0 to L.Count-1 do
+        begin
+        L.GetNameValue(I,P,U);
+        if (P<>'') and (U<>'') then
+          ProxyManager.RegisterLocation(P,U);
+        end;
+    finally
+      L.Free;
+      Free;
+    end;
+end;
+
+procedure THTTPApplication.ProcessOptions;
+
+Var
+  S : String;
+
+begin
+  for S in GetOptionValues('x','proxy') do
+    AddProxy(S);
   Quiet:=HasOption('q','quiet');
-  Port:=StrToIntDef(GetOptionValue('p','port'),3000);
+  Port:=StrToIntDef(GetOptionValue('p','port'),Port);
   LoadMimeTypes;
-  D:=GetOptionValue('d','directory');
-  if D='' then
-    D:=GetCurrentDir;
-  Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
+  if HasOption('d','directory') then
+    BaseDir:=GetOptionValue('d','directory');
   UseSSL:=HasOption('s','ssl');
   if HasOption('H','hostname') then
     HostName:=GetOptionValue('H','hostname');
-  TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
+  if HasOption('n','noindexpage') then
+    NoIndexPage:=True
+  else
+    IndexPageName:=GetOptionValue('i','indexpage');
+  FBackground:=HasOption('b','background');
+end;
+
+procedure THTTPApplication.Writeinfo;
+
+Var
+  I : Integer;
+
+begin
+  Log(etInfo,'Listening on port %d, serving files from directory: %s (using SSL: %s)',[Port,BaseDir,BoolToStr(UseSSL,'true','false')]);
+  For I:=0 to ProxyManager.LocationCount-1 do
+    with ProxyManager.Locations[i] do
+      Log(etInfo,'Proxy location /proxy/%s redirects to %s',[Path,URL]);
+  if not NoIndexPage then
+    Log(etInfo,'Using index page %s',[IndexPageName]);
+end;
+
+procedure THTTPApplication.DoRun;
+
+Var
+  S,ConfigFile : String;
+
+begin
+  S:=Checkoptions('hqd:ni:p:sH:m:x:c:b',['help','quiet','noindexpage','directory:','port:','indexpage:','ssl','hostname:','mimetypes:','proxy:','config:','background']);
+  if (S<>'') or HasOption('h','help') then
+    usage(S);
+  if HasOption('c','config') then
+    ConfigFile:=GetOptionValue('c','config')
+  else
+    ConfigFile:='simpleserver.ini';
+  ReadConfigFile(ConfigFile);
+  ProcessOptions;
+  if FBackground then
+    begin
+{$ifdef unix}
+    if FPFork>0 then Halt(0);
+{$else}
+    Log(erError,'Background option not supported');
+{$endif}
+    end;
+
+  if ProxyManager.LocationCount>0 then
+    begin
+    TProxyWebModule.RegisterModule('Proxy',True);
+    ProxyManager.OnLog:=@DoProxyLog;
+    end;
+  if BaseDir='' then
+    BaseDir:=GetCurrentDir;
+  if (BaseDir<>'') then
+    BaseDir:=IncludeTrailingPathDelimiter(BaseDir);
+  TSimpleFileModule.RegisterDefaultRoute;
+  TSimpleFileModule.BaseDir:=BaseDir;
   TSimpleFileModule.OnLog:=@Log;
-  If not HasOption('n','noindexpage') then
+  If not NoIndexPage then
     begin
-    IndexPage:=GetOptionValue('i','indexpage');
-    if IndexPage='' then
-      IndexPage:='index.html';
-    Log(etInfo,'Using index page %s',[IndexPage]);
-    TSimpleFileModule.IndexPageName:=IndexPage;
+    if (IndexPageName='') then
+      IndexPageName:='index.html';
+    TSimpleFileModule.IndexPageName:=IndexPageName;
     end;
+  if not Quiet then
+    WriteInfo;
+
   inherited;
 end;
 
 begin
-  TSimpleFileModule.RegisterDefaultRoute;
   Application:=THTTPApplication.Create(Nil);
   Application.Initialize;
   Application.Run;