* Merging revisions 43060,43061,43063,43064,43065,43066,43080,43081 from trunk:

    ------------------------------------------------------------------------
    r43060 | michael | 2019-09-23 17:14:35 +0200 (Mon, 23 Sep 2019) | 1 line
    
    * Fix appending path info and setting headers
    ------------------------------------------------------------------------
    r43061 | michael | 2019-09-23 17:19:25 +0200 (Mon, 23 Sep 2019) | 1 line
    
    * Use AppendPathInfo
    ------------------------------------------------------------------------
    r43063 | michael | 2019-09-25 16:06:28 +0200 (Wed, 25 Sep 2019) | 1 line
    
    * Add (cust)microhttpapp, high-concurrency standalone server
    ------------------------------------------------------------------------
    r43064 | michael | 2019-09-25 17:38:20 +0200 (Wed, 25 Sep 2019) | 1 line
    
    * Improve header & get variable fetching
    ------------------------------------------------------------------------
    r43065 | michael | 2019-09-25 17:40:19 +0200 (Wed, 25 Sep 2019) | 1 line
    
    * remove forced debug flag
    ------------------------------------------------------------------------
    r43066 | michael | 2019-09-25 17:49:28 +0200 (Wed, 25 Sep 2019) | 1 line
    
    * Construct query string, needed in proxy
    ------------------------------------------------------------------------
    r43080 | michael | 2019-09-26 15:29:26 +0200 (Thu, 26 Sep 2019) | 1 line
    
    * Set namevalueseparator for headers
    ------------------------------------------------------------------------
    r43081 | michael | 2019-09-26 15:54:23 +0200 (Thu, 26 Sep 2019) | 1 line
    
    * Allow max-age for cache control
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43260 -

.gitattributes

@@ -3356,6 +3356,7 @@ packages/fcl-web/src/base/custcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custfcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/custhttpapp.pp svneol=native#text/plain
 packages/fcl-web/src/base/custhttpsys.pp svneol=native#text/pascal
+packages/fcl-web/src/base/custmicrohttpapp.pp svneol=native#text/plain
 packages/fcl-web/src/base/custweb.pp svneol=native#text/plain
 packages/fcl-web/src/base/ezcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/fcgigate.pp svneol=native#text/plain
@@ -3384,6 +3385,7 @@ packages/fcl-web/src/base/httpdefs.pp svneol=native#text/plain
 packages/fcl-web/src/base/httpprotocol.pp svneol=native#text/plain
 packages/fcl-web/src/base/httproute.pp svneol=native#text/plain
 packages/fcl-web/src/base/iniwebsession.pp svneol=native#text/plain
+packages/fcl-web/src/base/microhttpapp.pp svneol=native#text/plain
 packages/fcl-web/src/base/restbase.pp svneol=native#text/plain
 packages/fcl-web/src/base/restcodegen.pp svneol=native#text/plain
 packages/fcl-web/src/base/tcwebmodule.pp svneol=native#text/plain

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

@@ -1,25 +1,45 @@
 {$mode objfpc}
 {$h+}
-{ $define USEGNUTLS}
+
+{ $DEFINE USEGNUTLS}
+{$DEFINE USEMICROHTTP}
+
 program simpleserver;
 
+{$IFDEF USEMICROHTTP}
+{$UNDEF USEGNUTLS}
+{$ENDIF}
+
 uses
-  sysutils,Classes,
+
+
+
+{$IFNDEF USEMICROHTTP}
 {$ifdef USEGNUTLS}
   gnutlssockets,
 {$else}
   opensslsockets,
 {$endif}
+  custhttpapp,
+{$ELSE}
+  cthreads,
+  custmicrohttpapp,
+{$ENDIF}
   {$ifdef unix}
   baseunix,
   {$endif}
-  inifiles, sslbase,httpdefs, custhttpapp, fpmimetypes, fpwebfile, fpwebproxy;
+  sysutils,Classes, inifiles, sslbase, httproute, httpdefs, fpmimetypes, fpwebfile, fpwebproxy, webutil;
 
 Type
 
   { THTTPApplication }
+{$IFDEF USEMICROHTTP}
+  TParentApp = TCustomMicroHTTPApplication;
+{$ELSE}
+  TParentApp = TCustomHTTPApplication;
+{$ENDIF}
 
-  THTTPApplication = Class(TCustomHTTPApplication)
+  THTTPApplication = Class(TParentApp)
   private
     FBaseDir: string;
     FIndexPageName: String;
@@ -27,8 +47,12 @@ Type
     FNoIndexPage: Boolean;
     FQuiet: Boolean;
     FBackground : Boolean;
+    FPassword : string;
+    FEcho : Boolean;
     procedure AddProxy(const aProxyDef: String);
+    procedure DoEcho(ARequest: TRequest; AResponse: TResponse);
     procedure DoProxyLog(Sender: TObject; const aMethod, aLocation, aFromURL, aToURL: String);
+    procedure Doquit(ARequest: TRequest; AResponse: TResponse);
     procedure LoadMimeTypes;
     procedure ProcessOptions;
     procedure ReadConfigFile(const ConfigFile: string);
@@ -49,6 +73,52 @@ Var
 
 { THTTPApplication }
 
+procedure THTTPApplication.DoEcho(ARequest: TRequest; AResponse: TResponse);
+
+Var
+  L : TStrings;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.AddStrings(['<!doctype html>',
+      '<html>',
+      '<head>',
+      '<title>Echo request</title>',
+      '</head>',
+      '<body>'
+    ]);
+    DumpRequest(aRequest,L);
+    L.AddStrings(['</body>','</html>']);
+    AResponse.Content:=L.Text;
+    AResponse.SendResponse;
+  finally
+    L.Free;
+  end;
+end;
+procedure THTTPApplication.Doquit(ARequest: TRequest; AResponse: TResponse);
+
+Var
+  PWD : String;
+
+begin
+  PWD:=ARequest.QueryFields.Values['password'];
+  if PWD='' then
+    ARequest.ContentFields.Values['password'];
+  if PWD=FPassword then
+    begin
+    AResponse.Content:='OK';
+    AResponse.SendContent;
+    Terminate;
+    end
+  else
+    begin
+    AResponse.Code:=403;
+    AResponse.CodeText:='Forbidden';
+    AResponse.SendContent;
+    end;
+end;
+
 procedure THTTPApplication.DoLog(EventType: TEventType; const Msg: String);
 begin
   if Quiet then
@@ -93,6 +163,8 @@ begin
   Writeln('-p --port=NNNN      TCP/IP port to listen on (default is 3000)');
   Writeln('-m --mimetypes=file path of mime.types. Loaded in addition to OS known types');
   Writeln('-q --quiet          Do not write diagnostic messages');
+  Writeln('-Q --quit=PWD       register /quit url. Send request with password variable equal to PWD to stop');
+  Writeln('-e --echo       register /quit url. Send request with password variable equal to PWD to stop');
   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:');
@@ -132,7 +204,7 @@ begin
     EHTTP.CreateFmt('Invalid proxy definition: %s',[aProxyDef]);
   N:=Copy(aProxyDef,1,P-1);
   URL:=Copy(aProxyDef,P+1,Length(aProxyDef));
-  ProxyManager.RegisterLocation(N,URL);
+  ProxyManager.RegisterLocation(N,URL).AppendPathInfo:=True;
 end;
 
 
@@ -148,6 +220,8 @@ Const
   keyMimetypes = 'mimetypes';
   KeySSL = 'SSL';
   KeyQuiet = 'quiet';
+  KeyQuit = 'quit';
+  KeyEcho = 'echo';
   KeyNoIndexPage = 'noindexpage';
   KeyBackground = 'background';
 
@@ -170,14 +244,15 @@ begin
       HostName:=ReadString(SConfig,KeyHostName,HostName);
       UseSSL:=ReadBool(SConfig,KeySSL,UseSSL);
       FBackground:=ReadBool(SConfig,Keybackground,FBackGround);
-
+      FPassword:=ReadString(SConfig,KeyQuit,FPassword);
+      FEcho:=ReadBool(SConfig,KeyEcho,FEcho);
       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);
+          ProxyManager.RegisterLocation(P,U).AppendPathInfo:=true;
         end;
     finally
       L.Free;
@@ -193,7 +268,9 @@ Var
 begin
   for S in GetOptionValues('x','proxy') do
     AddProxy(S);
+  FEcho:=HasOption('e','echo');
   Quiet:=HasOption('q','quiet');
+  FPassword:=GetOptionValue('Q','quit');
   Port:=StrToIntDef(GetOptionValue('p','port'),Port);
   LoadMimeTypes;
   if HasOption('d','directory') then
@@ -228,7 +305,7 @@ 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']);
+  S:=Checkoptions('hqd:ni:p:sH:m:x:c:beQ:',['help','quiet','noindexpage','directory:','port:','indexpage:','ssl','hostname:','mimetypes:','proxy:','config:','background','echo','quit:']);
   if (S<>'') or HasOption('h','help') then
     usage(S);
   if HasOption('c','config') then
@@ -245,7 +322,10 @@ begin
     Log(erError,'Background option not supported');
 {$endif}
     end;
-
+  if FPassword<>'' then
+    HTTPRouter.RegisterRoute('/quit',rmAll,@Doquit,False);
+  if FEcho  then
+    HTTPRouter.RegisterRoute('/echo',rmAll,@DoEcho,False);
   if ProxyManager.LocationCount>0 then
     begin
     TProxyWebModule.RegisterModule('Proxy',True);
@@ -266,7 +346,6 @@ begin
     end;
   if not Quiet then
     WriteInfo;
-
   inherited;
 end;
 

packages/fcl-web/src/base/custmicrohttpapp.pp

@@ -0,0 +1,770 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    TCustomMicroHTTPApplication class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ $define CGIDEBUG}
+{$mode objfpc}
+{$H+}
+
+unit custmicrohttpapp;
+
+Interface
+
+uses
+  Classes, SysUtils, httpprotocol, httpdefs, custweb, libmicrohttpd;
+
+Type
+  TCustomMicroHTTPApplication = Class;
+  TMicroServerOption = (
+     mcoDebug,
+     mcoSSL,
+     mcoThreadPerConnection,
+     mcoSelectInternally,
+     mcoIPV6,
+     mcoPedanticChecks,
+     mcoPoll,
+     mcoSuppressDateNoClock,
+     mcoNoListenSocket,
+     mcoEPollLinuxOnly,
+     mcoPipeForShutdown,
+     mcoDualStack,
+     mcoEPollTurbo,
+     mcoSuspendResume,
+     mcoTCPFastOpen
+  );
+  TMicroServerOptions = Set of TMicroServerOption;
+
+  TMicroHTTPHandler = Class;
+  TRequestHandler = Class;
+
+  { TMicroRequest }
+
+  TMicroRequest = Class(TRequest)
+  Private
+    FHandler : TRequestHandler;
+    FMyQueryString : String;
+    // Return amount of data handled
+    Procedure DoSetHeader(K,V : String);
+    Procedure AddQueryField(K,V : String);
+    Function AddData(Data: PAnsiChar; DataSize: Size_t) : Size_t;
+    Procedure Initialize(const aUrl, aMethod, aVersion: String);
+    procedure InitRequestVars; override;
+  Protected
+    Property Handler : TRequestHandler Read FHandler;
+  end;
+
+  { TMicroResponse }
+
+  TMicroResponse = Class(TResponse)
+  Private
+    FHandler : TRequestHandler;
+    FResponse : PMHD_Response;
+  Protected
+    Procedure MaybeAllocateResponse; virtual;
+    Procedure DoSendHeaders(Headers: TStrings); override;
+    Procedure DoSendContent; override;
+    Property Handler : TRequestHandler Read FHandler;
+    Property Response : PMHD_Response Read FResponse;
+  Public
+    Destructor Destroy; override;
+  end;
+
+  { TRequestHandler }
+
+  TRequestHandler = Class
+    FConnection : PMHD_Connection;
+    FWebHandler : TMicroHTTPHandler;
+    FRequest : TMicroRequest;
+    FResponse : TMicroResponse;
+  Public
+    Constructor Create(aHandler : TMicroHTTPHandler; aConnection :PMHD_Connection);
+    Destructor Destroy; override;
+    Procedure Initialize(const aUrl, aMethod, aVersion: String);
+    Function ContinueRequest(Data: PAnsiChar; var DataSize: Size_t) : Cint;
+    Property Connection : PMHD_Connection Read FConnection;
+    Property WebHandler : TMicroHTTPHandler Read FWebHandler;
+    Property Request : TMicroRequest Read FRequest;
+    Property Response : TMicroResponse Read FResponse;
+  end;
+
+  { TMicroHTTPHandler }
+
+  TAcceptHandler = Procedure (Sender : TObject; Addr : PSockAddr; addrLen : socklen_t; var Allow : Boolean) of object;
+  TRequestErrorHandler = Procedure (Sender : TObject; E : Exception) of object;
+
+  TMicroHTTPHandler = class(TWebHandler)
+  Private
+    FAcceptHandler: TAcceptHandler;
+    FExtraHeaders: TStrings;
+    FOnRequestError: TRequestErrorHandler;
+    FPort : Word;
+    FOptions: TMicroServerOptions;
+    FServer: PMHD_Daemon;
+    FHostName : string;
+    procedure MaybeStopServer;
+    procedure RequestCompleted(aRequest: TRequestHandler);
+    function DoRequest(connection: PMHD_Connection; const aUrl, aMethod, aVersion: String; Data: PAnsiChar; var DataSize: Size_t): TRequestHandler;
+    procedure SetExtraHeaders(AValue: TStrings);
+    procedure SetHostName(AValue: String);
+    procedure SetOptions(AValue: TMicroServerOptions);
+    procedure SetPort(const AValue: Word);
+  protected
+    function OptionsToFlags : Integer;
+    Function DoAcceptConnection(Addr : PSockAddr; addrLen : socklen_t) : Boolean;
+    procedure CheckInactive;
+    function CreateServer: PMHD_Daemon; virtual;
+    procedure HandleRequestError(Sender: TObject; E: Exception); virtual;
+    Procedure InitRequest(ARequest : TRequest); override;
+    Procedure InitResponse(AResponse : TResponse); override;
+    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
+    Property Daemon : PMHD_Daemon Read FServer;
+  Public
+    Procedure Run; override;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    // Port to listen on.
+    Property Port : Word Read FPort Write SetPort Default 80;
+    // HostName to use when using SSL
+    Property HostName : String Read FHostName Write SetHostName;
+    // ServerOPtions
+    Property Options : TMicroServerOptions Read FOptions Write SetOptions;
+    // On Accept handler
+    Property OnAccept : TAcceptHandler Read FAcceptHandler Write FAcceptHandler;
+    // Handle On Request error. If not set, error is logged.
+    Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
+    // Extra non-standard headers which can be accepted as part of requests
+    Property ExtraHeaders : TStrings Read FExtraHeaders Write SetExtraHeaders;
+  end;
+
+  { TCustomMicroHTTPApplication }
+
+  TCustomMicroHTTPApplication = Class(TCustomWebApplication)
+  private
+    function GetExtraHeaders: TStrings;
+    function GetHostName: String;
+    function GetOptions: TMicroServerOptions;
+    function GetPort: Word;
+    function GetUseSSL: Boolean;
+    procedure SetExtraHeaders(AValue: TStrings);
+    procedure SetHostName(AValue: String);
+    procedure SetOptions(AValue: TMicroServerOptions);
+    procedure SetPort(AValue: Word);
+    procedure SetUseSSL(AValue: Boolean);
+  protected
+    function InitializeWebHandler: TWebHandler; override;
+    Function HTTPHandler : TMicroHTTPHandler;
+  Public
+    constructor Create(aOwner : TComponent); override;
+    destructor Destroy; override;
+    Property Port : Word Read GetPort Write SetPort Default 80;
+    // Hostname to use when using SSL
+    Property HostName : String Read GetHostName Write SetHostName;
+    // ServerOptions
+    Property Options : TMicroServerOptions Read GetOptions Write SetOptions;
+    // For compatibility
+    Property UseSSL : Boolean Read GetUseSSL Write SetUSeSSL;
+    // Extra non-standard headers which can be accepted as part of requests
+    Property ExtraHeaders : TStrings Read GetExtraHeaders Write SetExtraHeaders;
+  end;
+
+
+Implementation
+
+Resourcestring
+  SErrServerActive = 'Operation cannot be performed while server is active';
+  SErrFailedToStartServer = 'Failed to start server';
+
+
+Const
+  BoolToYesNo : Array[Boolean] of Integer = (MHD_NO,MHD_YES);
+
+Const
+  OptionFlags :   Array[TMicroServerOption] of Integer = (
+  MHD_USE_DEBUG,
+  MHD_USE_SSL,
+  MHD_USE_THREAD_PER_CONNECTION,
+  MHD_USE_SELECT_INTERNALLY,
+  MHD_USE_IPv6,
+  MHD_USE_PEDANTIC_CHECKS,
+  MHD_USE_POLL,
+  MHD_SUPPRESS_DATE_NO_CLOCK,
+  MHD_USE_NO_LISTEN_SOCKET,
+  MHD_USE_EPOLL_LINUX_ONLY,
+  MHD_USE_PIPE_FOR_SHUTDOWN,
+  MHD_USE_DUAL_STACK,
+  MHD_USE_EPOLL_TURBO,
+  MHD_USE_SUSPEND_RESUME,
+  MHD_USE_TCP_FASTOPEN);
+
+{ ---------------------------------------------------------------------
+  libmicrohttp Callbacks
+  ---------------------------------------------------------------------}
+
+Function MaybeS(p : pchar) : String;
+begin
+  if Assigned(P) then Result:=P else Result:='';
+end;
+
+function GetRequestData(cls: Pointer; kind: MHD_ValueKind; key: Pcchar; value: Pcchar): cint; cdecl;
+
+var
+  K,V : String;
+
+
+begin
+  K:=MaybeS(key);
+  V:=MaybeS(Value);
+  if kind=MHD_HEADER_KIND then
+    TMicroRequest(Cls).DoSetHeader(K,V)
+  else if kind=MHD_GET_ARGUMENT_KIND then
+    TMicroRequest(Cls).AddQueryField(K,V);
+  Result:=MHD_YES;
+end;
+
+
+procedure DoPanic(cls: Pointer; &file: Pcchar; line: cuint; reason: Pcchar); cdecl;
+
+begin
+  if Assigned(cls) then
+    TCustomMicroHTTPApplication(Cls).Log(etError,Format('Panic at %s(%d): %s ',[MaybeS(&File),line,MaybeS(reason)]))
+  else if IsConsole then
+    writeln('Panic: File ',MaybeS(&File),'(',line,')',MaybeS(Reason));
+end;
+
+
+function DoReadResponse(cls: pointer; pos: cuint64; buf: Pcchar; max: size_t): ssize_t; cdecl;
+
+Var
+  Resp : TMicroResponse;
+
+begin
+  Resp:=TMicroResponse(cls);
+  if Pos<>Resp.ContentStream.Position then
+    Resp.ContentStream.Position:=Pos;
+  Result:=Resp.ContentStream.Read(buf^,max);
+end;
+
+
+function AcceptCallBack(cls: Pointer; addr: psockaddr; addrlen: socklen_t): cint; cdecl;
+begin
+  Result:=BoolToYesNo[TMicroHTTPHandler(Cls).DoAcceptConnection(addr,addrlen)];
+end;
+
+
+function DoMHDRequest(cls: Pointer; connection: PMHD_Connection; url: Pcchar; method: Pcchar; version: Pcchar; upload_data: Pcchar;
+  upload_data_size: pSize_t; con_cls: PPointer): cint; cdecl;
+
+Var
+  aURL : String;
+  aMethod : String;
+  aVersion : String;
+  H : TMicroHTTPHandler;
+
+begin
+  aURL:=URl;
+  aMethod:=Method;
+  aVersion:=Version;
+  if (Con_cls^=Nil) then
+    begin
+    H:=TMicroHTTPHandler(Cls);
+    Con_cls^:=H.DoRequest(connection,aURL,aMethod,aVersion,Upload_Data,Upload_data_size^);
+    Result:=BoolToYesNo[con_cls^<>Nil];
+    end
+  else
+    Result:=TRequestHandler(Con_cls^).ContinueRequest(Upload_Data,Upload_data_size^);
+end;
+
+procedure HandleRequestCompleted(ACls: Pointer; AConnection: PMHD_Connection; AConCls: PPointer; AToe: MHD_RequestTerminationCode); cdecl;
+var
+  Req: TRequestHandler;
+  H :  TMicroHTTPHandler;
+begin
+  Req:=TRequestHandler(AConCls^);
+  if not Assigned(Req) then
+    Exit;
+  H:=TMicroHTTPHandler(aCls);
+  if not Assigned(H) then
+    H:=Req.WebHandler;
+  if Assigned(H) then
+    H.RequestCompleted(Req)
+  else
+    Req.Free;
+  AConCls^ := nil;
+end;
+
+
+{ ---------------------------------------------------------------------
+  TMicroRequest
+  ---------------------------------------------------------------------}
+
+
+procedure TMicroRequest.DoSetHeader(K, V: String);
+
+Var
+  H :  THeader;
+
+begin
+  H:=HeaderType(K);
+  if hdRequest in HTTPHeaderDirections[h] then
+    SetHeader(H,V)
+  else
+    SetCustomHeader(K,V);
+end;
+
+procedure TMicroRequest.AddQueryField(K, V: String);
+
+Var
+  S : String;
+
+begin
+  if V<>'' then
+    QueryFields.Values[K]:=V
+  else
+    QueryFields.Add(K+'=');
+  S:=FMyQueryString;
+  if S<>'' then
+    S:=S+'&';
+  FMyQueryString:=S+K+'='+HTTPEncode(V);
+end;
+
+function TMicroRequest.AddData(Data: PAnsiChar; DataSize: Size_t): Size_t;
+
+Var
+  C : String;
+  L : Integer;
+
+begin
+  C:=Content;
+  L:=Length(C);
+  SetLength(C,L+Datasize);
+  Move(Data^,C[L+1],DataSize);
+  InitContent(C);
+  Result:=Datasize;
+end;
+
+procedure TMicroRequest.Initialize(const aUrl, aMethod, aVersion: String);
+
+begin
+  SetHTTPVariable(hvURL,aURL);
+  SetHTTPVariable(hvMethod,aMethod);
+  SetHTTPVariable(hvHTTPVersion,aVersion);
+  InitRequestVars;
+end;
+
+procedure TMicroRequest.InitRequestVars;
+
+Var
+  P : Pchar;
+  N,S  : String;
+  I : integer;
+
+begin
+  MHD_get_connection_values(FHandler.FConnection, MHD_GET_ARGUMENT_KIND,@GetRequestData,Self);
+  MHD_get_connection_values(FHandler.FConnection, MHD_HEADER_KIND,@GetRequestData,Self);
+  for N in FHandler.WebHandler.ExtraHeaders do
+    begin
+    P:=MHD_lookup_connection_value(FHandler.FConnection, MHD_HEADER_KIND,Pchar(N));
+    If P<>Nil then
+      SetCustomHeader(N,P);
+    end;
+  S:=URL;
+  I:=Pos('?',S);
+  if (I>0) then
+    S:=Copy(S,1,I-1);
+  If (Length(S)>1) and (S[1]<>'/') then
+    S:='/'+S
+  else if S='/' then
+    S:='';
+  PathInfo:=S;
+  Inherited;
+  // We set this afterwards, otherwise double processing
+  if FMyQueryString<>'' then
+    SetHTTPVariable(hvQuery,FMyQueryString)
+end;
+
+{ ---------------------------------------------------------------------
+  TMicroResponse
+  ---------------------------------------------------------------------}
+
+procedure TMicroResponse.MaybeAllocateResponse;
+
+Var
+  L : Integer;
+  P : PChar;
+  B : TBytes;
+
+begin
+  if FResponse<>Nil then exit;
+  if Assigned(ContentStream) then
+    begin
+    ContentStream.Position:=0;
+    L:=ContentStream.Size;
+    if FreeContentStream then
+      FResponse:=MHD_create_response_from_callback(L,4096,@DoReadResponse,Self,Nil)
+    else
+      // We must copy the bytes, because we don't know when the stream is freed.
+      begin
+      SetLength(B,L);
+      ContentStream.ReadBuffer(B[0],L);
+      P:=Pchar(B);
+      FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
+      end;
+    end
+  else
+    begin
+    L:=Length(Content);
+    P:=PChar(Content);
+    FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
+    end;
+end;
+
+procedure TMicroResponse.DoSendHeaders(Headers: TStrings);
+
+Var
+  I : Integer;
+  N,V : String;
+
+begin
+  // Note that if the response is allocated, then you cannot set the content stream any more...
+  MaybeAllocateResponse;
+  Headers.NameValueSeparator:=':';
+  For I:=0 to Headers.Count-1 do
+    begin
+    Headers.GetNameValue(I,N,V);
+    MHD_add_response_header(FResponse,PAnsiChar(N),PAnsiChar(V));
+    end;
+end;
+
+procedure TMicroResponse.DoSendContent;
+begin
+  MaybeAllocateResponse;
+  MHD_queue_response(FHandler.FConnection,Self.Code,FResponse);
+end;
+
+destructor TMicroResponse.Destroy;
+begin
+  if (FResponse<>Nil) then
+    MHD_destroy_response(FResponse);
+  inherited Destroy;
+end;
+
+{ ---------------------------------------------------------------------
+  TRequestHandler
+  ---------------------------------------------------------------------}
+
+constructor TRequestHandler.Create(aHandler: TMicroHTTPHandler; aConnection: PMHD_Connection);
+begin
+  FWebHandler:=aHandler;
+  FConnection:=aConnection;
+  FRequest:=TMicroRequest.Create;
+  FRequest.FHandler:=Self;
+  FResponse:=TMicroResponse.Create(FRequest);
+  FResponse.FHandler:=Self;
+end;
+
+destructor TRequestHandler.Destroy;
+begin
+  FreeAndNil(FRequest);
+  FreeAndNil(FResponse);
+  inherited Destroy;
+end;
+
+procedure TRequestHandler.Initialize(const aUrl, aMethod, aVersion: String);
+begin
+  FRequest.Initialize(aURL,aMethod,aVersion);
+end;
+
+function TRequestHandler.ContinueRequest(Data: PAnsiChar; var DataSize: Size_t): Cint;
+
+Var
+  CanHandleRequest : Boolean;
+
+begin
+  CanHandleRequest:=Datasize=0;
+  if Datasize>0 then
+    DataSize:=DataSize-FRequest.AddData(Data,Datasize);
+  If Not CanHandleRequest then
+    Result:=BoolToYesNo[DataSize=0]
+  else
+    begin
+    try
+      WebHandler.HandleRequest(FRequest,FResponse);
+      If Not FResponse.ContentSent then
+        try
+          FResponse.SendContent;
+        except
+          On E : Exception do
+            WebHandler.HandleRequestError(WebHandler,E);
+        end;
+      Result:=MHD_YES;
+    except
+      On E : Exception do
+        begin
+        Result:=MHD_NO;
+        WebHandler.HandleRequestError(WebHandler,E);
+        end;
+    end;
+    end;
+end;
+
+
+{ ---------------------------------------------------------------------
+  TMicroHTTPHandler
+  ---------------------------------------------------------------------}
+
+procedure TMicroHTTPHandler.RequestCompleted(aRequest: TRequestHandler);
+
+begin
+  try
+    EndRequest(aRequest.FRequest,aRequest.FResponse);
+    aRequest.FRequest:=Nil;
+    aRequest.FResponse:=Nil;
+    aRequest.Free;
+  except
+    On E: Exception do
+      HandleRequestError(Self,E);
+  end;
+end;
+
+function TMicroHTTPHandler.DoRequest(connection: PMHD_Connection; Const aUrl,aMethod,aVersion: String; Data: PAnsiChar; var DataSize: Size_t) : TRequestHandler;
+
+begin
+  Result:=TRequestHandler.Create(Self,Connection);
+  Result.Initialize(aURl,aMethod,AVersion);
+  if (DataSize>0) then
+    if Result.ContinueRequest(Data,Datasize)<>MHD_YES then
+      FreeAndNil(Result);
+end;
+
+procedure TMicroHTTPHandler.SetExtraHeaders(AValue: TStrings);
+begin
+  if FExtraHeaders=AValue then Exit;
+  FExtraHeaders.Assign(AValue);
+end;
+
+procedure TMicroHTTPHandler.HandleRequestError(Sender: TObject; E: Exception);
+begin
+  Try
+    If Assigned(FOnRequestError) then
+      FOnRequestError(Sender,E)
+    else
+      Log(etError,Format('Error (%s) handling request : %s',[E.ClassName,E.Message]));
+  except
+    // Do not let errors escape
+  end;
+end;
+
+procedure TMicroHTTPHandler.CheckInactive;
+
+begin
+  if Assigned(FServer) then
+    Raise EHTTP.Create(SErrServerActive);
+end;
+
+procedure TMicroHTTPHandler.SetHostName(AValue: String);
+begin
+  CheckInactive;
+  FHostName:=aValue;
+end;
+
+
+procedure TMicroHTTPHandler.SetOptions(AValue: TMicroServerOptions);
+begin
+  if FOptions=AValue then Exit;
+  CheckInactive;
+  FOptions:=AValue;
+end;
+
+procedure TMicroHTTPHandler.SetPort(const AValue: Word);
+begin
+  CheckInactive;
+  FPort:=Avalue
+end;
+
+procedure TMicroHTTPHandler.InitRequest(ARequest: TRequest);
+begin
+  inherited InitRequest(ARequest);
+end;
+
+procedure TMicroHTTPHandler.InitResponse(AResponse: TResponse);
+begin
+  inherited InitResponse(AResponse);
+end;
+
+function TMicroHTTPHandler.WaitForRequest(out ARequest: TRequest;
+  out AResponse: TResponse): boolean;
+begin
+  Result:=False;
+  ARequest:=Nil;
+  AResponse:=Nil;
+end;
+
+Function TMicroHTTPHandler.DoAcceptConnection(Addr : PSockAddr; addrLen : socklen_t) : Boolean;
+
+begin
+  Result:=True;
+  if Assigned(FAcceptHandler) then
+    FAcceptHandler(Self,Addr,addrLen,Result);
+end;
+
+
+function TMicroHTTPHandler.OptionsToFlags : Integer;
+
+Var
+  O : TMicroServerOption;
+
+begin
+  Result:=0;
+  For O in TMicroServerOption do
+    if O in Options then
+      Result:=Result or OptionFlags[O];
+end;
+
+
+function TMicroHTTPHandler.CreateServer: PMHD_Daemon;
+
+Var
+  F,P : Integer;
+
+begin
+  F:=OptionsToFlags;
+  P:=Port;
+  Result:= MHD_start_daemon(F,P,
+    @AcceptCallBack, Self,
+    @DoMHDRequest, Self,
+    MHD_OPTION_NOTIFY_COMPLETED, @HandleRequestCompleted,
+    Nil,MHD_OPTION_END);
+  if Result=Nil then
+    Writeln('a')
+  else
+    Writeln('b');
+end;
+
+procedure TMicroHTTPHandler.Run;
+begin
+  FServer:=CreateServer;
+  if (FServer=Nil) then
+    Raise EHTTP.Create(SErrFailedToStartServer);
+  Repeat
+    Sleep(50);
+  Until Terminated;
+end;
+
+procedure TMicroHTTPHandler.MaybeStopServer;
+
+begin
+  if Assigned(FServer) then
+    begin
+    MHD_stop_daemon(FServer);
+    FServer:=Nil;
+    end;
+end;
+
+constructor TMicroHTTPHandler.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FExtraHeaders:=TStringList.Create;
+  Options:=[mcoSelectInternally];
+  Port:=80;
+end;
+
+destructor TMicroHTTPHandler.Destroy;
+begin
+  MaybeStopServer;
+  FreeAndNil(FExtraHeaders);
+  inherited Destroy;
+end;
+
+
+{ ---------------------------------------------------------------------
+  TCustomMicroHTTPApplication
+  ---------------------------------------------------------------------}
+
+
+procedure TCustomMicroHTTPApplication.SetHostName(AValue: String);
+begin
+  HTTPHandler.HostName:=aValue;
+end;
+
+procedure TCustomMicroHTTPApplication.SetOptions(AValue: TMicroServerOptions);
+begin
+  HTTPHandler.Options:=aValue;
+end;
+
+procedure TCustomMicroHTTPApplication.SetPort(AValue: Word);
+begin
+  HTTPHandler.Port:=aValue;
+end;
+
+procedure TCustomMicroHTTPApplication.SetUSeSSL(AValue: Boolean);
+begin
+  if AValue then
+    Options:=Options+[mcoSSL]
+  else
+    Options:=Options-[mcoSSL]
+end;
+
+function TCustomMicroHTTPApplication.GetPort: Word;
+begin
+  Result:=HTTPHandler.Port;
+end;
+
+function TCustomMicroHTTPApplication.GetUseSSL: Boolean;
+begin
+  Result:=mcoSSL in Options;
+end;
+
+procedure TCustomMicroHTTPApplication.SetExtraHeaders(AValue: TStrings);
+begin
+  HTTPHandler.ExtraHeaders.Assign(AValue);
+end;
+
+function TCustomMicroHTTPApplication.InitializeWebHandler: TWebHandler;
+begin
+  Result:=TMicroHTTPHandler.Create(Self);
+end;
+
+function TCustomMicroHTTPApplication.HTTPHandler: TMicroHTTPHandler;
+begin
+  Result:=Webhandler as TMicroHTTPHandler;
+end;
+
+constructor TCustomMicroHTTPApplication.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  MHD_set_panic_func(@DoPanic,Self);
+end;
+
+destructor TCustomMicroHTTPApplication.Destroy;
+begin
+  MHD_set_panic_func(@DoPanic,Nil);
+  inherited Destroy;
+end;
+
+function TCustomMicroHTTPApplication.GetExtraHeaders: TStrings;
+begin
+  Result:=HTTPHandler.ExtraHeaders;
+end;
+
+function TCustomMicroHTTPApplication.GetHostName: String;
+begin
+  Result:=HTTPHandler.HostName;
+end;
+
+function TCustomMicroHTTPApplication.GetOptions: TMicroServerOptions;
+begin
+  Result:=HTTPHandler.Options;
+end;
+
+
+end.

packages/fcl-web/src/base/fpwebfile.pp

@@ -22,7 +22,12 @@ interface
 uses SysUtils, Classes, httpdefs, fphttp, httproute;
 
 Type
+
+  { TFPCustomFileModule }
+
   TFPCustomFileModule = Class(TCustomHTTPModule)
+  private
+    FCacheControlMaxAge: Integer;
   Protected
     // Determine filename frome request.
     Function GetRequestFileName(Const ARequest : TRequest) : String; virtual;
@@ -33,8 +38,10 @@ Type
     // Actually Send file to client.
     Procedure SendFile(Const AFileName : String; AResponse : TResponse); virtual;
   Public
+    Constructor CreateNew(AOwner: TComponent; CreateMode: Integer); override; overload;
     // Overrides TCustomHTTPModule to implement file serving.
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
+    Property CacheControlMaxAge : Integer Read FCacheControlMaxAge Write FCacheControlMaxAge;
   end;
   TFPCustomFileModuleClass = Class of TFPCustomFileModule;
 
@@ -69,6 +76,7 @@ Var
   DefaultFileModuleClass : TFPCustomFileModuleClass = TFPCustomFileModule;
   // Setting this will load mime types from that file.
   MimeTypesFile : string;
+  DefaultCacheControlMaxAge : Integer = 0;
 
 // use this to map locations (relative to BaseURL of the application) to physical directories.
 // More than one location can be registered. Directory must exist, location must not have / or \
@@ -250,6 +258,8 @@ begin
   AResponse.ContentType:=MimeTypes.GetMimeType(ExtractFileExt(AFileName));
   If (AResponse.ContentType='') then
     AResponse.ContentType:='Application/octet-stream';
+  if CacheControlMaxAge>0 then
+    aResponse.CacheControl:=Format('max-age=%d',[CacheControlMaxAge]);
   F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
   try
     AResponse.ContentLength:=F.Size;
@@ -261,6 +271,12 @@ begin
   end;
 end;
 
+constructor TFPCustomFileModule.CreateNew(AOwner: TComponent; CreateMode: Integer);
+begin
+  inherited CreateNew(aOwner,CreateMode);
+  CacheControlMaxAge:=DefaultCacheControlMaxAge;
+end;
+
 
 Procedure TFPCustomFileModule.HandleRequest(ARequest : TRequest; AResponse : TResponse);
 

packages/fcl-web/src/base/fpwebproxy.pp

@@ -239,7 +239,7 @@ end;
 procedure TProxyWebModule.ClientToResponse(T : TFPHTTPClient; aResponse : TResponse);
 
 Var
-  N,H : String;
+  N,H,V : String;
   HT : THeader;
 
 begin
@@ -249,8 +249,9 @@ begin
     HT:=HeaderType(H);
     if not (HT in [hhContentLength]) then
       begin
+      V:=Trim(ExtractWord(2,N,[':']));
       {$IFDEF DEBUGPROXY}Writeln('Returning header: ',N);{$ENDIF}
-      AResponse.CustomHeaders.Add(N);
+      AResponse.SetCustomHeader(H,V);
       end;
     end;
   AResponse.Code:=T.ResponseStatusCode;
@@ -268,9 +269,12 @@ begin
   URL:=L.URL;
   if L.AppendPathInfo then
     begin
-    P:=ARequest.PathInfo;
-    if (P<>'') then
+    P:=ARequest.GetNextPathInfo;
+    While P<>'' do
+      begin
       URL:=IncludeHTTPPathDelimiter(URL)+P;
+      P:=ARequest.GetNextPathInfo;
+      end;
     end;
   if (ARequest.QueryString<>'') then
     URL:=URL+'?'+ARequest.QueryString;

packages/fcl-web/src/base/microhttpapp.pp

@@ -0,0 +1,65 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    TMicroHTTPApplication class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$H+}
+unit microhttpapp;
+
+interface
+
+uses SysUtils,Classes, custmicrohttpapp;
+
+Type
+
+  { TCGIApplication }
+
+  TMicroHTTPApplication = Class(TCustomMicroHTTPApplication)
+  end;
+
+Var
+  Application : TMicroHTTPApplication;
+  ShowCleanUpErrors : Boolean = False;
+  
+Implementation
+
+uses CustApp;
+
+Procedure InitHTTP;
+
+begin
+  Application:=TMicroHTTPApplication.Create(Nil);
+  if not assigned(CustomApplication) then
+    CustomApplication := Application;
+end;
+
+Procedure DoneHTTP;
+
+begin
+  if CustomApplication=Application then
+    CustomApplication := nil;
+  try  
+    FreeAndNil(Application);
+  except
+    if ShowCleanUpErrors then
+      Raise;
+  end;
+end;
+
+Initialization
+  InitHTTP;
+  
+Finalization
+  DoneHTTP;
+  
+end.