Browse Source

* Adapt fcl-web (and examples) to unicode rtl: Need widestringmanager, use echo as path, make runnable.

Michael VAN CANNEYT 2 years ago
parent
commit
5cfaac64d5
30 changed files with 610 additions and 254 deletions
  1. 16 24
      packages/fcl-web/examples/echo/apache/echo.lpi
  2. 10 3
      packages/fcl-web/examples/echo/apache/echo.lpr
  3. 28 17
      packages/fcl-web/examples/echo/cgi/echo.lpi
  4. 4 0
      packages/fcl-web/examples/echo/cgi/echo.lpr
  5. 16 25
      packages/fcl-web/examples/echo/fcgi/echo.lpi
  6. 8 1
      packages/fcl-web/examples/echo/fcgi/echo.lpr
  7. BIN
      packages/fcl-web/examples/echo/fcgi/echo.res
  8. 1 1
      packages/fcl-web/examples/echo/webmodule/wmecho.pas
  9. 7 0
      packages/fcl-web/examples/fptemplate/simpletemplate/cgi/simpletemplate.lpr
  10. 6 0
      packages/fcl-web/examples/fptemplate/simpletemplate/webmodule/webmodule.lfm
  11. 10 4
      packages/fcl-web/examples/fptemplate/simpletemplate/webmodule/webmodule.pas
  12. 6 0
      packages/fcl-web/examples/httpclient/httpget.pas
  13. 6 1
      packages/fcl-web/examples/httpclient/httppost.pp
  14. 5 1
      packages/fcl-web/examples/httpclient/httppostfile.pp
  15. 5 6
      packages/fcl-web/examples/simpleserver/simpleserver.pas
  16. 88 12
      packages/fcl-web/src/base/custapache.pp
  17. 131 69
      packages/fcl-web/src/base/custapache24.pp
  18. 108 37
      packages/fcl-web/src/base/custfcgi.pp
  19. 81 20
      packages/fcl-web/src/base/custmicrohttpapp.pp
  20. 7 7
      packages/fcl-web/src/base/fcgigate.pp
  21. 11 3
      packages/fcl-web/src/base/fpapache.pp
  22. 12 4
      packages/fcl-web/src/base/fpapache24.pp
  23. 4 5
      packages/fcl-web/src/base/fphttpserver.pp
  24. 4 0
      packages/fcl-web/src/base/fpweb.pp
  25. 20 7
      packages/fcl-web/src/base/httpdefs.pp
  26. 10 2
      packages/fcl-web/src/jwt/fpjwaes256.pp
  27. 2 2
      packages/fcl-web/src/jwt/fpjwt.pp
  28. 1 1
      packages/fcl-web/src/restbridge/sqldbrestbridge.pp
  29. 1 1
      packages/fcl-web/src/restbridge/sqldbrestschema.pp
  30. 2 1
      packages/libmicrohttpd/src/libmicrohttpd.pp

+ 16 - 24
packages/fcl-web/examples/echo/apache/echo.lpi

@@ -1,76 +1,68 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
 <CONFIG>
   <ProjectOptions>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <PathDelim Value="\"/>
     <General>
     <General>
       <Flags>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <Runnable Value="False"/>
         <Runnable Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <ResourceType Value="res"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <UseXPManifest Value="True"/>
     </General>
     </General>
     <i18n>
     <i18n>
       <EnableI18N LFM="False"/>
       <EnableI18N LFM="False"/>
     </i18n>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
     </BuildModes>
     <PublishOptions>
     <PublishOptions>
       <Version Value="2"/>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
     </PublishOptions>
     </PublishOptions>
     <RunParams>
     <RunParams>
       <local>
       <local>
-        <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="\usr\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     </RunParams>
-    <RequiredPackages Count="1">
-      <Item1>
-        <PackageName Value="WebLaz"/>
-      </Item1>
-    </RequiredPackages>
     <Units Count="2">
     <Units Count="2">
       <Unit0>
       <Unit0>
         <Filename Value="echo.lpr"/>
         <Filename Value="echo.lpr"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="echo"/>
       </Unit0>
       </Unit0>
       <Unit1>
       <Unit1>
         <Filename Value="..\webmodule\wmecho.pas"/>
         <Filename Value="..\webmodule\wmecho.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="EchoModule"/>
         <ComponentName Value="EchoModule"/>
         <ResourceBaseClass Value="DataModule"/>
         <ResourceBaseClass Value="DataModule"/>
-        <UnitName Value="wmecho"/>
       </Unit1>
       </Unit1>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <PathDelim Value="\"/>
     <SearchPaths>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\webmodule;..\..\..\src\base"/>
     </SearchPaths>
     </SearchPaths>
     <Linking>
     <Linking>
       <Options>
       <Options>
         <ExecutableType Value="Library"/>
         <ExecutableType Value="Library"/>
       </Options>
       </Options>
     </Linking>
     </Linking>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   </CompilerOptions>
   <Debugging>
   <Debugging>
     <Exceptions Count="3">
     <Exceptions Count="3">

+ 10 - 3
packages/fcl-web/examples/echo/apache/echo.lpr

@@ -2,18 +2,25 @@ Library echo;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
+{ $define use_apache22}
+
 Uses
 Uses
 {$ifdef unix}
 {$ifdef unix}
-  cthreads,
+  cthreads, cwstring,
+{$endif}
+{$ifdef use_apache22}
+  httpd,fpApache,
+{$else}
+  httpd24,fpApache24,
 {$endif}
 {$endif}
-  httpd,fpApache, wmecho;
+  wmecho;
 
 
 Const
 Const
 
 
 { The following constant is used to export the module record. It must 
 { The following constant is used to export the module record. It must 
   always match the name in the LoadModule statement in the apache
   always match the name in the LoadModule statement in the apache
   configuration file(s). It is case sensitive !}
   configuration file(s). It is case sensitive !}
-  ModuleName='mod_echo';
+  ModuleName='mod_fpcecho';
 
 
 { The following constant is used to determine whether the module will
 { The following constant is used to determine whether the module will
   handle a request. It should match the name in the SetHandler statement
   handle a request. It should match the name in the SetHandler statement

+ 28 - 17
packages/fcl-web/examples/echo/cgi/echo.lpi

@@ -1,43 +1,50 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
 <CONFIG>
   <ProjectOptions>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <PathDelim Value="\"/>
     <General>
     <General>
       <Flags>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasCreateFormStatements Value="False"/>
-        <Runnable Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <ResourceType Value="res"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <UseXPManifest Value="True"/>
     </General>
     </General>
     <i18n>
     <i18n>
       <EnableI18N LFM="False"/>
       <EnableI18N LFM="False"/>
     </i18n>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
     </BuildModes>
     <PublishOptions>
     <PublishOptions>
       <Version Value="2"/>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
     </PublishOptions>
     </PublishOptions>
     <RunParams>
     <RunParams>
-      <local>
-        <FormatVersion Value="1"/>
-      </local>
+      <environment>
+        <UserOverrides Count="3">
+          <Variable0 Name="REQUEST_METHOD" Value="GET"/>
+          <Variable1 Name="QUERY_STRING" Value="me=13&amp;you=12&amp;them=SOSO"/>
+          <Variable2 Name="PATH_INFO" Value="echo"/>
+        </UserOverrides>
+      </environment>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <environment>
+            <UserOverrides Count="3">
+              <Variable0 Name="REQUEST_METHOD" Value="GET"/>
+              <Variable1 Name="QUERY_STRING" Value="me=13&amp;you=12&amp;them=SOSO"/>
+              <Variable2 Name="PATH_INFO" Value="echo"/>
+            </UserOverrides>
+          </environment>
+        </Mode0>
+      </Modes>
     </RunParams>
     </RunParams>
-    <RequiredPackages Count="1">
-      <Item1>
-        <PackageName Value="WebLaz"/>
-      </Item1>
-    </RequiredPackages>
     <Units Count="2">
     <Units Count="2">
       <Unit0>
       <Unit0>
         <Filename Value="echo.lpr"/>
         <Filename Value="echo.lpr"/>
@@ -47,6 +54,7 @@
         <Filename Value="..\webmodule\wmecho.pas"/>
         <Filename Value="..\webmodule\wmecho.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="EchoModule"/>
         <ComponentName Value="EchoModule"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="DataModule"/>
         <ResourceBaseClass Value="DataModule"/>
       </Unit1>
       </Unit1>
     </Units>
     </Units>
@@ -54,9 +62,12 @@
   <CompilerOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <Version Value="11"/>
     <PathDelim Value="\"/>
     <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="echo.cgi" ApplyConventions="False"/>
+    </Target>
     <SearchPaths>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="..\webmodule"/>
+      <OtherUnitFiles Value="..\webmodule;..\..\..\src\base"/>
     </SearchPaths>
     </SearchPaths>
   </CompilerOptions>
   </CompilerOptions>
   <Debugging>
   <Debugging>

+ 4 - 0
packages/fcl-web/examples/echo/cgi/echo.lpr

@@ -3,12 +3,16 @@ program echo;
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
 uses
 uses
+{$ifdef unix}
+  cwstring,
+{$endif}
   fpCGI, wmecho;
   fpCGI, wmecho;
 
 
 {$R *.res}
 {$R *.res}
 
 
 begin
 begin
   Application.Initialize;
   Application.Initialize;
+  Application.Title:='Echo demo';
   Application.Run;
   Application.Run;
 end.
 end.
 
 

+ 16 - 25
packages/fcl-web/examples/echo/fcgi/echo.lpi

@@ -1,71 +1,62 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
 <CONFIG>
   <ProjectOptions>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <PathDelim Value="\"/>
     <General>
     <General>
       <Flags>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasCreateFormStatements Value="False"/>
-        <Runnable Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <ResourceType Value="res"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <UseXPManifest Value="True"/>
     </General>
     </General>
     <i18n>
     <i18n>
       <EnableI18N LFM="False"/>
       <EnableI18N LFM="False"/>
     </i18n>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
     </BuildModes>
     <PublishOptions>
     <PublishOptions>
       <Version Value="2"/>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
     </PublishOptions>
     </PublishOptions>
     <RunParams>
     <RunParams>
       <local>
       <local>
-        <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="\usr\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     </RunParams>
-    <RequiredPackages Count="1">
-      <Item1>
-        <PackageName Value="WebLaz"/>
-      </Item1>
-    </RequiredPackages>
     <Units Count="2">
     <Units Count="2">
       <Unit0>
       <Unit0>
         <Filename Value="echo.lpr"/>
         <Filename Value="echo.lpr"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="echo"/>
       </Unit0>
       </Unit0>
       <Unit1>
       <Unit1>
         <Filename Value="..\webmodule\wmecho.pas"/>
         <Filename Value="..\webmodule\wmecho.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="EchoModule"/>
         <ComponentName Value="EchoModule"/>
         <ResourceBaseClass Value="DataModule"/>
         <ResourceBaseClass Value="DataModule"/>
-        <UnitName Value="wmecho"/>
       </Unit1>
       </Unit1>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <PathDelim Value="\"/>
     <SearchPaths>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\webmodule;..\..\..\src\base"/>
     </SearchPaths>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   </CompilerOptions>
   <Debugging>
   <Debugging>
     <Exceptions Count="3">
     <Exceptions Count="3">

+ 8 - 1
packages/fcl-web/examples/echo/fcgi/echo.lpr

@@ -3,12 +3,19 @@ program echo;
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
 uses
 uses
-  fpFCGI, wmecho;
+  {$ifdef unix}
+  fpwidestring, unicodeducet,
+  {$endif}
+  fpFCGI, custfcgi, wmecho;
 
 
 {$R *.res}
 {$R *.res}
 
 
 begin
 begin
+  {$IFDEF UNIX}
+  SetActiveCollation('DUCET');
+  {$ENDIF}
   Application.Port:=2015;//Port the FCGI application is listening on
   Application.Port:=2015;//Port the FCGI application is listening on
+  Application.PathInfoHandling:=pihLastScriptComponent; // Assume url is of form /scriptname/echo
   Application.Initialize;
   Application.Initialize;
   Application.Run;
   Application.Run;
 end.
 end.

BIN
packages/fcl-web/examples/echo/fcgi/echo.res


+ 1 - 1
packages/fcl-web/examples/echo/webmodule/wmecho.pas

@@ -48,6 +48,6 @@ begin
 end;
 end;
 
 
 initialization
 initialization
-  RegisterHTTPModule('TEchoModule', TEchoModule);
+  RegisterHTTPModule('Echo', TEchoModule);
 end.
 end.
 
 

+ 7 - 0
packages/fcl-web/examples/fptemplate/simpletemplate/cgi/simpletemplate.lpr

@@ -3,11 +3,18 @@ program simpletemplate;
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
 uses
 uses
+  {$ifdef unix}
+  fpwidestring, unicodeducet,
+  {$endif}
+
   fpCGI, webmodule;
   fpCGI, webmodule;
 
 
 {$R *.res}
 {$R *.res}
 
 
 begin
 begin
+  {$ifdef unix}
+  SetActiveCollation('DUCET');
+  {$endif}
   Application.Initialize;
   Application.Initialize;
   Application.Run;
   Application.Run;
 end.
 end.

+ 6 - 0
packages/fcl-web/examples/fptemplate/simpletemplate/webmodule/webmodule.lfm

@@ -8,6 +8,12 @@ object FPWebModule1: TFPWebModule1
       Template.AllowTagParams = False
       Template.AllowTagParams = False
     end>
     end>
   CreateSession = False
   CreateSession = False
+  CORS.Enabled = False
+  CORS.Options = [coAllowCredentials, coEmptyDomainToOrigin]
+  CORS.AllowedMethods = 'GET, PUT, POST, OPTIONS, HEAD'
+  CORS.AllowedOrigins = '*'
+  CORS.AllowedHeaders = 'x-requested-with, content-type, authorization'
+  CORS.MaxAge = 0
   Height = 300
   Height = 300
   HorizontalOffset = 290
   HorizontalOffset = 290
   VerticalOffset = 149
   VerticalOffset = 149

+ 10 - 4
packages/fcl-web/examples/fptemplate/simpletemplate/webmodule/webmodule.pas

@@ -33,16 +33,22 @@ implementation
 
 
 procedure TFPWebModule1.func1callRequest(Sender: TObject; ARequest: TRequest;
 procedure TFPWebModule1.func1callRequest(Sender: TObject; ARequest: TRequest;
   AResponse: TResponse; var Handled: Boolean);
   AResponse: TResponse; var Handled: Boolean);
+var
+  S : String;
 begin
 begin
   //ModuleTemplate is a web module global property
   //ModuleTemplate is a web module global property
   //To use the Template propery of the current web action (which is visible in
   //To use the Template propery of the current web action (which is visible in
   //the object inspector for every Action), use
   //the object inspector for every Action), use
   //(Sender as TFPWebAction).Template.FileName := 'mytemplate1.html'; and so on.
   //(Sender as TFPWebAction).Template.FileName := 'mytemplate1.html'; and so on.
-  ModuleTemplate.FileName := 'mytemplate1.html';//best to use full path here
+  ModuleTemplate.FileName := ExtractFilePath(paramstr(0))+'../templates/mytemplate1.html';//best to use full path here
   ModuleTemplate.AllowTagParams := true;
   ModuleTemplate.AllowTagParams := true;
   ModuleTemplate.OnReplaceTag := @func1callReplaceTag;
   ModuleTemplate.OnReplaceTag := @func1callReplaceTag;
-
-  AResponse.Content := ModuleTemplate.GetContent;
+  S:=ModuleTemplate.GetContent;
+  {$IF SIZEOF(CHAR)=2}
+  AResponse.Content := UTF8Encode(S);
+  {$ELSE}
+  AResponse.Content := S;
+  {$ENDIF}
 
 
   Handled := true;
   Handled := true;
 end;
 end;
@@ -61,5 +67,5 @@ begin
 end;
 end;
 
 
 initialization
 initialization
-  RegisterHTTPModule('TFPWebModule1', TFPWebModule1);
+  RegisterHTTPModule('template', TFPWebModule1);
 end.
 end.

+ 6 - 0
packages/fcl-web/examples/httpclient/httpget.pas

@@ -4,6 +4,9 @@ program httpget;
 {$DEFINE USEGNUTLS}
 {$DEFINE USEGNUTLS}
 
 
 uses
 uses
+  {$IFDEF UNIX}
+  fpwidestring, unicodeducet,
+  {$ENDIF}
   SysUtils, Classes, fphttpclient, ssockets,
   SysUtils, Classes, fphttpclient, ssockets,
 {$IFNDEF USEGNUTLS}
 {$IFNDEF USEGNUTLS}
   fpopenssl, opensslsockets,
   fpopenssl, opensslsockets,
@@ -141,6 +144,9 @@ begin
 end;
 end;
 
 
 begin
 begin
+  {$IFDEF UNIX}
+  SetActiveCollation('DUCET');
+  {$ENDIF}
   With TTestApp.Create do
   With TTestApp.Create do
     try
     try
       Run;
       Run;

+ 6 - 1
packages/fcl-web/examples/httpclient/httppost.pp

@@ -9,6 +9,8 @@ Var
   F : TFileStream;
   F : TFileStream;
   Vars : TStrings;
   Vars : TStrings;
   i : integer;
   i : integer;
+  Fmt : UNicodeString;
+
 begin
 begin
   With TFPHTTPClient.Create(Nil) do
   With TFPHTTPClient.Create(Nil) do
     begin
     begin
@@ -17,7 +19,10 @@ begin
       Vars:=TstringList.Create;
       Vars:=TstringList.Create;
       try
       try
         For i:=1 to 10 do
         For i:=1 to 10 do
-          Vars.Add(Format('Var%d=Value %d',[i,i]));
+          begin
+          Fmt:='Var%d=Value %d';
+          Vars.Add(Format(Fmt,[i,i]));
+          end;
         FormPost(ParamStr(1),vars,f);
         FormPost(ParamStr(1),vars,f);
       finally
       finally
         Vars.Free;
         Vars.Free;

+ 5 - 1
packages/fcl-web/examples/httpclient/httppostfile.pp

@@ -1,14 +1,18 @@
 program httppostfile;
 program httppostfile;
 
 
+
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
 uses
 uses
+  {$ifdef unix}
+  cwstring,
+  {$endif}
   SysUtils, Classes, fphttpclient, opensslsockets;
   SysUtils, Classes, fphttpclient, opensslsockets;
 
 
 Var
 Var
   F : TFileStream;
   F : TFileStream;
   Vars : TStrings;
   Vars : TStrings;
-  i : integer;
+
 begin
 begin
   With TFPHTTPClient.Create(Nil) do
   With TFPHTTPClient.Create(Nil) do
     begin
     begin

+ 5 - 6
packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -25,9 +25,10 @@ program simpleserver;
 {$ENDIF}
 {$ENDIF}
 
 
 uses
 uses
-
-
-
+{$IFDEF UNIX}
+  cwstring,
+  cthreads,
+{$ENDIF}
 {$IFNDEF USEMICROHTTP}
 {$IFNDEF USEMICROHTTP}
 {$ifdef USEGNUTLS}
 {$ifdef USEGNUTLS}
   gnutlssockets,
   gnutlssockets,
@@ -36,9 +37,6 @@ uses
 {$endif}
 {$endif}
   custhttpapp,
   custhttpapp,
 {$ELSE}
 {$ELSE}
-{$ifdef unix}
-  cthreads,
-{$endif}  
   custmicrohttpapp,
   custmicrohttpapp,
 {$ENDIF}
 {$ENDIF}
   {$ifdef unix}
   {$ifdef unix}
@@ -140,6 +138,7 @@ begin
     DumpRequest(aRequest,L);
     DumpRequest(aRequest,L);
     L.AddStrings(['</body>','</html>']);
     L.AddStrings(['</body>','</html>']);
     AResponse.Content:=L.Text;
     AResponse.Content:=L.Text;
+    AResponse.ContentLength:=Length(AResponse.Content);
     AResponse.SendResponse;
     AResponse.SendResponse;
   finally
   finally
     L.Free;
     L.Free;

+ 88 - 12
packages/fcl-web/src/base/custapache.pp

@@ -32,6 +32,9 @@ Type
     FApache : TApacheHandler;
     FApache : TApacheHandler;
     FRequest : PRequest_rec;
     FRequest : PRequest_rec;
   Protected
   Protected
+    function GetApacheHeaderValue(H: THeader): String;
+    function GetApacheVariableValue(V: THTTPVariableType): String;
+    procedure initrequestvars; override;
     Procedure InitFromRequest;
     Procedure InitFromRequest;
     procedure ReadContent; override;
     procedure ReadContent; override;
   Public
   Public
@@ -165,7 +168,7 @@ const
   HPRIO : Array[THandlerPriority] of Integer
   HPRIO : Array[THandlerPriority] of Integer
         = (APR_HOOK_FIRST,APR_HOOK_MIDDLE,APR_HOOK_LAST);
         = (APR_HOOK_FIRST,APR_HOOK_MIDDLE,APR_HOOK_LAST);
 
 
-Function MaybeP(P : Pchar) : String;
+Function MaybeP(P : PAnsiChar) : String;
 
 
 begin
 begin
   If (P<>Nil) then
   If (P<>Nil) then
@@ -188,7 +191,7 @@ Procedure RegisterApacheHooks(P: PApr_pool_t);cdecl;
 
 
 Var
 Var
   H : ap_hook_handler_t;
   H : ap_hook_handler_t;
-  PP1,PP2 : PPChar;
+  PP1,PP2 : PPAnsiChar;
 
 
 begin
 begin
   H:=AlternateHandler;
   H:=AlternateHandler;
@@ -313,13 +316,13 @@ begin
     Raise EFPApacheError.Create(SErrNoModuleName);
     Raise EFPApacheError.Create(SErrNoModuleName);
   STANDARD20_MODULE_STUFF(FModuleRecord^);
   STANDARD20_MODULE_STUFF(FModuleRecord^);
   If (StrPas(FModuleRecord^.name)<>FModuleName) then
   If (StrPas(FModuleRecord^.name)<>FModuleName) then
-    FModuleRecord^.Name:=PChar(FModuleName);
+    FModuleRecord^.Name:=PAnsiChar(FModuleName);
   FModuleRecord^.register_hooks:=@RegisterApacheHooks;
   FModuleRecord^.register_hooks:=@RegisterApacheHooks;
 end;
 end;
 
 
 procedure TApacheHandler.LogErrorMessage(const Msg: String; LogLevel: integer);
 procedure TApacheHandler.LogErrorMessage(const Msg: String; LogLevel: integer);
 begin
 begin
-  ap_log_error(pchar(FModuleName),0,LogLevel,0,Nil,'module: %s',[pchar(Msg)]);
+  ap_log_error(PAnsiChar(FModuleName),0,LogLevel,0,Nil,'module: %s',[PAnsiChar(Msg)]);
 end;
 end;
 
 
 function TApacheHandler.GetIdleModuleCount : Integer;
 function TApacheHandler.GetIdleModuleCount : Integer;
@@ -432,7 +435,7 @@ procedure TApacheRequest.ReadContent;
 
 
 Var
 Var
   Left,Len,Count,Bytes : Integer;
   Left,Len,Count,Bytes : Integer;
-  P : Pchar;
+  P : PAnsiChar;
   S : String;
   S : String;
 
 
 begin
 begin
@@ -443,7 +446,7 @@ begin
     If (Len>0) then
     If (Len>0) then
       begin
       begin
       SetLength(S,Len);
       SetLength(S,Len);
-      P:=PChar(S);
+      P:=PAnsiChar(S);
       Left:=Len;
       Left:=Len;
       Count:=0;
       Count:=0;
       Repeat
       Repeat
@@ -458,6 +461,79 @@ begin
   InitContent(S);
   InitContent(S);
 end;
 end;
 
 
+function TApacheRequest.GetApacheHeaderValue(H: THeader): String;
+
+var
+  FN : AnsiString;
+  I : Integer;
+  S : String;
+
+begin
+  Result:='';
+  Str(H,S);
+  If Not Assigned(FRequest) then
+    exit;
+  Case h of
+    hhContentEncoding:
+      Result:=MaybeP(FRequest^.content_encoding);
+    hhHost:
+      Result:=MaybeP(FRequest^.HostName);
+  else
+    FN:=HeaderName(H);
+    Result:=MaybeP(apr_table_get(FRequest^.headers_in,PAnsiChar(FN)));
+  end;
+end;
+
+function TApacheRequest.GetApacheVariableValue(V: THTTPVariableType): String;
+var
+  i : integer;
+
+begin
+  Result:='';
+  if not Assigned(FRequest) then
+    exit;
+  case V of
+    hvHTTPVersion:
+      Result:=MaybeP(FRequest^.protocol); // ProtocolVersion
+    hvPathInfo:
+      Result:=MaybeP(FRequest^.path_info); // PathInfo
+    hvPathTranslated:
+      Result:=MaybeP(FRequest^.filename); // PathTranslated
+    hvRemoteAddress :
+      If (FRequest^.Connection<>Nil) then
+        Result:=MaybeP(FRequest^.Connection^.remote_ip);
+    hvRemoteHost:
+      If (FRequest^.Connection<>Nil) then
+        begin
+        Result:=MaybeP(ap_get_remote_host(FRequest^.Connection,
+                       FRequest^.per_dir_config,
+//                     nil,
+                       REMOTE_NAME,@i));
+        end;
+    hvScriptName:
+      begin // ScriptName
+      Result:=MaybeP(FRequest^.unparsed_uri);
+      I:=Pos('?',Result)-1;
+      If (I=-1) then
+       I:=Length(Result);
+      Result:=Copy(Result,1,I-Length(PathInfo));
+      end;
+    hvServerPort:
+      Result:=IntToStr(ap_get_server_port(FRequest)); // ServerPort
+    hvMethod:
+      Result:=MaybeP(FRequest^.method); // Method
+    hvURL:
+      Result:=MaybeP(FRequest^.unparsed_uri); // URL
+    hvQuery:
+      Result:=MaybeP(FRequest^.args); // Query
+    end;
+end;
+
+procedure TApacheRequest.initrequestvars;
+begin
+  inherited initrequestvars;
+end;
+
 procedure TApacheRequest.InitFromRequest;
 procedure TApacheRequest.InitFromRequest;
 
 
 
 
@@ -513,7 +589,7 @@ function TApacheRequest.GetCustomHeader(const Name: String): String;
 begin
 begin
   Result:=inherited GetCustomHeader(Name);
   Result:=inherited GetCustomHeader(Name);
   if Result='' then
   if Result='' then
-    Result:=MaybeP(apr_table_get(FRequest^.headers_in,pchar(Name)));
+    Result:=MaybeP(apr_table_get(FRequest^.headers_in,PAnsiChar(Name)));
 end;
 end;
 
 
 { TApacheResponse }
 { TApacheResponse }
@@ -534,7 +610,7 @@ begin
       N:=Copy(V,1,P-1);
       N:=Copy(V,1,P-1);
       System.Delete(V,1,P);
       System.Delete(V,1,P);
       V := Trim(V);//no need space before the value, apache puts it there
       V := Trim(V);//no need space before the value, apache puts it there
-      apr_table_set(FRequest^.headers_out,Pchar(N),Pchar(V));
+      apr_table_set(FRequest^.headers_out,PAnsiChar(N),PAnsiChar(V));
       end;
       end;
     end;
     end;
 end;
 end;
@@ -548,10 +624,10 @@ Var
 begin
 begin
   S:=ContentType;
   S:=ContentType;
   If (S<>'') then
   If (S<>'') then
-    FRequest^.content_type:=apr_pstrdup(FRequest^.pool,Pchar(S));
+    FRequest^.content_type:=apr_pstrdup(FRequest^.pool,PAnsiChar(S));
   S:=ContentEncoding;
   S:=ContentEncoding;
   If (S<>'') then
   If (S<>'') then
-    FRequest^.content_encoding:=apr_pstrdup(FRequest^.pool,Pchar(S));
+    FRequest^.content_encoding:=apr_pstrdup(FRequest^.pool,PAnsiChar(S));
   If Code <> 200 then
   If Code <> 200 then
     FRequest^.status := Code;
     FRequest^.status := Code;
   If assigned(ContentStream) then
   If assigned(ContentStream) then
@@ -561,7 +637,7 @@ begin
       begin
       begin
       S:=Contents[i]+LineEnding;
       S:=Contents[i]+LineEnding;
       // If there is a null, it's written also with ap_rwrite
       // If there is a null, it's written also with ap_rwrite
-      ap_rwrite(PChar(S),Length(S),FRequest);
+      ap_rwrite(PAnsiChar(S),Length(S),FRequest);
       end;
       end;
 end;
 end;
 
 
@@ -699,7 +775,7 @@ end;
 
 
 procedure TCustomApacheApplication.ShowException(E: Exception);
 procedure TCustomApacheApplication.ShowException(E: Exception);
 begin
 begin
-  ap_log_error(pchar(TApacheHandler(WebHandler).ModuleName),0,APLOG_ERR,0,Nil,'module: %s',[Pchar(E.Message)]);
+  ap_log_error(PAnsiChar(TApacheHandler(WebHandler).ModuleName),0,APLOG_ERR,0,Nil,'module: %s',[PAnsiChar(E.Message)]);
 end;
 end;
 
 
 function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec): Integer;
 function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec): Integer;

+ 131 - 69
packages/fcl-web/src/base/custapache24.pp

@@ -20,7 +20,7 @@ unit custapache24;
 interface
 interface
 
 
 uses
 uses
-  SysUtils, Classes, CustWeb, httpDefs, fpHTTP, httpd24, apr24, SyncObjs;
+  SysUtils, Classes, CustWeb, httpDefs, fpHTTP, httpd24, apr24, SyncObjs, httpprotocol;
 
 
 Type
 Type
 
 
@@ -33,8 +33,10 @@ Type
     FApache : TApacheHandler;
     FApache : TApacheHandler;
     FRequest : PRequest_rec;
     FRequest : PRequest_rec;
   Protected
   Protected
-    Function GetFieldValue(Index : Integer) : String; override;
+    function GetApacheHeaderValue(H: THeader): String;
+    function GetApacheVariableValue(V: THTTPVariableType): String;
     Procedure InitFromRequest;
     Procedure InitFromRequest;
+    procedure initrequestvars; override;
     procedure ReadContent; override;
     procedure ReadContent; override;
   Public
   Public
     Constructor CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
     Constructor CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
@@ -153,6 +155,7 @@ Var
 
 
 
 
 implementation
 implementation
+
 uses CustApp;
 uses CustApp;
 
 
 resourcestring
 resourcestring
@@ -162,6 +165,18 @@ resourcestring
   SErrNoModuleName = 'No module name set';
   SErrNoModuleName = 'No module name set';
   SErrTooManyRequests = 'Too many simultaneous requests.';
   SErrTooManyRequests = 'Too many simultaneous requests.';
 
 
+
+Function MaybeAnsi(S : String) : AnsiString; inline;
+
+begin
+{$IF SIZEOF(CHAR)=1}
+  Result:=S;
+{$ELSE}
+  Result:=UTF8Encode(S);
+{$ENDIF}
+end;
+
+
 const
 const
   HPRIO : Array[THandlerPriority] of Integer
   HPRIO : Array[THandlerPriority] of Integer
         = (APR_HOOK_FIRST,APR_HOOK_MIDDLE,APR_HOOK_LAST);
         = (APR_HOOK_FIRST,APR_HOOK_MIDDLE,APR_HOOK_LAST);
@@ -184,7 +199,7 @@ Procedure RegisterApacheHooks(P: PApr_pool_t);cdecl;
 
 
 Var
 Var
   H : ap_hook_handler_t;
   H : ap_hook_handler_t;
-  PP1,PP2 : PPChar;
+  PP1,PP2 : PPAnsiChar;
 
 
 begin
 begin
   H:=AlternateHandler;
   H:=AlternateHandler;
@@ -309,21 +324,21 @@ begin
     Raise EFPApacheError.Create(SErrNoModuleName);
     Raise EFPApacheError.Create(SErrNoModuleName);
   STANDARD20_MODULE_STUFF(FModuleRecord^);
   STANDARD20_MODULE_STUFF(FModuleRecord^);
   If (StrPas(FModuleRecord^.name)<>FModuleName) then
   If (StrPas(FModuleRecord^.name)<>FModuleName) then
-    FModuleRecord^.Name:=PChar(FModuleName);
+    FModuleRecord^.Name:=PAnsiChar(FModuleName);
   FModuleRecord^.register_hooks:=@RegisterApacheHooks;
   FModuleRecord^.register_hooks:=@RegisterApacheHooks;
 end;
 end;
 
 
 procedure TApacheHandler.LogErrorMessage(const Msg: String; LogLevel: integer);
 procedure TApacheHandler.LogErrorMessage(const Msg: String; LogLevel: integer);
 var a: ap_version_t;
 var a: ap_version_t;
 begin
 begin
-  ap_log_error(pchar(FModuleName),  //The file in which this function is called
+  ap_log_error(PAnsiChar(FModuleName),  //The file in which this function is called
                0,                   //The line number on which this function is called
                0,                   //The line number on which this function is called
                0,                   //The module_index of the module generating this message
                0,                   //The module_index of the module generating this message
                LogLevel,            //The level of this error message
                LogLevel,            //The level of this error message
                0,                   //The status code from the previous command
                0,                   //The status code from the previous command
                Nil,                 //The server on which we are logging
                Nil,                 //The server on which we are logging
                'module: %s',        //The format string
                'module: %s',        //The format string
-               [pchar(Msg)])        //The arguments to use to fill out fmt.
+               [PAnsiChar(Msg)])        //The arguments to use to fill out fmt.
 end;
 end;
 
 
 function TApacheHandler.GetIdleModuleCount : Integer;
 function TApacheHandler.GetIdleModuleCount : Integer;
@@ -423,60 +438,83 @@ end;
 
 
 { TApacheRequest }
 { TApacheRequest }
 
 
-function TApacheRequest.GetFieldValue(Index: Integer): String;
+Function MaybeP(P : PAnsiChar) : String;
 
 
-  Function MaybeP(P : Pchar) : String;
+begin
+  If (P<>Nil) then
+    Result:=StrPas(P);
+end;
 
 
-  begin
-    If (P<>Nil) then
-      Result:=StrPas(P);
-  end;
+function TApacheRequest.GetApacheVariableValue(V: THTTPVariableType): String;
 
 
 var
 var
-  FN : String;
-  I : Integer;
+  i : integer;
 
 
 begin
 begin
   Result:='';
   Result:='';
-  If (Index in [1..NoHTTPFields]) then
-    begin
-    FN:=HTTPFieldNames[Index];
-    Result:=MaybeP(apr_table_get(FRequest^.headers_in,pchar(FN)));
-    end;
-  if (Result='') and Assigned(FRequest) then
-    case Index of
-      0  : Result:=MaybeP(FRequest^.protocol); // ProtocolVersion
-      7  : Result:=MaybeP(FRequest^.content_encoding); //ContentEncoding
-      25 : Result:=MaybeP(FRequest^.path_info); // PathInfo
-      26 : Result:=MaybeP(FRequest^.filename); // PathTranslated
-      27 : // RemoteAddr
-           If (FRequest^.Connection<>Nil) then
-             Result:=MaybeP(FRequest^.Connection^.remote_ip);
-      28 : // RemoteHost
-           If (FRequest^.Connection<>Nil) then
-             begin
-             Result:=MaybeP(ap_get_remote_host(FRequest^.Connection,
-                            FRequest^.per_dir_config,
-//                            nil,
-                            REMOTE_NAME,@i));
-             end;
-      29 : begin // ScriptName
-           Result:=MaybeP(FRequest^.unparsed_uri);
-           I:=Pos('?',Result)-1;
-           If (I=-1) then
-             I:=Length(Result);
-           Result:=Copy(Result,1,I-Length(PathInfo));
-           end;
-      30 : Result:=IntToStr(ap_get_server_port(FRequest)); // ServerPort
-      31 : Result:=MaybeP(FRequest^.method); // Method
-      32 : Result:=MaybeP(FRequest^.unparsed_uri); // URL
-      33 : Result:=MaybeP(FRequest^.args); // Query
-      34 : Result:=MaybeP(FRequest^.HostName); // Host
-    else
-      Result:=inherited GetFieldValue(Index);
+  if not Assigned(FRequest) then
+    exit;
+  case V of
+    hvHTTPVersion:
+      Result:=MaybeP(FRequest^.protocol); // ProtocolVersion
+    hvPathInfo:
+      Result:=MaybeP(FRequest^.path_info); // PathInfo
+    hvPathTranslated:
+      Result:=MaybeP(FRequest^.filename); // PathTranslated
+    hvRemoteAddress :
+      If (FRequest^.Connection<>Nil) then
+        Result:=MaybeP(FRequest^.Connection^.remote_ip);
+    hvRemoteHost:
+      If (FRequest^.Connection<>Nil) then
+        begin
+        Result:=MaybeP(ap_get_remote_host(FRequest^.Connection,
+                       FRequest^.per_dir_config,
+//                     nil,
+                       REMOTE_NAME,@i));
+        end;
+    hvScriptName:
+      begin // ScriptName
+      Result:=MaybeP(FRequest^.unparsed_uri);
+      I:=Pos('?',Result)-1;
+      If (I=-1) then
+       I:=Length(Result);
+      Result:=Copy(Result,1,I-Length(PathInfo));
+      end;
+    hvServerPort:
+      Result:=IntToStr(ap_get_server_port(FRequest)); // ServerPort
+    hvMethod:
+      Result:=MaybeP(FRequest^.method); // Method
+    hvURL:
+      Result:=MaybeP(FRequest^.unparsed_uri); // URL
+    hvQuery:
+      Result:=MaybeP(FRequest^.args); // Query
     end;
     end;
 end;
 end;
 
 
+function TApacheRequest.GetApacheHeaderValue(H: THeader): String;
+
+var
+  FN : AnsiString;
+  I : Integer;
+  S : String;
+
+begin
+  Result:='';
+  Str(H,S);
+  If Not Assigned(FRequest) then
+    exit;
+  Case h of
+    hhContentEncoding:
+      Result:=MaybeP(FRequest^.content_encoding);
+    hhHost:
+      Result:=MaybeP(FRequest^.HostName);
+  else
+    FN:=MaybeAnsi(HeaderName(H));
+    Result:=MaybeP(apr_table_get(FRequest^.headers_in,PAnsiChar(FN)));
+  end;
+end;
+
+
 procedure TApacheRequest.ReadContent;
 procedure TApacheRequest.ReadContent;
 
 
   Function MinS(A,B : Integer) : Integer;
   Function MinS(A,B : Integer) : Integer;
@@ -490,7 +528,7 @@ procedure TApacheRequest.ReadContent;
 
 
 Var
 Var
   Left,Len,Count,Bytes : Integer;
   Left,Len,Count,Bytes : Integer;
-  P : Pchar;
+  P : PAnsiChar;
   S : String;
   S : String;
 
 
 begin
 begin
@@ -501,7 +539,7 @@ begin
     If (Len>0) then
     If (Len>0) then
       begin
       begin
       SetLength(S,Len);
       SetLength(S,Len);
-      P:=PChar(S);
+      P:=PAnsiChar(S);
       Left:=Len;
       Left:=Len;
       Count:=0;
       Count:=0;
       Repeat
       Repeat
@@ -516,13 +554,39 @@ begin
   InitContent(S);
   InitContent(S);
 end;
 end;
 
 
+
 procedure TApacheRequest.InitFromRequest;
 procedure TApacheRequest.InitFromRequest;
 begin
 begin
   ParseCookies;
   ParseCookies;
   ReadContent;
   ReadContent;
 end;
 end;
 
 
-Constructor TApacheRequest.CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
+procedure TApacheRequest.initrequestvars;
+
+Var
+  H : THeader;
+  V : THTTPVariableType;
+  S : String;
+
+begin
+  For H in Theader do
+    if hdRequest in HTTPHeaderDirections[H] then
+      begin
+      S:=GetApacheHeaderValue(H);
+      if S<>'' then
+        SetHeader(H,S);
+      end;
+  For V in THTTPVariableType do
+    begin
+    S:=GetApacheVariableValue(V);
+    if S<>'' then
+      SetHTTPVariable(V,S);
+    end;
+  inherited initrequestvars;
+end;
+
+constructor TApacheRequest.CreateReq(App: TApacheHandler; ARequest: PRequest_rec
+  );
 
 
 begin
 begin
   FApache:=App;
   FApache:=App;
@@ -538,7 +602,7 @@ procedure TApacheResponse.DoSendHeaders(Headers: TStrings);
 
 
 Var
 Var
   I,P : Integer;
   I,P : Integer;
-  N,V : String;
+  N,V : AnsiString;
 
 
 begin
 begin
   For I:=0 to Headers.Count-1 do
   For I:=0 to Headers.Count-1 do
@@ -550,35 +614,33 @@ begin
       N:=Copy(V,1,P-1);
       N:=Copy(V,1,P-1);
       System.Delete(V,1,P);
       System.Delete(V,1,P);
       V := Trim(V);//no need space before the value, apache puts it there
       V := Trim(V);//no need space before the value, apache puts it there
-      apr_table_set(FRequest^.headers_out,Pchar(N),Pchar(V));
+      apr_table_set(FRequest^.headers_out,PAnsiChar(N),PAnsiChar(V));
       end;
       end;
     end;
     end;
 end;
 end;
 
 
+
 procedure TApacheResponse.DoSendContent;
 procedure TApacheResponse.DoSendContent;
 
 
 Var
 Var
-  S : String;
-  I : Integer;
+  S : AnsiString;
 
 
 begin
 begin
-  S:=ContentType;
+  S:=MaybeAnsi(ContentType);
   If (S<>'') then
   If (S<>'') then
-    FRequest^.content_type:=apr_pstrdup(FRequest^.pool,Pchar(S));
-  S:=ContentEncoding;
+    FRequest^.content_type:=apr_pstrdup(FRequest^.pool,PAnsiChar(S));
+  S:=MaybeAnsi(ContentEncoding);
   If (S<>'') then
   If (S<>'') then
-    FRequest^.content_encoding:=apr_pstrdup(FRequest^.pool,Pchar(S));
+    FRequest^.content_encoding:=apr_pstrdup(FRequest^.pool,PAnsiChar(S));
   If Code <> 200 then
   If Code <> 200 then
     FRequest^.status := Code;
     FRequest^.status := Code;
   If assigned(ContentStream) then
   If assigned(ContentStream) then
     SendStream(Contentstream)
     SendStream(Contentstream)
   else
   else
-    for I:=0 to Contents.Count-1 do
-      begin
-      S:=Contents[i]+LineEnding;
-      // If there is a null, it's written also with ap_rwrite
-      ap_rwrite(PChar(S),Length(S),FRequest);
-      end;
+    begin
+    S:=Content;
+    ap_rwrite(PAnsiChar(S),Length(S),FRequest);
+    end;
 end;
 end;
 
 
 Procedure TApacheResponse.SendStream(S : TStream);
 Procedure TApacheResponse.SendStream(S : TStream);
@@ -715,14 +777,14 @@ end;
 
 
 procedure TCustomApacheApplication.ShowException(E: Exception);
 procedure TCustomApacheApplication.ShowException(E: Exception);
 begin
 begin
-  ap_log_error(PChar(TApacheHandler(WebHandler).ModuleName),  //The file in which this function is called
+  ap_log_error(PAnsiChar(TApacheHandler(WebHandler).ModuleName),  //The file in which this function is called
                0,                                             //The line number on which this function is called
                0,                                             //The line number on which this function is called
                0,                                             //The module_index of the module generating this message
                0,                                             //The module_index of the module generating this message
                APLOG_ERR,                                     //The level of this error message
                APLOG_ERR,                                     //The level of this error message
                0,                                             //The status code from the previous command
                0,                                             //The status code from the previous command
                Nil,                                           //The server on which we are logging
                Nil,                                           //The server on which we are logging
                'module: %s',                                  //The format string
                'module: %s',                                  //The format string
-               [Pchar(E.Message)]);                           //The arguments to use to fill out fmt.
+               [PAnsiChar(E.Message)]);                           //The arguments to use to fill out fmt.
 end;
 end;
 
 
 function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec): Integer;
 function TCustomApacheApplication.ProcessRequest(P: PRequest_Rec): Integer;

+ 108 - 37
packages/fcl-web/src/base/custfcgi.pp

@@ -47,6 +47,7 @@ Type
   TProtocolOption = (poNoPadding,poStripContentLength, poFailonUnknownRecord,
   TProtocolOption = (poNoPadding,poStripContentLength, poFailonUnknownRecord,
                      poReuseAddress, poUseSelect );
                      poReuseAddress, poUseSelect );
   TProtocolOptions = Set of TProtocolOption;
   TProtocolOptions = Set of TProtocolOption;
+  TPathInfoHandling = (pihNone,pohAll,pihLastScriptComponent,pihFirstScriptComponent,pihSkipFirstScriptComponent);
 
 
   TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
   TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
   TFastCGIReadEvent = Function (AHandle : THandle; Var ABuf; ACount : Integer) : Integer of Object;
   TFastCGIReadEvent = Function (AHandle : THandle; Var ABuf; ACount : Integer) : Integer of Object;
@@ -56,14 +57,12 @@ Type
   Private
   Private
     FHandle: THandle;
     FHandle: THandle;
     FKeepConnectionAfterRequest: boolean;
     FKeepConnectionAfterRequest: boolean;
+    FPathInfoHandling: TPathInfoHandling;
     FPO: TProtoColOptions;
     FPO: TProtoColOptions;
     FRequestID : Word;
     FRequestID : Word;
     FCGIParams : TSTrings;
     FCGIParams : TSTrings;
     FUR: TUnknownRecordEvent;
     FUR: TUnknownRecordEvent;
     FLog : TLogEvent;
     FLog : TLogEvent;
-    FSTDin : String;
-    FSTDinRead: Integer;
-
     FRequestHeadersInitialized: Boolean;
     FRequestHeadersInitialized: Boolean;
     FStreamingContentReceived: Boolean;
     FStreamingContentReceived: Boolean;
   Protected
   Protected
@@ -77,6 +76,7 @@ Type
     property Handle : THandle read FHandle write FHandle;
     property Handle : THandle read FHandle write FHandle;
     property KeepConnectionAfterRequest : boolean read FKeepConnectionAfterRequest;
     property KeepConnectionAfterRequest : boolean read FKeepConnectionAfterRequest;
     Property ProtocolOptions : TProtoColOptions read FPO Write FPO;
     Property ProtocolOptions : TProtoColOptions read FPO Write FPO;
+    Property PathInfoHandling : TPathInfoHandling Read FPathInfoHandling Write FPathInfoHandling;
     Property OnUnknownRecord : TUnknownRecordEvent Read FUR Write FUR;
     Property OnUnknownRecord : TUnknownRecordEvent Read FUR Write FUR;
   end;
   end;
   TFCGIRequestClass = Class of TFCGIRequest;
   TFCGIRequestClass = Class of TFCGIRequest;
@@ -106,6 +106,7 @@ Type
   Private
   Private
     FLingerTimeOut: integer;
     FLingerTimeOut: integer;
     FOnUnknownRecord: TUnknownRecordEvent;
     FOnUnknownRecord: TUnknownRecordEvent;
+    FPathInfoHandling: TPathInfoHandling;
     FPO: TProtoColOptions;
     FPO: TProtoColOptions;
     FRequestsArray : Array of TReqResp;
     FRequestsArray : Array of TReqResp;
     FRequestsAvail : integer;
     FRequestsAvail : integer;
@@ -146,6 +147,7 @@ Type
     Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
     Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
     Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
     Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
     Property TimeOut : Integer Read FTimeOut Write FTimeOut;
     Property TimeOut : Integer Read FTimeOut Write FTimeOut;
+    Property PathInfoHandling : TPathInfoHandling Read FPathInfoHandling Write FPathInfoHandling;
   end;
   end;
   TFCgiHandlerClass = Class of TFCgiHandler;
   TFCgiHandlerClass = Class of TFCgiHandler;
 
 
@@ -154,22 +156,27 @@ Type
   TCustomFCgiApplication = Class(TCustomWebApplication)
   TCustomFCgiApplication = Class(TCustomWebApplication)
   private
   private
     function GetAddress: string;
     function GetAddress: string;
+    function GetCH: TFCgiHandler;
     function GetFPO: TProtoColOptions;
     function GetFPO: TProtoColOptions;
     function GetLingerTimeOut: integer;
     function GetLingerTimeOut: integer;
     function GetOnUnknownRecord: TUnknownRecordEvent;
     function GetOnUnknownRecord: TUnknownRecordEvent;
+    function GetPIH: TPathInfoHandling;
     function GetPort: integer;
     function GetPort: integer;
     procedure SetAddress(const AValue: string);
     procedure SetAddress(const AValue: string);
     procedure SetLingerTimeOut(const AValue: integer);
     procedure SetLingerTimeOut(const AValue: integer);
     procedure SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
     procedure SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
+    procedure SetPIH(AValue: TPathInfoHandling);
     procedure SetPort(const AValue: integer);
     procedure SetPort(const AValue: integer);
     procedure SetPO(const AValue: TProtoColOptions);
     procedure SetPO(const AValue: TProtoColOptions);
   protected
   protected
     function InitializeWebHandler: TWebHandler; override;
     function InitializeWebHandler: TWebHandler; override;
+    Property FCGIHandler : TFCgiHandler Read GetCH;
   Public
   Public
     property Port: integer read GetPort write SetPort;
     property Port: integer read GetPort write SetPort;
     property LingerTimeOut : integer read GetLingerTimeOut write SetLingerTimeOut;
     property LingerTimeOut : integer read GetLingerTimeOut write SetLingerTimeOut;
     property Address: string read GetAddress write SetAddress;
     property Address: string read GetAddress write SetAddress;
     Property ProtocolOptions : TProtoColOptions Read GetFPO Write SetPO;
     Property ProtocolOptions : TProtoColOptions Read GetFPO Write SetPO;
+    Property PathInfoHandling : TPathInfoHandling Read GetPIH Write SetPIH;
     Property OnUnknownRecord : TUnknownRecordEvent Read GetOnUnknownRecord Write SetOnUnknownRecord;
     Property OnUnknownRecord : TUnknownRecordEvent Read GetOnUnknownRecord Write SetOnUnknownRecord;
   end;
   end;
 
 
@@ -190,10 +197,12 @@ ResourceString
   
   
 Implementation
 Implementation
 
 
-{$ifdef CGIDEBUG}
 uses
 uses
-  dbugintf;
+{$ifdef CGIDEBUG}
+  dbugintf,
 {$endif}
 {$endif}
+  strutils;
+
 {$undef nosignal}
 {$undef nosignal}
 
 
 {$if defined(FreeBSD) or defined(Linux)}
 {$if defined(FreeBSD) or defined(Linux)}
@@ -336,20 +345,32 @@ var
     inc(i);
     inc(i);
   end;
   end;
 
 
-  function GetString(ALength : integer) : string;
+  function GetBytes(ALength : integer) : TBytes;
   begin
   begin
     if (ALength<0) then
     if (ALength<0) then
       ALength:=0;
       ALength:=0;
     SetLength(Result,ALength);
     SetLength(Result,ALength);
     if (ALength>0) then
     if (ALength>0) then
-      move(ARecord^.ContentData[i],Result[1],ALength);
+      move(ARecord^.ContentData[i],Result[0],ALength);
     inc(i,ALength);
     inc(i,ALength);
   end;
   end;
 
 
+  function MakeString(B : TBytes) : string;
+
+
+  begin
+    {$IF SIZEOF(CHAR)=2}
+      Result:=TEncoding.UTF8.GetString(B);
+    {$else}
+      Result:=TEncoding.UTF8.GetAnsiString(B);
+    {$ENDIF}
+  end;
+
 var
 var
-  VarNo,NameLength, ValueLength : Integer;
+  NameLength, ValueLength : Integer;
   RecordLength : Integer;
   RecordLength : Integer;
-  Name,Value : String;
+  Name,Tmp : String;
+  Value : TBytes;
   h : THeader;
   h : THeader;
   v : THTTPVariableType;
   v : THTTPVariableType;
 
 
@@ -360,23 +381,44 @@ begin
     begin
     begin
     NameLength:=GetVarLength;
     NameLength:=GetVarLength;
     ValueLength:=GetVarLength;
     ValueLength:=GetVarLength;
-    Name:=GetString(NameLength);
-    Value:=GetString(ValueLength);
-    VarNo:=IndexOfCGIVar(Name);
+    Name:=MakeString(GetBytes(NameLength));
+    Value:=GetBytes(ValueLength);
     if Not DoMapCgiToHTTP(Name,H,V) then
     if Not DoMapCgiToHTTP(Name,H,V) then
-      NameValueList.Add(Name+'='+Value)
+      NameValueList.Add(Name+'='+MakeString(Value))
     else if (H<>hhUnknown) then
     else if (H<>hhUnknown) then
-      SetHeader(H,Value)
+      SetHeader(H,MakeString(Value))
+    else if (v=hvContent) then
+      ContentBytes:=Value
     else if (v<>hvUnknown) then
     else if (v<>hvUnknown) then
       begin
       begin
-      if (V=hvPathInfo) and (Copy(Value,1,2)='//') then //mod_proxy_fcgi gives double slashes at the beginning for some reason
-          Delete(Value,1,3);
+      Tmp:=MakeString(Value);
+      if (V=hvPathInfo) and (Copy(Tmp,1,2)='//') then //mod_proxy_fcgi gives double slashes at the beginning for some reason
+          Delete(Tmp,1,3);
       if (V<>hvQuery) then
       if (V<>hvQuery) then
-        Value:=HTTPDecode(Value);
-      SetHTTPVariable(v,Value);
+        Tmp:=HTTPDecode(Tmp);
+      SetHTTPVariable(v,Tmp);
       end
       end
     else
     else
-      NameValueList.Add(Name+'='+Value)
+      NameValueList.Add(Name+'='+MakeString(Value));
+    end;
+  if (PathInfo='') then
+    // Apache does not send PathInfo if configured via proxy
+    begin
+    Tmp:=ScriptName;
+    ValueLength:=Length(Tmp);
+    Case PathInfoHandling of
+      pihNone : ;
+      pohAll : PathInfo:=Tmp;
+      pihLastScriptComponent :
+         PathInfo:=Copy(Tmp,RPos('/',Tmp)+1,ValueLength);
+      pihFirstScriptComponent :
+         PathInfo:=Copy(Tmp,RPos('/',Tmp)-1,ValueLength);
+      pihSkipFirstScriptComponent:
+        begin
+        Delete(Value,1,RPos('/',ScriptName));
+        PathInfo:=Tmp;
+        end;
+    end;
     end;
     end;
   // Microsoft-IIS hack. IIS includes the script name in the PATH_INFO
   // Microsoft-IIS hack. IIS includes the script name in the PATH_INFO
   if Pos('IIS', ServerSoftware) > 0 then
   if Pos('IIS', ServerSoftware) > 0 then
@@ -429,7 +471,7 @@ procedure TFCGIResponse.DoSendHeaders(Headers : TStrings);
 var
 var
   cl : word;
   cl : word;
   pl : byte;
   pl : byte;
-  str : String;
+  str : AnsiString;
   ARespRecord : PFCGI_ContentRecord;
   ARespRecord : PFCGI_ContentRecord;
   I : Integer;
   I : Integer;
 
 
@@ -442,7 +484,11 @@ begin
     For I:=Headers.Count-1 downto 0 do
     For I:=Headers.Count-1 downto 0 do
       If (Pos('Content-Length',Headers[i])<>0)  then
       If (Pos('Content-Length',Headers[i])<>0)  then
         Headers.Delete(i);
         Headers.Delete(i);
+  {$if SIZEOF(CHAR)=2}
+  str := UTF8Encode(Headers.Text+sLineBreak);
+  {$ELSE}
   str := Headers.Text+sLineBreak;
   str := Headers.Text+sLineBreak;
+  {$ENDIF}
   cl := length(str);
   cl := length(str);
   if ((cl mod 8)=0) or (poNoPadding in ProtocolOptions) then
   if ((cl mod 8)=0) or (poNoPadding in ProtocolOptions) then
     pl:=0
     pl:=0
@@ -473,19 +519,26 @@ var
   bs,l : Integer;
   bs,l : Integer;
   cl : word;
   cl : word;
   pl : byte;
   pl : byte;
-  str : String;
+  str : TBytes;
   ARespRecord : PFCGI_ContentRecord;
   ARespRecord : PFCGI_ContentRecord;
   EndRequest : FCGI_EndRequestRecord;
   EndRequest : FCGI_EndRequestRecord;
 
 
 begin
 begin
+  Str:=[];
   If Assigned(ContentStream) then
   If Assigned(ContentStream) then
     begin
     begin
     setlength(str,ContentStream.Size);
     setlength(str,ContentStream.Size);
     ContentStream.Position:=0;
     ContentStream.Position:=0;
-    ContentStream.Read(str[1],ContentStream.Size);
+    ContentStream.Read(str[0],ContentStream.Size);
     end
     end
   else
   else
-    str := Contents.Text;
+    begin
+    {$IF SIZEOF(CHAR)=2}
+    str := TENcoding.UTF8.GetBytes(Contents.Text);
+    {$ELSE}
+    str := TENcoding.UTF8.GetAnsiBytes(Contents.Text);
+    {$ENDIF}
+    end;
   L:=Length(Str);
   L:=Length(Str);
   BS:=0;
   BS:=0;
   Repeat
   Repeat
@@ -505,7 +558,7 @@ begin
       ARespRecord^.header.paddingLength:=pl;
       ARespRecord^.header.paddingLength:=pl;
       ARespRecord^.header.contentLength:=NtoBE(cl);
       ARespRecord^.header.contentLength:=NtoBE(cl);
       ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
       ARespRecord^.header.requestId:=NToBE(TFCGIRequest(Request).RequestID);
-      move(Str[BS+1],ARespRecord^.ContentData,cl);
+      move(Str[BS],ARespRecord^.ContentData,cl);
       Write_FCGIRecord(PFCGI_Header(ARespRecord));
       Write_FCGIRecord(PFCGI_Header(ARespRecord));
     finally
     finally
       Freemem(ARespRecord);
       Freemem(ARespRecord);
@@ -643,7 +696,7 @@ function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
         if s2[1] = ' ' then s2[1] := '0';
         if s2[1] = ' ' then s2[1] := '0';
         s1 := s1 + s2;
         s1 := s1 + s2;
         If PByte(ResRecord)[i]>32 then
         If PByte(ResRecord)[i]>32 then
-          S:=S+char(PByte(ResRecord)[i])
+          S:=S+AnsiChar(PByte(ResRecord)[i])
         else
         else
           S:=S+' ';
           S:=S+' ';
         if (I>0) and (((I+1) mod 16) = 0) then
         if (I>0) and (((I+1) mod 16) = 0) then
@@ -728,7 +781,8 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TFCgiHandler.SetupSocket(var IAddress : TInetSockAddr; Var AddressLength : tsocklen);
+procedure TFCgiHandler.SetupSocket(var IAddress: TInetSockAddr;
+  var AddressLength: tsocklen);
 
 
 Var
 Var
   L : Linger;
   L : Linger;
@@ -824,6 +878,8 @@ begin
   if (C=Nil) then
   if (C=Nil) then
     C:=TFCGIRequest;
     C:=TFCGIRequest;
   Result:=C.Create;
   Result:=C.Create;
+  if Result is TFCGIRequest then
+    TFCGIRequest(Result).PathInfoHandling:=PathInfoHandling;
 end;
 end;
 
 
 function TFCgiHandler.CreateResponse(ARequest: TFCGIRequest): TFCGIResponse;
 function TFCgiHandler.CreateResponse(ARequest: TFCGIRequest): TFCGIResponse;
@@ -848,7 +904,7 @@ begin
 end;
 end;
 
 
 function TFCgiHandler.DoFastCGIWrite(AHandle: THandle; const ABuf;
 function TFCgiHandler.DoFastCGIWrite(AHandle: THandle; const ABuf;
-  ACount: Integer; Out ExtendedErrorCode : Integer): Integer;
+  ACount: Integer; out ExtendedErrorCode: Integer): Integer;
 begin
 begin
   {$ifdef windowspipe}
   {$ifdef windowspipe}
   if FIsWinPipe then
   if FIsWinPipe then
@@ -1005,52 +1061,67 @@ end;
 
 
 function TCustomFCgiApplication.GetAddress: string;
 function TCustomFCgiApplication.GetAddress: string;
 begin
 begin
-  result := TFCgiHandler(WebHandler).Address;
+  result := FCGIHandler.Address;
+end;
+
+function TCustomFCgiApplication.GetCH: TFCgiHandler;
+begin
+  Result:=WebHandler as TFCgiHandler;
 end;
 end;
 
 
 function TCustomFCgiApplication.GetFPO: TProtoColOptions;
 function TCustomFCgiApplication.GetFPO: TProtoColOptions;
 begin
 begin
-  result := TFCgiHandler(WebHandler).ProtocolOptions;
+  result := FCGIHandler.ProtocolOptions;
 end;
 end;
 
 
 function TCustomFCgiApplication.GetLingerTimeOut: integer;
 function TCustomFCgiApplication.GetLingerTimeOut: integer;
 begin
 begin
-  Result:=TFCgiHandler(WebHandler).LingerTimeOut;
+  Result:=FCGIHandler.LingerTimeOut;
 end;
 end;
 
 
 function TCustomFCgiApplication.GetOnUnknownRecord: TUnknownRecordEvent;
 function TCustomFCgiApplication.GetOnUnknownRecord: TUnknownRecordEvent;
 begin
 begin
-  result := TFCgiHandler(WebHandler).OnUnknownRecord;
+  result := FCGIHandler.OnUnknownRecord;
+end;
+
+function TCustomFCgiApplication.GetPIH: TPathInfoHandling;
+begin
+  Result:=FCGIHandler.PathInfoHandling;
 end;
 end;
 
 
 function TCustomFCgiApplication.GetPort: integer;
 function TCustomFCgiApplication.GetPort: integer;
 begin
 begin
-  result := TFCgiHandler(WebHandler).Port;
+  result := FCGIHandler.Port;
 end;
 end;
 
 
 procedure TCustomFCgiApplication.SetAddress(const AValue: string);
 procedure TCustomFCgiApplication.SetAddress(const AValue: string);
 begin
 begin
-  TFCgiHandler(WebHandler).Address := AValue;
+  FCGIHandler.Address := AValue;
 end;
 end;
 
 
 procedure TCustomFCgiApplication.SetLingerTimeOut(const AValue: integer);
 procedure TCustomFCgiApplication.SetLingerTimeOut(const AValue: integer);
 begin
 begin
-  TFCgiHandler(WebHandler).LingerTimeOut:=AValue;
+  FCGIHandler.LingerTimeOut:=AValue;
 end;
 end;
 
 
 procedure TCustomFCgiApplication.SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
 procedure TCustomFCgiApplication.SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
 begin
 begin
-  TFCgiHandler(WebHandler).OnUnknownRecord := AValue;
+  FCGIHandler.OnUnknownRecord := AValue;
+end;
+
+procedure TCustomFCgiApplication.SetPIH(AValue: TPathInfoHandling);
+begin
+  FCGIHandler.PathInfoHandling:=aValue;
 end;
 end;
 
 
 procedure TCustomFCgiApplication.SetPort(const AValue: integer);
 procedure TCustomFCgiApplication.SetPort(const AValue: integer);
 begin
 begin
-  TFCgiHandler(WebHandler).Port := AValue;
+  FCGIHandler.Port := AValue;
 end;
 end;
 
 
 procedure TCustomFCgiApplication.SetPO(const AValue: TProtoColOptions);
 procedure TCustomFCgiApplication.SetPO(const AValue: TProtoColOptions);
 begin
 begin
-  TFCgiHandler(WebHandler).ProtocolOptions := AValue;
+  FCGIHandler.ProtocolOptions := AValue;
 end;
 end;
 
 
 function TCustomFCgiApplication.InitializeWebHandler: TWebHandler;
 function TCustomFCgiApplication.InitializeWebHandler: TWebHandler;

+ 81 - 20
packages/fcl-web/src/base/custmicrohttpapp.pp

@@ -105,6 +105,7 @@ Type
   TMicroHTTPHandler = class(TWebHandler)
   TMicroHTTPHandler = class(TWebHandler)
   Private
   Private
     FAcceptHandler: TAcceptHandler;
     FAcceptHandler: TAcceptHandler;
+    FAddress: String;
     FExtraHeaders: TStrings;
     FExtraHeaders: TStrings;
     FOnRequestError: TRequestErrorHandler;
     FOnRequestError: TRequestErrorHandler;
     FPort : Word;
     FPort : Word;
@@ -144,17 +145,21 @@ Type
     Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
     Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
     // Extra non-standard headers which can be accepted as part of requests
     // Extra non-standard headers which can be accepted as part of requests
     Property ExtraHeaders : TStrings Read FExtraHeaders Write SetExtraHeaders;
     Property ExtraHeaders : TStrings Read FExtraHeaders Write SetExtraHeaders;
+    // Interface Address to listen on
+    Property Address : String Read FAddress Write FAddress;
   end;
   end;
 
 
   { TCustomMicroHTTPApplication }
   { TCustomMicroHTTPApplication }
 
 
   TCustomMicroHTTPApplication = Class(TCustomWebApplication)
   TCustomMicroHTTPApplication = Class(TCustomWebApplication)
   private
   private
+    function GetAddress: String;
     function GetExtraHeaders: TStrings;
     function GetExtraHeaders: TStrings;
     function GetHostName: String;
     function GetHostName: String;
     function GetOptions: TMicroServerOptions;
     function GetOptions: TMicroServerOptions;
     function GetPort: Word;
     function GetPort: Word;
     function GetUseSSL: Boolean;
     function GetUseSSL: Boolean;
+    procedure SetAddress(AValue: String);
     procedure SetExtraHeaders(AValue: TStrings);
     procedure SetExtraHeaders(AValue: TStrings);
     procedure SetHostName(const AValue: String);
     procedure SetHostName(const AValue: String);
     procedure SetOptions(AValue: TMicroServerOptions);
     procedure SetOptions(AValue: TMicroServerOptions);
@@ -175,6 +180,8 @@ Type
     Property UseSSL : Boolean Read GetUseSSL Write SetUSeSSL;
     Property UseSSL : Boolean Read GetUseSSL Write SetUSeSSL;
     // Extra non-standard headers which can be accepted as part of requests
     // Extra non-standard headers which can be accepted as part of requests
     Property ExtraHeaders : TStrings Read GetExtraHeaders Write SetExtraHeaders;
     Property ExtraHeaders : TStrings Read GetExtraHeaders Write SetExtraHeaders;
+    // Interface Address to listen on
+    Property Address : String Read GetAddress Write SetAddress;
   end;
   end;
 
 
 
 
@@ -193,7 +200,7 @@ Const
   MHD_USE_DEBUG,
   MHD_USE_DEBUG,
   MHD_USE_SSL,
   MHD_USE_SSL,
   MHD_USE_THREAD_PER_CONNECTION,
   MHD_USE_THREAD_PER_CONNECTION,
-  MHD_USE_SELECT_INTERNALLY,
+  MHD_USE_INTERNAL_POLLING_THREAD,
   MHD_USE_IPv6,
   MHD_USE_IPv6,
   MHD_USE_PEDANTIC_CHECKS,
   MHD_USE_PEDANTIC_CHECKS,
   MHD_USE_POLL,
   MHD_USE_POLL,
@@ -210,9 +217,18 @@ Const
   libmicrohttp Callbacks
   libmicrohttp Callbacks
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
-Function MaybeS(p : pchar) : String;
+Function MaybeS(p : PAnsiChar) : String;
+
+Var
+  S : AnsiString;
+
 begin
 begin
-  if Assigned(P) then Result:=P else Result:='';
+  if Assigned(P) then S:=P else S:='';
+  {$IF SIZEOF(CHAR)=2}
+  Result:=UTF8Decode(S);
+  {$ELSE}
+  Result:=S;
+  {$ENDIF}
 end;
 end;
 
 
 function GetRequestData(cls: Pointer; kind: MHD_ValueKind; key: Pcchar; value: Pcchar): cint; cdecl;
 function GetRequestData(cls: Pointer; kind: MHD_ValueKind; key: Pcchar; value: Pcchar): cint; cdecl;
@@ -221,6 +237,7 @@ var
   K,V : String;
   K,V : String;
 
 
 
 
+
 begin
 begin
   K:=MaybeS(key);
   K:=MaybeS(key);
   V:=MaybeS(Value);
   V:=MaybeS(Value);
@@ -340,15 +357,23 @@ end;
 function TMicroRequest.AddData(Data: PAnsiChar; DataSize: Size_t): Size_t;
 function TMicroRequest.AddData(Data: PAnsiChar; DataSize: Size_t): Size_t;
 
 
 Var
 Var
-  C : String;
+  C : RawByteString;
   L : Integer;
   L : Integer;
 
 
 begin
 begin
+  {$IF SIZEOF(CHAR)=2}
+  C:=UTF8Encode(Content);
+  {$ELSE}
   C:=Content;
   C:=Content;
+  {$ENDIF}
   L:=Length(C);
   L:=Length(C);
   SetLength(C,L+Datasize);
   SetLength(C,L+Datasize);
   Move(Data^,C[L+1],DataSize);
   Move(Data^,C[L+1],DataSize);
+  {$IF SIZEOF(CHAR)=2}
+  InitContent(UTF8Decode(C));
+  {$ELSE}
   InitContent(C);
   InitContent(C);
+  {$ENDIF}
   Result:=Datasize;
   Result:=Datasize;
 end;
 end;
 
 
@@ -364,18 +389,33 @@ end;
 procedure TMicroRequest.InitRequestVars;
 procedure TMicroRequest.InitRequestVars;
 
 
 Var
 Var
-  P : Pchar;
-  N,S  : String;
+  P : PAnsiChar;
+  N  : AnsiString;
+  HN,S,V : String;
   I : integer;
   I : integer;
 
 
 begin
 begin
   MHD_get_connection_values(FHandler.FConnection, MHD_GET_ARGUMENT_KIND,@GetRequestData,Self);
   MHD_get_connection_values(FHandler.FConnection, MHD_GET_ARGUMENT_KIND,@GetRequestData,Self);
   MHD_get_connection_values(FHandler.FConnection, MHD_HEADER_KIND,@GetRequestData,Self);
   MHD_get_connection_values(FHandler.FConnection, MHD_HEADER_KIND,@GetRequestData,Self);
-  for N in FHandler.WebHandler.ExtraHeaders do
+  for S in FHandler.WebHandler.ExtraHeaders do
     begin
     begin
-    P:=MHD_lookup_connection_value(FHandler.FConnection, MHD_HEADER_KIND,Pchar(N));
+    {$IF SIZEOF(Char)=2}
+    N:=UTF8Encode(S);
+    {$ELSE}
+    N:=S;
+    {$ENDIF}
+    P:=MHD_lookup_connection_value(FHandler.FConnection, MHD_HEADER_KIND,PAnsiChar(N));
     If P<>Nil then
     If P<>Nil then
-      SetCustomHeader(N,P);
+      begin
+      {$IF SIZEOF(Char)=2}
+      HN:=UTF8Decode(N);
+      V:=UTF8Decode(P);
+      {$ELSE}
+      HN:=N;
+      V:=P;
+      {$ENDIF}
+      SetCustomHeader(HN,V);
+      end;
     end;
     end;
   S:=URL;
   S:=URL;
   I:=Pos('?',S);
   I:=Pos('?',S);
@@ -400,7 +440,7 @@ procedure TMicroResponse.MaybeAllocateResponse;
 
 
 Var
 Var
   L : Integer;
   L : Integer;
-  P : PChar;
+  P : PAnsiChar;
   B : TBytes;
   B : TBytes;
 
 
 begin
 begin
@@ -416,14 +456,15 @@ begin
       begin
       begin
       SetLength(B,L);
       SetLength(B,L);
       ContentStream.ReadBuffer(B[0],L);
       ContentStream.ReadBuffer(B[0],L);
-      P:=Pchar(B);
+      P:=PAnsiChar(B);
       FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
       FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
       end;
       end;
     end
     end
   else
   else
     begin
     begin
-    L:=Length(Content);
-    P:=PChar(Content);
+    B:=TEncoding.UTF8.GetAnsiBytes(Content);
+    L:=Length(B);
+    P:=PAnsiChar(B);
     FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
     FResponse:=MHD_create_response_from_buffer(L,P,MHD_RESPMEM_MUST_COPY);
     end;
     end;
 end;
 end;
@@ -433,6 +474,8 @@ procedure TMicroResponse.DoSendHeaders(Headers: TStrings);
 Var
 Var
   I : Integer;
   I : Integer;
   N,V : String;
   N,V : String;
+  NA : RawByteString {$IF SIZEOF(CHAR)=1}absolute N{$ENDIF};
+  VA : RawByteString {$IF SIZEOF(CHAR)=1}absolute V{$ENDIF};
 
 
 begin
 begin
   // Note that if the response is allocated, then you cannot set the content stream any more...
   // Note that if the response is allocated, then you cannot set the content stream any more...
@@ -441,7 +484,11 @@ begin
   For I:=0 to Headers.Count-1 do
   For I:=0 to Headers.Count-1 do
     begin
     begin
     Headers.GetNameValue(I,N,V);
     Headers.GetNameValue(I,N,V);
-    MHD_add_response_header(FResponse,PAnsiChar(N),PAnsiChar(V));
+    {$IF SIZEOF(CHAR)=2}
+    NA:=UTF8Encode(N);
+    VA:=UTF8Encode(V);
+    {$ENDIF}
+    MHD_add_response_header(FResponse,PAnsiChar(NA),PAnsiChar(VA));
     end;
     end;
 end;
 end;
 
 
@@ -536,7 +583,9 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TMicroHTTPHandler.DoRequest(connection: PMHD_Connection; Const aUrl,aMethod,aVersion: String; Data: PAnsiChar; var DataSize: Size_t) : TRequestHandler;
+function TMicroHTTPHandler.DoRequest(connection: PMHD_Connection; const aUrl,
+  aMethod, aVersion: String; Data: PAnsiChar; var DataSize: Size_t
+  ): TRequestHandler;
 
 
 begin
 begin
   Result:=TRequestHandler.Create(Self,Connection);
   Result:=TRequestHandler.Create(Self,Connection);
@@ -609,7 +658,8 @@ begin
   AResponse:=Nil;
   AResponse:=Nil;
 end;
 end;
 
 
-Function TMicroHTTPHandler.DoAcceptConnection(Addr : PSockAddr; addrLen : socklen_t) : Boolean;
+function TMicroHTTPHandler.DoAcceptConnection(Addr: PSockAddr;
+  addrLen: socklen_t): Boolean;
 
 
 begin
 begin
   Result:=True;
   Result:=True;
@@ -634,7 +684,8 @@ end;
 function TMicroHTTPHandler.CreateServer: PMHD_Daemon;
 function TMicroHTTPHandler.CreateServer: PMHD_Daemon;
 
 
 Var
 Var
-  F,P : Integer;
+  F : Integer;
+  P : Word;
 
 
 begin
 begin
   F:=OptionsToFlags;
   F:=OptionsToFlags;
@@ -642,8 +693,8 @@ begin
   Result:= MHD_start_daemon(F,P,
   Result:= MHD_start_daemon(F,P,
     @AcceptCallBack, Self,
     @AcceptCallBack, Self,
     @DoMHDRequest, Self,
     @DoMHDRequest, Self,
-    MHD_OPTION_NOTIFY_COMPLETED, @HandleRequestCompleted,
-    Nil,MHD_OPTION_END);
+    MHD_OPTION_NOTIFY_COMPLETED, @HandleRequestCompleted, Nil,
+    MHD_OPTION_END,Nil);
 end;
 end;
 
 
 procedure TMicroHTTPHandler.Run;
 procedure TMicroHTTPHandler.Run;
@@ -702,7 +753,7 @@ begin
   HTTPHandler.Port:=aValue;
   HTTPHandler.Port:=aValue;
 end;
 end;
 
 
-procedure TCustomMicroHTTPApplication.SetUSeSSL(AValue: Boolean);
+procedure TCustomMicroHTTPApplication.SetUseSSL(AValue: Boolean);
 begin
 begin
   if AValue then
   if AValue then
     Options:=Options+[mcoSSL]
     Options:=Options+[mcoSSL]
@@ -720,6 +771,11 @@ begin
   Result:=mcoSSL in Options;
   Result:=mcoSSL in Options;
 end;
 end;
 
 
+procedure TCustomMicroHTTPApplication.SetAddress(AValue: String);
+begin
+  HTTPHandler.Address:=aValue;
+end;
+
 procedure TCustomMicroHTTPApplication.SetExtraHeaders(AValue: TStrings);
 procedure TCustomMicroHTTPApplication.SetExtraHeaders(AValue: TStrings);
 begin
 begin
   HTTPHandler.ExtraHeaders.Assign(AValue);
   HTTPHandler.ExtraHeaders.Assign(AValue);
@@ -747,6 +803,11 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
+function TCustomMicroHTTPApplication.GetAddress: String;
+begin
+  Result:=HTTPHandler.Address;
+end;
+
 function TCustomMicroHTTPApplication.GetExtraHeaders: TStrings;
 function TCustomMicroHTTPApplication.GetExtraHeaders: TStrings;
 begin
 begin
   Result:=HTTPHandler.ExtraHeaders;
   Result:=HTTPHandler.ExtraHeaders;

+ 7 - 7
packages/fcl-web/src/base/fcgigate.pp

@@ -106,7 +106,7 @@ Type
     // Transform CGI environment variables.
     // Transform CGI environment variables.
     Function TransformRequestVars: String;virtual;
     Function TransformRequestVars: String;virtual;
     // Encode name=value pair for PARAMS fastcgi record.
     // Encode name=value pair for PARAMS fastcgi record.
-    Function EncodeFastCGIParam(N, V: AnsiString): String;
+    Function EncodeFastCGIParam(N, V: AnsiString): ansiString;
     // High-level Communication
     // High-level Communication
     // Send data from request
     // Send data from request
     procedure SendRequestData(const ARequest : TRequest); virtual;
     procedure SendRequestData(const ARequest : TRequest); virtual;
@@ -246,7 +246,7 @@ begin
       Result:=Result+Format('#%.3d',[Ord(S[i])]);
       Result:=Result+Format('#%.3d',[Ord(S[i])]);
 end;
 end;
 
 
-Function TFastCGIGatewayHandler.EncodeFastCGIParam(N,V : AnsiString) : String;
+Function TFastCGIGatewayHandler.EncodeFastCGIParam(N,V : AnsiString) : AnsiString;
 
 
   Function CalcJump(ALen : Integer) : Integer;
   Function CalcJump(ALen : Integer) : Integer;
   begin
   begin
@@ -256,7 +256,7 @@ Function TFastCGIGatewayHandler.EncodeFastCGIParam(N,V : AnsiString) : String;
       Result:=4;
       Result:=4;
   end;
   end;
 
 
-  Procedure AddLengthEncoding(Var S : String; ALen : Integer; Var Offset : Integer);
+  Procedure AddLengthEncoding(Var S : AnsiString; ALen : Integer; Var Offset : Integer);
 
 
   Var
   Var
     J,L : integer;
     J,L : integer;
@@ -445,7 +445,7 @@ var
   BytesRead : integer;
   BytesRead : integer;
   ContentLength : word;
   ContentLength : word;
   PaddingLength : byte;
   PaddingLength : byte;
-  ReadBuf : Pchar;
+  ReadBuf : PAnsiChar;
 
 
   function ReadBytes(ByteAmount : Word) : boolean;
   function ReadBytes(ByteAmount : Word) : boolean;
 
 
@@ -470,7 +470,7 @@ begin
   PaddingLength:=Header.paddingLength;
   PaddingLength:=Header.paddingLength;
   Result:=Getmem(BytesRead+ContentLength+PaddingLength);
   Result:=Getmem(BytesRead+ContentLength+PaddingLength);
   Result^:=Header;
   Result^:=Header;
-  ReadBuf:=Pchar(Result)+SizeOf(Header);
+  ReadBuf:=PAnsiChar(Result)+SizeOf(Header);
   ReadBytes(ContentLength);
   ReadBytes(ContentLength);
   ReadBuf:=ReadBuf+BytesRead;
   ReadBuf:=ReadBuf+BytesRead;
   ReadBytes(PaddingLength);
   ReadBytes(PaddingLength);
@@ -492,7 +492,7 @@ Procedure TFastCGIGatewayHandler.ReadResponse(AResponse : TResponse);
 Var
 Var
   Rec : PFCGI_Header;
   Rec : PFCGI_Header;
   CL : Integer;
   CL : Integer;
-  WBuf : PChar;
+  WBuf : PAnsiChar;
   EOR : Boolean;
   EOR : Boolean;
 
 
 begin
 begin
@@ -508,7 +508,7 @@ begin
          begin
          begin
          AResponse.ContentStream:=TMemoryStream.Create;
          AResponse.ContentStream:=TMemoryStream.Create;
          end;
          end;
-      WBuf:=Pchar(Rec)+SizeOf(FCGI_Header);
+      WBuf:=PAnsiChar(Rec)+SizeOf(FCGI_Header);
       AResponse.ContentStream.WriteBuffer(WBuf^,CL);
       AResponse.ContentStream.WriteBuffer(WBuf^,CL);
       end
       end
     else If (Rec^.ReqType=FCGI_END_REQUEST) and (CL>0) then
     else If (Rec^.ReqType=FCGI_END_REQUEST) and (CL>0) then

+ 11 - 3
packages/fcl-web/src/base/fpapache.pp

@@ -43,12 +43,20 @@ Type
     Property WorkingWebModuleCount;
     Property WorkingWebModuleCount;
   end;
   end;
 
 
+Function Application : TCustomApacheApplication;
+
 Implementation
 Implementation
 
 
+Function Application : TCustomApacheApplication;
+
+begin
+  Result:=CustApache.Application;
+end;
+
 Procedure InitApache;
 Procedure InitApache;
 
 
 begin
 begin
-  Application:=TApacheApplication.Create(Nil);
+  custapache.Application:=TApacheApplication.Create(Nil);
   if not assigned(CustomApplication) then
   if not assigned(CustomApplication) then
     CustomApplication := Application;
     CustomApplication := Application;
 end;
 end;
@@ -57,9 +65,9 @@ Procedure DoneApache;
 
 
 begin
 begin
   Try
   Try
-    if CustomApplication=Application then
+    if CustomApplication=CustApache.Application then
       CustomApplication := nil;
       CustomApplication := nil;
-    FreeAndNil(Application);
+    FreeAndNil(CustApache.Application);
   except
   except
     if ShowCleanUpErrors then
     if ShowCleanUpErrors then
       Raise;
       Raise;

+ 12 - 4
packages/fcl-web/src/base/fpapache24.pp

@@ -44,23 +44,31 @@ Type
   end;
   end;
 
 
 
 
+Function Application : TCustomApacheApplication;
+
 Implementation
 Implementation
 
 
+Function Application : TCustomApacheApplication;
+
+begin
+  Result:=CustApache24.Application;
+end;
+
 Procedure InitApache;
 Procedure InitApache;
 
 
 begin
 begin
-  Application:=TApacheApplication.Create(Nil);
+  CustApache24.Application:=TApacheApplication.Create(Nil);
   if not assigned(CustomApplication) then
   if not assigned(CustomApplication) then
-    CustomApplication := Application;
+    CustomApplication := CustApache24.Application;
 end;
 end;
 
 
 Procedure DoneApache;
 Procedure DoneApache;
 
 
 begin
 begin
   Try
   Try
-    if CustomApplication=Application then
+    if CustomApplication=CustApache24.Application then
       CustomApplication := nil;
       CustomApplication := nil;
-    FreeAndNil(Application);
+    FreeAndNil(CustApache24.Application);
   except
   except
     if ShowCleanUpErrors then
     if ShowCleanUpErrors then
       Raise;
       Raise;

+ 4 - 5
packages/fcl-web/src/base/fphttpserver.pp

@@ -1078,10 +1078,10 @@ procedure TFPHTTPConnection.ReadRequestContent(
 
 
 Var
 Var
   P,L,R : integer;
   P,L,R : integer;
-  S : String;
+  S : TBytes;
 
 
 begin
 begin
-  S:='';
+  S:=[];
   L:=ARequest.ContentLength;
   L:=ARequest.ContentLength;
   If (L>0) then
   If (L>0) then
     begin
     begin
@@ -1091,11 +1091,10 @@ begin
       begin
       begin
       if P>L then
       if P>L then
         P:=L;
         P:=L;
-      Move(FBuffer[1],S[1],P);
+      Move(FBuffer[1],S[0],P);
       FBuffer:='';
       FBuffer:='';
       L:=L-P;
       L:=L-P;
       end;
       end;
-    P:=P+1;
     R:=1;
     R:=1;
     While (L>0) and (R>0) do
     While (L>0) and (R>0) do
       begin
       begin
@@ -1109,7 +1108,7 @@ begin
         end;
         end;
       end;  
       end;  
     end;
     end;
-  ARequest.InitContent(S);
+  ARequest.ContentBytes:=S;
 end;
 end;
 
 
 function TFPHTTPConnection.ReadRequestHeaders: TFPHTTPConnectionRequest;
 function TFPHTTPConnection.ReadRequestHeaders: TFPHTTPConnectionRequest;

+ 4 - 0
packages/fcl-web/src/base/fpweb.pp

@@ -415,7 +415,11 @@ procedure TCustomFPWebModule.GetTemplateContent(ARequest: TRequest;
   
   
 begin
 begin
   TFPWebTemplate(FTemplate).Request:=ARequest;
   TFPWebTemplate(FTemplate).Request:=ARequest;
+  {$IF SIZEOF(CHAR)=2}
+  AResponse.Content:=UTF8Encode(FTemplate.GetContent);
+  {$ELSE}
   AResponse.Content:=FTemplate.GetContent;
   AResponse.Content:=FTemplate.GetContent;
+  {$ENDIF}
 end;
 end;
 
 
 function TCustomFPWebModule.GetContent: String;
 function TCustomFPWebModule.GetContent: String;

+ 20 - 7
packages/fcl-web/src/base/httpdefs.pp

@@ -310,13 +310,13 @@ type
 
 
   TStreamingMimeItems = class(TMimeItems)
   TStreamingMimeItems = class(TMimeItems)
   private
   private
-    FBuffer: string;
+    FBuffer: Ansistring;
     FBufferCount: SizeInt;
     FBufferCount: SizeInt;
     FCurrentItem: TMimeItem;
     FCurrentItem: TMimeItem;
     FMimeEndFound: Boolean;
     FMimeEndFound: Boolean;
     FAtStart: Boolean;
     FAtStart: Boolean;
   protected
   protected
-    procedure SetBoundary(const AValue: string); override;
+    procedure SetBoundary(const AValue: String); override;
     procedure ProcessStreamingMultiPart(const State: TContentStreamingState; const Buf; const Size: Integer); override;
     procedure ProcessStreamingMultiPart(const State: TContentStreamingState; const Buf; const Size: Integer); override;
     class function SupportsStreamingProcessing: Boolean; override;
     class function SupportsStreamingProcessing: Boolean; override;
   end;
   end;
@@ -841,13 +841,19 @@ end;
 { TStreamingMimeItems }
 { TStreamingMimeItems }
 
 
 procedure TStreamingMimeItems.ProcessStreamingMultiPart(const State: TContentStreamingState; const Buf; const Size: Integer);
 procedure TStreamingMimeItems.ProcessStreamingMultiPart(const State: TContentStreamingState; const Buf; const Size: Integer);
+
+Const
+   DashDash : AnsiString = '--';
+   CRLFDashDash : AnsiString = #13#10'--';
+
 var
 var
   bl: SizeInt;
   bl: SizeInt;
   p: SizeInt;
   p: SizeInt;
   BufEnd: SizeInt;
   BufEnd: SizeInt;
   LeadingLineEndMissing: Boolean;
   LeadingLineEndMissing: Boolean;
   Bound,EndBound : RawByteString;
   Bound,EndBound : RawByteString;
-  
+  Sep : AnsiString;
+
 begin
 begin
   // The length of the boundary, including the leading CR/LF, '--' and trailing '--' or
   // The length of the boundary, including the leading CR/LF, '--' and trailing '--' or
   // CR/LF.
   // CR/LF.
@@ -878,14 +884,14 @@ begin
 
 
   FBufferCount := 1;
   FBufferCount := 1;
   repeat
   repeat
-  if FAtStart and CompareMem(@FBuffer[1], PChar('--'+FBoundary), Length(FBoundary)+2) then
+  if FAtStart and CompareMem(@FBuffer[1], PAnsiChar(EndBound), Length(Bound)+2) then
     begin
     begin
     // Sometimes a mime-message (mistakenly) does not start with CR/LF.
     // Sometimes a mime-message (mistakenly) does not start with CR/LF.
     p := 1;
     p := 1;
     LeadingLineEndMissing := True;
     LeadingLineEndMissing := True;
     end
     end
   else
   else
-    p := Pos(#13#10'--'+FBoundary, FBuffer, FBufferCount);
+    p := Pos(CRLFDashDash+Bound, FBuffer, FBufferCount);
   if (P > 0) and (P < Size) then
   if (P > 0) and (P < Size) then
     begin
     begin
     if Assigned(FCurrentItem) then
     if Assigned(FCurrentItem) then
@@ -896,8 +902,14 @@ begin
     else
     else
       begin
       begin
       if FAtStart and (P > 1) then
       if FAtStart and (P > 1) then
+        begin
         // Add the preamble to the content
         // Add the preamble to the content
+        {$IF SIZEOF(CHAR)=2}
+        FPreamble := UTF8Decode(Copy(FBuffer, FBufferCount, P-1));
+        {$ELSE}
         FPreamble := Copy(FBuffer, FBufferCount, P-1);
         FPreamble := Copy(FBuffer, FBufferCount, P-1);
+        {$ENDIF}
+        end;
       end;
       end;
     FAtStart := False;
     FAtStart := False;
     Inc(P, bl);
     Inc(P, bl);
@@ -907,7 +919,8 @@ begin
       LeadingLineEndMissing := False;
       LeadingLineEndMissing := False;
       end;
       end;
     FBufferCount := P;
     FBufferCount := P;
-    if (Copy(FBuffer,p-2,2)='--') then
+    Sep:=Copy(FBuffer,p-2,2);
+    if (Sep=DashDash) then
       FMimeEndFound := True;
       FMimeEndFound := True;
     end;
     end;
   if not Assigned(FCurrentItem) and not FMimeEndFound then
   if not Assigned(FCurrentItem) and not FMimeEndFound then
@@ -2227,7 +2240,7 @@ begin
   P:=PathInfo;
   P:=PathInfo;
 {$ifdef CGIDEBUG}SendDebug(Format('Pathinfo: "%s" "%s"',[P,FReturnedPathInfo]));{$ENDIF}
 {$ifdef CGIDEBUG}SendDebug(Format('Pathinfo: "%s" "%s"',[P,FReturnedPathInfo]));{$ENDIF}
   if (P <> '') and (P[length(P)] = '/') then
   if (P <> '') and (P[length(P)] = '/') then
-    Delete(P, length(P), 1);//last char is '/'
+    Delete(P, length(P), 1); // last char is '/'
   If (P<>'') and (P[1]='/') then
   If (P<>'') and (P[1]='/') then
     Delete(P,1,1);
     Delete(P,1,1);
   Delete(P,1,Length(IncludeHTTPPathDelimiter(FReturnedPathInfo)));
   Delete(P,1,Length(IncludeHTTPPathDelimiter(FReturnedPathInfo)));

+ 10 - 2
packages/fcl-web/src/jwt/fpjwaes256.pp

@@ -60,7 +60,7 @@ end;
 Class function TJWTSignerES256.Verify(const aJWT: String; aPrivateKey: TECCPrivateKey): Boolean;
 Class function TJWTSignerES256.Verify(const aJWT: String; aPrivateKey: TECCPrivateKey): Boolean;
 
 
 Var
 Var
-  J,C,S : AnsiString;
+  J,C,S : String;
   aSignature : TEccSignature;
   aSignature : TEccSignature;
   B : TBytes;
   B : TBytes;
 
 
@@ -68,7 +68,11 @@ begin
   Result:=GetParts(aJWT,J,C,S);
   Result:=GetParts(aJWT,J,C,S);
   if Not Result then
   if Not Result then
     exit;
     exit;
+{$IF SIZEOF(CHAR)=2}    
+  B:=TEncoding.UTF8.GetBytes(J+'.'+C);
+{$ELSE}  
   B:=TEncoding.UTF8.GetAnsiBytes(J+'.'+C);
   B:=TEncoding.UTF8.GetAnsiBytes(J+'.'+C);
+{$ENDIF}  
   BytesToVar(Base64url.Decode(S),aSignature,Sizeof(aSignature));
   BytesToVar(Base64url.Decode(S),aSignature,Sizeof(aSignature));
   Result:=TECDSA.verifySHA256(B,aPrivateKey,aSignature);
   Result:=TECDSA.verifySHA256(B,aPrivateKey,aSignature);
 end;
 end;
@@ -76,7 +80,7 @@ end;
 class function TJWTSignerES256.Verify(const aJWT: String; aPublicKey: TECCPublicKey): Boolean;
 class function TJWTSignerES256.Verify(const aJWT: String; aPublicKey: TECCPublicKey): Boolean;
 
 
 Var
 Var
-  J,C,S : AnsiString;
+  J,C,S : String;
   aSignature : TEccSignature;
   aSignature : TEccSignature;
   B : TBytes;
   B : TBytes;
 
 
@@ -84,7 +88,11 @@ begin
   Result:=GetParts(aJWT,J,C,S);
   Result:=GetParts(aJWT,J,C,S);
   if Not Result then
   if Not Result then
     exit;
     exit;
+{$IF SIZEOF(CHAR)=2}    
+  B:=TEncoding.UTF8.GetBytes(J+'.'+C);
+{$ELSE}     
   B:=TEncoding.UTF8.GetAnsiBytes(J+'.'+C);
   B:=TEncoding.UTF8.GetAnsiBytes(J+'.'+C);
+{$ENDIF}  
   Base64url.Decode(S,@aSignature);
   Base64url.Decode(S,@aSignature);
   Result:=TECDSA.verifySHA256(B,aPublicKey,aSignature);
   Result:=TECDSA.verifySHA256(B,aPublicKey,aSignature);
 end;
 end;

+ 2 - 2
packages/fcl-web/src/jwt/fpjwt.pp

@@ -609,7 +609,7 @@ Var
   PL : PPropList;
   PL : PPropList;
   I,VI,Count : Integer;
   I,VI,Count : Integer;
   VF : Double;
   VF : Double;
-  C : Char;
+  C : AnsiChar;
   CW : WideChar;
   CW : WideChar;
   I64 : Int64;
   I64 : Int64;
   W : UnicodeString;
   W : UnicodeString;
@@ -631,7 +631,7 @@ begin
             end;
             end;
           tkChar :
           tkChar :
             begin
             begin
-            C:=Char(GetOrdProp(Self,P));
+            C:=AnsiChar(GetOrdProp(Self,P));
             if All or (C<>#0) then
             if All or (C<>#0) then
               if C=#0 then
               if C=#0 then
                 JSON.Add(p^.Name,'')
                 JSON.Add(p^.Name,'')

+ 1 - 1
packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -2352,7 +2352,7 @@ begin
   // Check & discard basepath parts of the URL
   // Check & discard basepath parts of the URL
   Path:=aRequest.GetNextPathInfo;
   Path:=aRequest.GetNextPathInfo;
   Full:=BasePath;
   Full:=BasePath;
-  BasePaths:=Full.Split('/',TStringSplitOptions.ExcludeEmpty);
+  BasePaths:=Full.Split(RTLString('/'),TStringSplitOptions.ExcludeEmpty);
   I:=0;
   I:=0;
   While (I<Length(BasePaths)) and SameText(Path,BasePaths[i]) do
   While (I<Length(BasePaths)) and SameText(Path,BasePaths[i]) do
     begin
     begin

+ 1 - 1
packages/fcl-web/src/restbridge/sqldbrestschema.pp

@@ -1533,7 +1533,7 @@ begin
     O:=aMinFieldOpts;
     O:=aMinFieldOpts;
     if FD.Required then
     if FD.Required then
        Include(O,foRequired);
        Include(O,foRequired);
-    If AnsiIndexStr(FN,aIndexFields)<>-1 then
+    If IndexStr(FN,aIndexFields)<>-1 then
       begin
       begin
       Include(O,foInKey);
       Include(O,foInKey);
       Exclude(O,foFilter);
       Exclude(O,foFilter);

+ 2 - 1
packages/libmicrohttpd/src/libmicrohttpd.pp

@@ -209,7 +209,8 @@ const
   MHD_USE_DEBUG = 1;
   MHD_USE_DEBUG = 1;
   MHD_USE_SSL = 2;
   MHD_USE_SSL = 2;
   MHD_USE_THREAD_PER_CONNECTION = 4;
   MHD_USE_THREAD_PER_CONNECTION = 4;
-  MHD_USE_SELECT_INTERNALLY = 8;
+  MHD_USE_INTERNAL_POLLING_THREAD = 8;
+  MHD_USE_SELECT_INTERNALLY = 8 deprecated 'use MHD_USE_INTERNAL_POLLING_THREAD';
   MHD_USE_IPv6 = 16;
   MHD_USE_IPv6 = 16;
   MHD_USE_PEDANTIC_CHECKS = 32;
   MHD_USE_PEDANTIC_CHECKS = 32;
   MHD_USE_POLL = 64;
   MHD_USE_POLL = 64;