--- Merging r17442 into '.':

U    packages/fcl-web/src/webdata/extjsjson.pp
U    packages/fcl-web/src/webdata/fpwebdata.pp
U    packages/fcl-web/src/base/fpweb.pp
U    packages/fcl-web/src/base/fphttp.pp
U    packages/fcl-web/src/base/Makefile.fpc
U    packages/fcl-web/src/base/fpapache.pp
U    packages/fcl-web/src/base/websession.pp
U    packages/fcl-web/src/base/httpdefs.pp
C    packages/fcl-web/src/base/Makefile
U    packages/fcl-web/src/jsonrpc/fpextdirect.pp
U    packages/fcl-web/src/jsonrpc/webjsonrpc.pp
--- Merging r17443 into '.':
A    packages/fcl-web/src/base/iniwebsession.pp
--- Merging r17465 into '.':
G    packages/fcl-web/src/base/fpweb.pp
G    packages/fcl-web/src/base/httpdefs.pp
A    packages/fcl-web/src/base/fphttpserver.pp
A    packages/fcl-web/examples/httpserver
A    packages/fcl-web/examples/httpserver/simplehttpserver.pas
A    packages/fcl-web/examples/httpserver/simplehttpserver.lpi
--- Merging r17466 into '.':
U    packages/fcl-web/fpmake.pp
G    packages/fcl-web/src/base/Makefile.fpc
C    packages/fcl-web/src/base/Makefile
--- Merging r17472 into '.':
G    packages/fcl-web/fpmake.pp
A    packages/fcl-web/src/base/fphttpclient.pp
G    packages/fcl-web/src/base/Makefile.fpc
G    packages/fcl-web/src/base/Makefile
A    packages/fcl-web/examples/httpclient
A    packages/fcl-web/examples/httpclient/httpget.pas
A    packages/fcl-web/examples/httpclient/httpget.lpi
--- Merging r17502 into '.':
G    packages/fcl-web/src/jsonrpc/fpextdirect.pp
--- Merging r17503 into '.':
G    packages/fcl-web/src/base/websession.pp
--- Merging r17504 into '.':
U    packages/fcl-web/src/base/custweb.pp
--- Merging r17505 into '.':
U    packages/fcl-web/src/base/custfcgi.pp
--- Merging r17510 into '.':
G    packages/fcl-web/src/base/custweb.pp
--- Merging r17511 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r17519 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r17520 into '.':
U    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r17521 into '.':
U    packages/fcl-web/examples/httpclient/httpget.lpi
A    packages/fcl-web/examples/httpclient/httppost.pp
A    packages/fcl-web/examples/httpclient/httppostfile.pp
A    packages/fcl-web/examples/httpclient/httppost.lpi
A    packages/fcl-web/examples/httpclient/httppostfile.lpi
--- Merging r17525 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r17526 into '.':
U    packages/fcl-web/src/base/fphttpserver.pp
--- Merging r17527 into '.':
U    packages/fcl-web/src/base/webutil.pp
--- Merging r17532 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r17544 into '.':
G    packages/fcl-web/src/base/fpapache.pp
--- Merging r17555 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r17568 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r17569 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r17571 into '.':
G    packages/fcl-web/src/webdata/fpwebdata.pp
--- Merging r17595 into '.':
G    packages/fcl-web/src/base/fphttp.pp
--- Merging r17596 into '.':
G    packages/fcl-web/src/base/custweb.pp
--- Merging r17597 into '.':
G    packages/fcl-web/src/base/custweb.pp
--- Merging r17602 into '.':
G    packages/fcl-web/src/base/custweb.pp
--- Merging r17609 into '.':
U    packages/fcl-json/src/jsonparser.pp
--- Merging r17610 into '.':
U    packages/fcl-json/src/jsonscanner.pp
G    packages/fcl-json/src/jsonparser.pp
--- Merging r17612 into '.':
G    packages/fcl-web/src/base/custweb.pp
--- Merging r17615 into '.':
U    packages/fcl-web/src/base/webpage.pp
U    packages/fcl-web/src/base/fphtml.pp
Summary of conflicts:
  Text conflicts: 2

# revisions: 17442,17443,17465,17466,17472,17502,17503,17504,17505,17510,17511,17519,17520,17521,17525,17526,17527,17532,17544,17555,17568,17569,17571,17595,17596,17597,17602,17609,17610,17612,17615
------------------------------------------------------------------------
r17442 | michael | 2011-05-13 14:08:59 +0200 (Fri, 13 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/Makefile
   M /trunk/packages/fcl-web/src/base/Makefile.fpc
   M /trunk/packages/fcl-web/src/base/fpapache.pp
   M /trunk/packages/fcl-web/src/base/fphttp.pp
   M /trunk/packages/fcl-web/src/base/fpweb.pp
   M /trunk/packages/fcl-web/src/base/httpdefs.pp
   M /trunk/packages/fcl-web/src/base/websession.pp
   M /trunk/packages/fcl-web/src/jsonrpc/fpextdirect.pp
   M /trunk/packages/fcl-web/src/jsonrpc/webjsonrpc.pp
   M /trunk/packages/fcl-web/src/webdata/extjsjson.pp
   M /trunk/packages/fcl-web/src/webdata/fpwebdata.pp

* Reworked session management.
------------------------------------------------------------------------
------------------------------------------------------------------------
r17443 | michael | 2011-05-13 17:08:07 +0200 (Fri, 13 May 2011) | 1 line
Changed paths:
   A /trunk/packages/fcl-web/src/base/iniwebsession.pp

* Fixed
------------------------------------------------------------------------
------------------------------------------------------------------------
r17465 | michael | 2011-05-15 14:39:26 +0200 (Sun, 15 May 2011) | 1 line
Changed paths:
   A /trunk/packages/fcl-web/examples/httpserver
   A /trunk/packages/fcl-web/examples/httpserver/simplehttpserver.lpi
   A /trunk/packages/fcl-web/examples/httpserver/simplehttpserver.pas
   A /trunk/packages/fcl-web/src/base/fphttpserver.pp
   M /trunk/packages/fcl-web/src/base/fpweb.pp
   M /trunk/packages/fcl-web/src/base/httpdefs.pp

* Initial implementation of HTTP Server component
------------------------------------------------------------------------
------------------------------------------------------------------------
r17466 | michael | 2011-05-15 14:42:20 +0200 (Sun, 15 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/fpmake.pp
   M /trunk/packages/fcl-web/src/base/Makefile
   M /trunk/packages/fcl-web/src/base/Makefile.fpc

* Add fphttpserver to makefile/fpmake
------------------------------------------------------------------------
------------------------------------------------------------------------
r17472 | michael | 2011-05-15 18:01:17 +0200 (Sun, 15 May 2011) | 1 line
Changed paths:
   A /trunk/packages/fcl-web/examples/httpclient
   A /trunk/packages/fcl-web/examples/httpclient/httpget.lpi
   A /trunk/packages/fcl-web/examples/httpclient/httpget.pas
   M /trunk/packages/fcl-web/fpmake.pp
   M /trunk/packages/fcl-web/src/base/Makefile
   M /trunk/packages/fcl-web/src/base/Makefile.fpc
   A /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Added HTTP Client implementation
------------------------------------------------------------------------
------------------------------------------------------------------------
r17502 | michael | 2011-05-19 16:19:47 +0200 (Thu, 19 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpextdirect.pp

* Do not send content  twice
------------------------------------------------------------------------
------------------------------------------------------------------------
r17503 | michael | 2011-05-19 16:20:06 +0200 (Thu, 19 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/websession.pp

* Ensure backwards compatibility
------------------------------------------------------------------------
------------------------------------------------------------------------
r17504 | michael | 2011-05-19 16:22:05 +0200 (Thu, 19 May 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Allow logging in TWebHandler
* Better construction of TLogEVent
------------------------------------------------------------------------
------------------------------------------------------------------------
r17505 | michael | 2011-05-19 16:22:40 +0200 (Thu, 19 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Logging in request
------------------------------------------------------------------------
------------------------------------------------------------------------
r17510 | michael | 2011-05-20 15:37:53 +0200 (Fri, 20 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Expose log event handler in webhandler
------------------------------------------------------------------------
------------------------------------------------------------------------
r17511 | michael | 2011-05-20 15:38:48 +0200 (Fri, 20 May 2011) | 2 lines
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Added LingerTimeOut. If >0 then socket option linger is set.
  (needed for fastcgi under Windows 2003 server)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17519 | michael | 2011-05-21 10:52:35 +0200 (Sat, 21 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Fixed compilation
------------------------------------------------------------------------
------------------------------------------------------------------------
r17520 | michael | 2011-05-21 12:01:47 +0200 (Sat, 21 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Added sending of files and form posts
------------------------------------------------------------------------
------------------------------------------------------------------------
r17521 | michael | 2011-05-21 12:03:53 +0200 (Sat, 21 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/examples/httpclient/httpget.lpi
   A /trunk/packages/fcl-web/examples/httpclient/httppost.lpi
   A /trunk/packages/fcl-web/examples/httpclient/httppost.pp
   A /trunk/packages/fcl-web/examples/httpclient/httppostfile.lpi
   A /trunk/packages/fcl-web/examples/httpclient/httppostfile.pp

* Post form/file examples
------------------------------------------------------------------------
------------------------------------------------------------------------
r17525 | michael | 2011-05-22 17:59:57 +0200 (Sun, 22 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Added cookie support (needed for WST)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17526 | michael | 2011-05-22 18:00:32 +0200 (Sun, 22 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpserver.pp

* Fixed bugs in reading of content from browser. (WST server now works)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17527 | michael | 2011-05-22 18:01:01 +0200 (Sun, 22 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/webutil.pp

* Added Content fields dump
------------------------------------------------------------------------
------------------------------------------------------------------------
r17532 | michael | 2011-05-23 18:47:11 +0200 (Mon, 23 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Fix bug in ReadContent
------------------------------------------------------------------------
------------------------------------------------------------------------
r17544 | michael | 2011-05-23 22:06:48 +0200 (Mon, 23 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fpapache.pp

* Some extra security when getting request variables from Apache (19397)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17555 | michael | 2011-05-25 18:14:05 +0200 (Wed, 25 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Commented out etDebug log request
------------------------------------------------------------------------
------------------------------------------------------------------------
r17568 | michael | 2011-05-27 13:01:08 +0200 (Fri, 27 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

+ Implemented named pipe communication for windows.
------------------------------------------------------------------------
------------------------------------------------------------------------
r17569 | michael | 2011-05-27 13:07:50 +0200 (Fri, 27 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Fixed linux compilation
------------------------------------------------------------------------
------------------------------------------------------------------------
r17571 | michael | 2011-05-27 13:39:44 +0200 (Fri, 27 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/webdata/fpwebdata.pp

* Added  transcode event
------------------------------------------------------------------------
------------------------------------------------------------------------
r17595 | michael | 2011-05-28 11:11:04 +0200 (Sat, 28 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttp.pp

* Check for session in DoneSession, avoids creation of a factory if none is needed.
------------------------------------------------------------------------
------------------------------------------------------------------------
r17596 | michael | 2011-05-28 11:17:30 +0200 (Sat, 28 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Do not send headers before setting content, as content-length will be set by setting the content.
------------------------------------------------------------------------
------------------------------------------------------------------------
r17597 | michael | 2011-05-28 11:18:49 +0200 (Sat, 28 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Send code 500 in case of exception.
------------------------------------------------------------------------
------------------------------------------------------------------------
r17602 | michael | 2011-05-29 11:51:49 +0200 (Sun, 29 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Applied Patch from Attila Borka (bug 19374)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17609 | michael | 2011-05-30 09:15:28 +0200 (Mon, 30 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/jsonparser.pp

* Renamed EJSONScanner to EJSONParser
------------------------------------------------------------------------
------------------------------------------------------------------------
r17610 | michael | 2011-05-30 09:18:40 +0200 (Mon, 30 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/jsonparser.pp
   M /trunk/packages/fcl-json/src/jsonscanner.pp

* Made exceptions descendents of EParserError
------------------------------------------------------------------------
------------------------------------------------------------------------
r17612 | joost | 2011-05-30 19:45:11 +0200 (Mon, 30 May 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custweb.pp

 * Initialize nil-pointer
------------------------------------------------------------------------
------------------------------------------------------------------------
r17615 | joost | 2011-05-31 10:12:47 +0200 (Tue, 31 May 2011) | 6 lines
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphtml.pp
   M /trunk/packages/fcl-web/src/base/webpage.pp

 * Added TWebController.onGetURL property
 * Made TWebPage.Module public
 * Fixed handling ajax-calls of components within containers
 * THtmlContentProducer.GetIdentification added
 * Ability to reset the iteration-level

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@17706 -

.gitattributes

@@ -1704,6 +1704,14 @@ packages/fcl-web/examples/combined/wmlogin.pp svneol=native#text/plain
 packages/fcl-web/examples/combined/wmusers.lfm svneol=native#text/plain
 packages/fcl-web/examples/combined/wmusers.lrs svneol=native#text/plain
 packages/fcl-web/examples/combined/wmusers.pp svneol=native#text/plain
+packages/fcl-web/examples/httpclient/httpget.lpi svneol=native#text/plain
+packages/fcl-web/examples/httpclient/httpget.pas svneol=native#text/plain
+packages/fcl-web/examples/httpclient/httppost.lpi svneol=native#text/plain
+packages/fcl-web/examples/httpclient/httppost.pp svneol=native#text/plain
+packages/fcl-web/examples/httpclient/httppostfile.lpi svneol=native#text/plain
+packages/fcl-web/examples/httpclient/httppostfile.pp svneol=native#text/plain
+packages/fcl-web/examples/httpserver/simplehttpserver.lpi svneol=native#text/plain
+packages/fcl-web/examples/httpserver/simplehttpserver.pas svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/demo.lpi svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/demo1/demo.lpr svneol=native#text/plain
@@ -1808,8 +1816,11 @@ packages/fcl-web/src/base/fpdatasetform.pp svneol=native#text/plain
 packages/fcl-web/src/base/fpfcgi.pp svneol=native#text/plain
 packages/fcl-web/src/base/fphtml.pp svneol=native#text/plain
 packages/fcl-web/src/base/fphttp.pp svneol=native#text/plain
+packages/fcl-web/src/base/fphttpclient.pp svneol=native#text/plain
+packages/fcl-web/src/base/fphttpserver.pp svneol=native#text/plain
 packages/fcl-web/src/base/fpweb.pp svneol=native#text/plain
 packages/fcl-web/src/base/httpdefs.pp svneol=native#text/plain
+packages/fcl-web/src/base/iniwebsession.pp svneol=native#text/plain
 packages/fcl-web/src/base/webpage.pp svneol=native#text/plain
 packages/fcl-web/src/base/websession.pp svneol=native#text/plain
 packages/fcl-web/src/base/webutil.pp svneol=native#text/plain

packages/fcl-json/src/jsonparser.pp

@@ -48,7 +48,7 @@ Type
     Property Strict : Boolean Read FStrict Write SetStrict;
   end;
   
-  EJSONScanner = Class(Exception);
+  EJSONParser = Class(EParserError);
   
 implementation
 
@@ -246,7 +246,7 @@ Var
 begin
   S:=Format(Msg,[CurrentTokenString]);
   S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
-  Raise EJSONScanner.Create(S);
+  Raise EJSONParser.Create(S);
 end;
 
 constructor TJSONParser.Create(Source: TStream);

packages/fcl-json/src/jsonscanner.pp

@@ -46,7 +46,7 @@ type
     tkUnknown
     );
 
-  EScannerError       = class(Exception);
+  EScannerError       = class(EParserError);
 
 
   { TJSONScanner }

packages/fcl-web/examples/httpclient/httpget.lpi

@@ -0,0 +1,70 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="HTTP Client application demo"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="httpget.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="httpget"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="10"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/httpclient/httpget.pas

@@ -0,0 +1,27 @@
+program httpget;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, fphttpclient;
+
+var
+  i : Integer;
+
+begin
+  if (ParamCount<>2) then
+    begin
+    writeln('Usage : ',ExtractFileName(ParamStr(0)), 'URL filename');
+    Halt(1);
+    end;
+  With TFPHTTPClient.Create(Nil) do
+    try
+      Get(ParamStr(1),ParamStr(2));
+      Writeln('Response headers:');
+      For I:=0 to ResponseHeaders.Count-1 do
+        Writeln(ResponseHeaders[i]);
+    finally
+      Free;
+    end;
+end.
+

packages/fcl-web/examples/httpclient/httppost.lpi

@@ -0,0 +1,76 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Form post example"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="httppost.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="httppost"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="10"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/httpclient/httppost.pp

@@ -0,0 +1,30 @@
+program httppost;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, fphttpclient;
+
+Var
+  F : TFileStream;
+  Vars : TStrings;
+  i : integer;
+begin
+  With TFPHTTPClient.Create(Nil) do
+    begin
+    F:=TFileStream.Create('response.html',fmCreate);
+    try
+      Vars:=TstringList.Create;
+      try
+        For i:=1 to 10 do
+          Vars.Add(Format('Var%d=Value %d',[i,i]));
+        FormPost(ParamStr(1),vars,f);
+      finally
+        Vars.Free;
+      end;
+    finally
+      F.Free;
+    end;
+    end;
+end.
+

packages/fcl-web/examples/httpclient/httppostfile.lpi

@@ -0,0 +1,77 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Form post file example"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="httppostfile.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="httppostfile"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="10"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/httpclient/httppostfile.pp

@@ -0,0 +1,28 @@
+program httppostfile;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, Classes, fphttpclient;
+
+Var
+  F : TFileStream;
+  Vars : TStrings;
+  i : integer;
+begin
+  With TFPHTTPClient.Create(Nil) do
+    begin
+    F:=TFileStream.Create('response.html',fmCreate);
+    try
+      Vars:=TstringList.Create;
+      try
+        FileFormPost(ParamStr(1),'myfile',paramstr(2),f);
+      finally
+        Vars.Free;
+      end;
+    finally
+      F.Free;
+    end;
+    end;
+end.
+

packages/fcl-web/examples/httpserver/simplehttpserver.lpi

@@ -0,0 +1,71 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Simple HTTP server demo"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="simplehttpserver.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="simplehttpserver"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="10"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/httpserver/simplehttpserver.pas

@@ -0,0 +1,106 @@
+program simplehttpserver;
+
+{$mode objfpc}{$H+}
+{$define UseCThreads}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  sysutils, Classes, fphttpserver, fpmimetypes;
+
+Type
+
+  { TTestHTTPServer }
+
+  TTestHTTPServer = Class(TFPHTTPServer)
+  private
+    FBaseDir : String;
+    FCount : Integer;
+    FMimeLoaded : Boolean;
+    FMimeTypesFile: String;
+    procedure SetBaseDir(const AValue: String);
+  Protected
+    procedure CheckMimeLoaded;
+    Property MimeLoaded : Boolean Read FMimeLoaded;
+  public
+    procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest;
+                            Var AResponse : TFPHTTPConnectionResponse); override;
+    Property BaseDir : String Read FBaseDir Write SetBaseDir;
+    Property MimeTypesFile : String Read FMimeTypesFile Write FMimeTypesFile;
+  end;
+
+Var
+  Serv : TTestHTTPServer;
+{ TTestHTTPServer }
+
+procedure TTestHTTPServer.SetBaseDir(const AValue: String);
+begin
+  if FBaseDir=AValue then exit;
+  FBaseDir:=AValue;
+  If (FBaseDir<>'') then
+    FBaseDir:=IncludeTrailingPathDelimiter(FBaseDir);
+end;
+
+procedure TTestHTTPServer.CheckMimeLoaded;
+begin
+  If (Not MimeLoaded) and (MimeTypesFile<>'') then
+    begin
+    MimeTypes.LoadFromFile(MimeTypesFile);
+    FMimeLoaded:=true;
+    end;
+end;
+
+procedure TTestHTTPServer.HandleRequest(var ARequest: TFPHTTPConnectionRequest;
+  var AResponse: TFPHTTPConnectionResponse);
+
+Var
+  F : TFileStream;
+  FN : String;
+
+begin
+  FN:=ARequest.Url;
+  If (length(FN)>0) and (FN[1]='/') then
+    Delete(FN,1,1);
+  DoDirSeparators(FN);
+  FN:=BaseDir+FN;
+  if FileExists(FN) then
+    begin
+    F:=TFileStream.Create(FN,fmOpenRead);
+    try
+      CheckMimeLoaded;
+      AResponse.ContentType:=MimeTypes.GetMimeType(ExtractFileExt(FN));
+      Writeln('Serving file: "',Fn,'". Reported Mime type: ',AResponse.ContentType);
+      AResponse.ContentLength:=F.Size;
+      AResponse.ContentStream:=F;
+      AResponse.SendContent;
+      AResponse.ContentStream:=Nil;
+    finally
+      F.Free;
+    end;
+    end
+  else
+    begin
+    AResponse.Code:=404;
+    AResponse.SendContent;
+    end;
+  Inc(FCount);
+  If FCount>=5 then
+    Active:=False;
+end;
+
+begin
+  Serv:=TTestHTTPServer.Create(Nil);
+  try
+    Serv.BaseDir:=ExtractFilePath(ParamStr(0));
+{$ifdef unix}
+    Serv.MimeTypesFile:='/etc/mime.types';
+{$endif}
+    Serv.Threaded:=False;
+    Serv.Port:=8080;
+    Serv.Active:=True;
+  finally
+    Serv.Free;
+  end;
+end.
+

packages/fcl-web/fpmake.pp

@@ -126,6 +126,13 @@ begin
       AddUnit('httpdefs');
       AddUnit('custcgi');
       end;
+    T:=P.Targets.AddUnit('fphttpserver.pp');
+    T.ResourceStrings:=true;
+      with T.Dependencies do
+        begin
+          AddUnit('httpdefs');
+        end;
+    T:=P.Targets.AddUnit('fphttpclient.pp');
     T:=P.Targets.AddUnit('fpwebdata.pp');
     With T.Dependencies do
       begin

packages/fcl-web/src/base/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/02/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/06/09]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -268,364 +268,364 @@ override PACKAGE_NAME=fcl-web
 override PACKAGE_VERSION=2.4.5
 PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-web/Makefile.fpc,$(PACKAGESDIR))))))
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate  custfcgi fpfcgi
+override TARGET_UNITS+=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver fphttpclient  custfcgi fpfcgi
 endif
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp
+override TARGET_RSTS+=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)

packages/fcl-web/src/base/Makefile.fpc

@@ -7,13 +7,14 @@ main=fcl-web
 version=2.4.5
 
 [target]
-units=httpdefs fphttp custweb custcgi fpcgi fphtml websession fpweb \
-      webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate
-rsts=fpcgi fphtml fpweb websession cgiapp
+units=httpdefs fphttp custweb custcgi fpcgi fphtml iniwebsession websession fpweb \
+      webutil fpdatasetform cgiapp ezcgi fpapache webpage fcgigate fphttpserver \
+      fphttpclient
+rsts=fpcgi fphtml fpweb websession cgiapp fphttpserver fphttpclient
 
 # these units are listed separately because they don't work for
 # darwin (which does support the rest of fcl-web)
-units_beos=custfcgi fpfcgi
+units_beos=custfcgi fpfcgi 
 units_haiku=custfcgi fpfcgi
 units_freebsd=custfcgi fpfcgi
 units_solaris=custfcgi fpfcgi

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

@@ -25,7 +25,7 @@ uses
 {$ifdef unix}
   BaseUnix, TermIO,
 {$else}
-  winsock2,
+  winsock2, windows,
 {$endif}
   Sockets, custweb, custcgi, fastcgi;
 
@@ -40,6 +40,8 @@ Type
   TProtocolOptions = Set of TProtocolOption;
 
   TUnknownRecordEvent = Procedure (ARequest : TFCGIRequest; AFCGIRecord: PFCGI_Header) Of Object;
+  TFastCGIReadEvent = Function (AHandle : THandle; Var ABuf; ACount : Integer) : Integer of Object;
+  TFastCGIWriteEvent = Function (AHandle : THandle; Const ABuf; ACount : Integer) : Integer of Object;
 
   TFCGIRequest = Class(TCGIRequest)
   Private
@@ -49,8 +51,10 @@ Type
     FRequestID : Word;
     FCGIParams : TSTrings;
     FUR: TUnknownRecordEvent;
+    FLog : TLogEvent;
     procedure GetNameValuePairsFromContentRecord(const ARecord : PFCGI_ContentRecord; NameValueList : TStrings);
   Protected
+    Procedure Log(EventType : TEventType; Const Msg : String);
     Function GetFieldValue(Index : Integer) : String; override;
     procedure ReadContent; override;
   Public
@@ -68,8 +72,9 @@ Type
   TFCGIResponse = Class(TCGIResponse)
   private
     FPO: TProtoColOptions;
-    procedure Write_FCGIRecord(ARecord : PFCGI_Header);
+    FOnWrite : TFastCGIWriteEvent;
   Protected
+    procedure Write_FCGIRecord(ARecord : PFCGI_Header); virtual;
     Procedure DoSendHeaders(Headers : TStrings); override;
     Procedure DoSendContent; override;
     Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
@@ -84,6 +89,7 @@ Type
 
   TFCgiHandler = class(TWebHandler)
   Private
+    FLingerTimeOut: integer;
     FOnUnknownRecord: TUnknownRecordEvent;
     FPO: TProtoColOptions;
     FRequestsArray : Array of TReqResp;
@@ -95,9 +101,16 @@ Type
     FAddress: string;
     FTimeOut,
     FPort: integer;
+{$ifdef windows}
+    FIsWinPipe: Boolean;
+{$endif}
+    function AcceptConnection: Integer;
+    procedure CloseConnection;
     function Read_FCGIRecord : PFCGI_Header;
     function DataAvailable : Boolean;
   protected
+    Function DoFastCGIRead(AHandle : THandle; Var ABuf; ACount : Integer) : Integer; virtual;
+    Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer) : Integer; virtual;
     function  ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest;  out AResponse: TResponse): boolean; virtual;
     procedure SetupSocket(var IAddress: TInetSockAddr;  var AddressLength: tsocklen); virtual;
     function  WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
@@ -106,6 +119,7 @@ Type
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     property Port: integer read FPort write FPort;
+    property LingerTimeOut : integer read FLingerTimeOut write FLingerTimeOut;
     property Address: string read FAddress write FAddress;
     Property ProtocolOptions : TProtoColOptions Read FPO Write FPO;
     Property OnUnknownRecord : TUnknownRecordEvent Read FOnUnknownRecord Write FOnUnknownRecord;
@@ -118,9 +132,11 @@ Type
   private
     function GetAddress: string;
     function GetFPO: TProtoColOptions;
+    function GetLingerTimeOut: integer;
     function GetOnUnknownRecord: TUnknownRecordEvent;
     function GetPort: integer;
     procedure SetAddress(const AValue: string);
+    procedure SetLingerTimeOut(const AValue: integer);
     procedure SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
     procedure SetPort(const AValue: integer);
     procedure SetPO(const AValue: TProtoColOptions);
@@ -128,6 +144,7 @@ Type
     function InitializeWebHandler: TWebHandler; override;
   Public
     property Port: integer read GetPort write SetPort;
+    property LingerTimeOut : integer read GetLingerTimeOut write SetLingerTimeOut;
     property Address: string read GetAddress write SetAddress;
     Property ProtocolOptions : TProtoColOptions Read GetFPO Write SetPO;
     Property OnUnknownRecord : TUnknownRecordEvent Read GetOnUnknownRecord Write SetOnUnknownRecord;
@@ -178,7 +195,12 @@ var cl,rcl : Integer;
 begin
   Result := False;
   case AFCGIRecord^.reqtype of
-    FCGI_BEGIN_REQUEST : FKeepConnectionAfterRequest := (PFCGI_BeginRequestRecord(AFCGIRecord)^.body.flags and FCGI_KEEP_CONN) = FCGI_KEEP_CONN;
+    FCGI_BEGIN_REQUEST :
+         begin
+         FKeepConnectionAfterRequest := (PFCGI_BeginRequestRecord(AFCGIRecord)^.body.flags and FCGI_KEEP_CONN) = FCGI_KEEP_CONN;
+//         With PFCGI_BeginRequestRecord(AFCGIRecord)^.body do
+//           log(etDebug,Format('Begin request body role & flags: %d %d',[Beton(Role),Flags]));
+         end;
     FCGI_PARAMS :       begin
                         if AFCGIRecord^.contentLength=0 then
                           Result := False
@@ -259,6 +281,12 @@ begin
     end;
 end;
 
+procedure TFCGIRequest.Log(EventType: TEventType; const Msg: String);
+begin
+  If Assigned(FLog) then
+    FLog(EventType,Msg);
+end;
+
 
 Function TFCGIRequest.GetFieldValue(Index : Integer) : String;
 
@@ -330,7 +358,7 @@ begin
   BytesToWrite := BEtoN(ARecord^.contentLength) + ARecord^.paddingLength+sizeof(FCGI_Header);
   P:=PByte(Arecord);
   Repeat
-    BytesWritten := sockets.fpsend(TFCGIRequest(Request).Handle, P, BytesToWrite, NoSignalAttr);
+    BytesWritten:=FOnWrite(TFCGIRequest(Request).Handle, P^, BytesToWrite);
     If (BytesWritten<0) then
       begin
       // TODO : Better checking for closed connection, EINTR
@@ -460,18 +488,45 @@ begin
   inherited Destroy;
 end;
 
+procedure TFCgiHandler.CloseConnection;
+Var
+  i : Integer;
+begin
+{$ifdef windows}
+  if FIsWinPipe then
+    begin
+    if not FlushFileBuffers(FHandle) then
+      begin
+      I:=GetLastError;
+//      Log(etError,Format('Failed to flush file buffers: %d ',[i]));
+      end;
+    if not DisconnectNamedPipe(FHandle) then
+      begin
+      I:=GetLastError;
+//      Log(etError,Format('Failed to disconnect named pipe: %d ',[i]));
+      end
+    end
+  else
+{$endif}
+    begin
+    i:=fpshutdown(FHandle,SHUT_RDWR);
+//      Log(etError,Format('Shutting down socket: %d ',[i]));
+    i:=CloseSocket(FHandle);
+//      Log(etError,Format('Closing socket %d',[i]));
+    end;
+  FHandle := THandle(-1);
+end;
+
 procedure TFCgiHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
+
+
 begin
   with FRequestsArray[TFCGIRequest(ARequest).RequestID] do
     begin
     Assert(ARequest=Request);
     Assert(AResponse=Response);
     if (not TFCGIRequest(ARequest).KeepConnectionAfterRequest) then
-      begin
-      fpshutdown(FHandle,SHUT_RDWR);
-      CloseSocket(FHandle);
-      FHandle := THandle(-1);
-      end;
+      CloseConnection;
     Request := Nil;
     Response := Nil;
     end;
@@ -515,7 +570,7 @@ function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
     P:=ReadBuf;
     if (ByteAmount=0) then exit;
     Repeat
-      Count:=sockets.fpRecv(FHandle, P, ByteAmount, NoSignalAttr);
+      Count:=DoFastCGIRead(FHandle,P^,ByteAmount);
       If (Count>0) then
         begin
         Dec(ByteAmount,Count);
@@ -576,6 +631,10 @@ end;
 
 procedure TFCgiHandler.SetupSocket(var IAddress : TInetSockAddr; Var AddressLength : tsocklen);
 
+Var
+  L : Linger;
+  ll,lr : integer;
+
 begin
   AddressLength:=Sizeof(IAddress);
   Socket := fpsocket(AF_INET,SOCK_STREAM,0);
@@ -599,7 +658,22 @@ begin
     Terminate;
     raise Exception.CreateFmt(SBindFailed,[port,socketerror]);
     end;
-  if fplisten(Socket,1)=-1 then
+  if (FLingerTimeout>0) then
+    begin
+    ll:=SizeOf(l);
+    if fpgetsockopt(Socket,SOL_SOCKET,SO_LINGER,@l,@ll)=0 then
+      begin
+//      Log(etDebug,Format('Socket linger : %d, %d',[L.l_linger,L.l_onoff]));
+      if (L.l_onoff=0) then
+        begin
+        l.l_onoff:=1;
+        l.l_linger:=1;
+        lr:=fpsetsockopt(Socket,SOL_SOCKET,SO_LINGER,@l,ll);
+//        Log(etDebug,Format('Set socket linger (%d, %d) : %d',[L.l_linger,L.l_onoff,lr]));
+        end;
+      end;
+    end;
+  if fplisten(Socket,10)=-1 then
     begin
     CloseSocket(socket);
     Socket:=0;
@@ -638,6 +712,27 @@ begin
 end;
 {$endif}
 
+function TFCgiHandler.DoFastCGIRead(AHandle: THandle; var ABuf; ACount: Integer): Integer;
+begin
+{$ifdef windows}
+  if FIsWinPipe then
+    Result:=FileRead(FHandle,ABuf,ACount)
+  else
+{$endif}
+    Result:=sockets.fpRecv(FHandle, @Abuf, ACount, NoSignalAttr);
+end;
+
+function TFCgiHandler.DoFastCGIWrite(AHandle: THandle; const ABuf;
+  ACount: Integer): Integer;
+begin
+  {$ifdef windows}
+  if FIsWinPipe then
+    Result := FileWrite(AHandle, ABuf, ACount)
+  else
+  {$endif windows}
+    Result := sockets.fpsend(AHandle, @ABuf, ACount, NoSignalAttr);
+end;
+
 function TFCgiHandler.ProcessRecord(AFCGI_Record  : PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean;
 
 var
@@ -660,6 +755,7 @@ begin
     ATempRequest.Handle:=FHandle;
     ATempRequest.ProtocolOptions:=Self.Protocoloptions;
     ATempRequest.OnUnknownRecord:=Self.OnUnknownRecord;
+    ATempRequest.FLog:=@Log;
     FRequestsArray[ARequestID].Request := ATempRequest;
     end;
   if (ARequestID>FRequestsAvail) then
@@ -672,11 +768,45 @@ begin
     ARequest:=FRequestsArray[ARequestID].Request;
     FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
     FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
+    FRequestsArray[ARequestID].Response.FOnWrite:=@DoFastCGIWrite;
     AResponse:=FRequestsArray[ARequestID].Response;
     Result := True;
     end;
 end;
 
+function TFCgiHandler.AcceptConnection : Integer;
+
+{$ifdef windows}
+Var
+  B : BOOL;
+  pipeMode : DWORD = PIPE_READMODE_BYTE or PIPE_WAIT;
+  i : integer;
+{$endif}
+
+begin
+{$ifndef windows}
+  Result:=fpaccept(Socket,psockaddr(@FIAddress),@FAddressLength);
+{$else}
+  if Not fIsWinPipe then
+    Result:=fpaccept(Socket,psockaddr(@FIAddress),@FAddressLength);
+  If FIsWinPipe or ((Result<0) and (socketerror=10038)) then
+    begin
+    B:=ConnectNamedPipe(Socket,Nil);
+    if B or (GetLastError=ERROR_PIPE_CONNECTED) then
+       begin
+       Result:=Socket;
+       if Not FIsWinPipe then // First time, set handle state
+         if not SetNamedPipeHandleState(Result,@PipeMode,Nil,Nil) then
+           begin
+           I:=GetLastError;
+//           Log(etError,'Setting named pipe handle state failed : '+intToStr(i));
+           end;
+       FIsWinPipe:=True;
+       end;
+    end;
+{$endif}
+end;
+
 function TFCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 
 var
@@ -684,19 +814,19 @@ var
 
 begin
   Result := False;
+  AResponse:=Nil;
+  ARequest:=Nil;
   if Socket=0 then
     if Port<>0 then
       SetupSocket(FIAddress,FAddressLength)
     else
       Socket:=StdInputHandle;
+  if FHandle=THandle(-1) then
+    FHandle:=AcceptConnection;
   if FHandle=THandle(-1) then
     begin
-    FHandle:=fpaccept(Socket,psockaddr(@FIAddress),@FAddressLength);
-    if FHandle=THandle(-1) then
-      begin
-      Terminate;
-      raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
-      end;
+    Terminate;
+    raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
     end;
   repeat
     If (poUseSelect in ProtocolOptions) then
@@ -706,7 +836,6 @@ begin
           OnIdle(Self);
       end;
     AFCGI_Record:=Read_FCGIRecord;
-
     if assigned(AFCGI_Record) then
     try
       Result:=ProcessRecord(AFCGI_Record,ARequest,AResponse);
@@ -729,6 +858,11 @@ begin
   result := TFCgiHandler(WebHandler).ProtocolOptions;
 end;
 
+function TCustomFCgiApplication.GetLingerTimeOut: integer;
+begin
+  Result:=TFCgiHandler(WebHandler).LingerTimeOut;
+end;
+
 function TCustomFCgiApplication.GetOnUnknownRecord: TUnknownRecordEvent;
 begin
   result := TFCgiHandler(WebHandler).OnUnknownRecord;
@@ -744,6 +878,11 @@ begin
   TFCgiHandler(WebHandler).Address := AValue;
 end;
 
+procedure TCustomFCgiApplication.SetLingerTimeOut(const AValue: integer);
+begin
+  TFCgiHandler(WebHandler).LingerTimeOut:=AValue;
+end;
+
 procedure TCustomFCgiApplication.SetOnUnknownRecord(const AValue: TUnknownRecordEvent);
 begin
   TFCgiHandler(WebHandler).OnUnknownRecord := AValue;

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

@@ -77,6 +77,7 @@ Type
   TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
                                Var ModuleClass : TCustomHTTPModuleClass) of object;
   TOnShowRequestException = procedure(AResponse: TResponse; AnException: Exception; var handled: boolean);
+  TLogEvent = Procedure (EventType: TEventType; const Msg: String) of object;
 
   { TWebHandler }
 
@@ -97,6 +98,7 @@ Type
     FRedirectOnErrorURL : String;
     FTitle: string;
     FOnTerminate : TNotifyEvent;
+    FOnLog : TLogEvent;
   protected
     procedure Terminate;
     Function GetModuleName(Arequest : TRequest) : string;
@@ -112,6 +114,7 @@ Type
   Public
     constructor Create(AOwner: TComponent); override;
     Procedure Run; virtual;
+    Procedure Log(EventType : TEventType; Const Msg : String);
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse);
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
@@ -127,6 +130,7 @@ Type
     Property Administrator : String Read GetAdministrator Write FAdministrator;
     property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
     property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
+    Property OnLog : TLogEvent Read FOnLog Write FOnLog;
   end;
 
   TCustomWebApplication = Class(TCustomApplication)
@@ -241,6 +245,12 @@ begin
     end;
 end;
 
+procedure TWebHandler.Log(EventType: TEventType; const Msg: String);
+begin
+  If Assigned(FOnLog) then
+    FOnLog(EventType,Msg);
+end;
+
 procedure TWebHandler.ShowRequestException(R: TResponse; E: Exception);
 Var
  S : TStrings;
@@ -260,10 +270,11 @@ begin
     R.SendContent;
     Exit;
     end;
-  If not R.HeadersSent then
+  If (not R.HeadersSent) then
     begin
+    R.Code:=500;
+    R.CodeText:='Application error '+E.ClassName;
     R.ContentType:='text/html';
-    R.SendHeaders;
     end;
   If (R.ContentType='text/html') then
     begin
@@ -299,6 +310,7 @@ begin
   try
     MC:=Nil;
     M:=NIL;
+    MI:=Nil;
     If (OnGetModule<>Nil) then
       OnGetModule(Self,ARequest,MC);
     If (MC=Nil) then
@@ -311,7 +323,7 @@ begin
       end;
     M:=FindModule(MC); // Check if a module exists already
     If (M=Nil) then
-      if Mi.SkipStreaming then
+      if assigned(MI) and Mi.SkipStreaming then
         M:=MC.CreateNew(Self)
       else
         M:=MC.Create(Self);
@@ -365,8 +377,11 @@ begin
   If (Result='') then
     begin
     S:=ARequest.PathInfo;
-    If (Length(S)>0) and (S[1]='/') then
-      Delete(S,1,1);
+    If (Length(S)>0) and (S[1]='/') then  
+      Delete(S,1,1);                      //Delete the leading '/' if exists
+    I:=Length(S);
+    If (I>0) and (S[I]='/') then
+      Delete(S,I,1);                      //Delete the trailing '/' if exists
     I:=Pos('/',S);
     if (I>0) then
       Result:=ARequest.GetNextPathInfo;
@@ -460,7 +475,14 @@ end;
 function TCustomWebApplication.GetEventLog: TEventLog;
 begin
   if not assigned(FEventLog) then
-    FEventLog := TEventLog.Create(self);
+    begin
+    FEventLog := TEventLog.Create(Nil);
+    FEventLog.Name:=Self.Name+'Logger';
+    FEventLog.Identification:=Title;
+    FEventLog.RegisterMessageFile(ParamStr(0));
+    FEventLog.LogType:=ltSystem;
+    FEventLog.Active:=True;
+    end;
   Result := FEventLog;
 end;
 
@@ -560,6 +582,7 @@ begin
   Inherited Create(AOwner);
   FWebHandler := InitializeWebHandler;
   FWebHandler.FOnTerminate:=@DoOnTerminate;
+  FWebHandler.FOnLog:=@Log;
 end;
 
 procedure TCustomWebApplication.DoOnTerminate(Sender : TObject);

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

@@ -446,6 +446,13 @@ end;
 
 function TApacheRequest.GetFieldValue(Index: Integer): String;
 
+  Function MaybeP(P : Pchar) : String;
+  
+  begin
+    If (P<>Nil) then
+      Result:=StrPas(P);
+  end;
+
 var
   P : Pchar;
   FN : String;
@@ -462,30 +469,32 @@ begin
     end;
   if (Result='') then
     case Index of
-      0  : Result:=strpas(FRequest^.protocol); // ProtocolVersion
-      7  : Result:=Strpas(FRequest^.content_encoding); //ContentEncoding
-      25 : Result:=StrPas(FRequest^.path_info); // PathInfo
-      26 : Result:=StrPas(FRequest^.filename); // PathTranslated
+      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:=StrPas(FRequest^.Connection^.remote_ip);
+             Result:=MaybeP(FRequest^.Connection^.remote_ip);
       28 : // RemoteHost
            If (FRequest^.Connection<>Nil) then
-             Result:=StrPas(ap_get_remote_host(FRequest^.Connection,
-                                FRequest^.Per_Dir_Config,
-                                REMOTE_HOST,Nil));
+             begin
+             Result:=MaybeP(ap_get_remote_host(FRequest^.Connection,
+                                   FRequest^.Per_Dir_Config,
+                                   REMOTE_HOST,Nil));
+             end;                   
       29 : begin // ScriptName
-           Result:=StrPas(FRequest^.unparsed_uri);
+           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:=StrPas(FRequest^.method); // Method
-      32 : Result:=StrPas(FRequest^.unparsed_uri); // URL
-      33 : Result:=StrPas(FRequest^.args); // Query
-      34 : Result:=StrPas(FRequest^.HostName); // Host
+      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);
     end;
@@ -618,7 +627,8 @@ end;
 
 function __dummythread(p: pointer): ptrint;
 begin
-//empty
+  sleep(1000);
+  Result:=0;
 end;
 
 { TCustomApacheApplication }
@@ -745,8 +755,6 @@ end;
 
 Initialization
   BeginThread(@__dummythread);//crash prevention for simultaneous requests
-  sleep(300);
-
   InitApache;
   
 Finalization

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

@@ -39,6 +39,7 @@ type
   TWebButtons = array of TWebButton;
 
   TMessageBoxHandler = function(Sender: TObject; AText: String; Buttons: TWebButtons; Loaded: string = ''): string of object;
+  TOnGetUrlProc = procedure(ParamNames, ParamValues, KeepParams: array of string; Action: string; var URL: string) of object;
   TWebController = class;
   THTMLContentProducer = class;
 
@@ -125,6 +126,7 @@ type
     FAddRelURLPrefix: boolean;
     FBaseURL: string;
     FMessageBoxHandler: TMessageBoxHandler;
+    FOnGetURL: TOnGetUrlProc;
     FScriptName: string;
     FScriptStack: TFPObjectList;
     FIterationIDs: array of string;
@@ -139,6 +141,7 @@ type
     function GetStyleSheetReferences: TContainerStylesheets; virtual; abstract;
     function GetScripts: TFPObjectList; virtual; abstract;
     function GetRequest: TRequest;
+    property OnGetURL: TOnGetUrlProc read FOnGetURL write FOnGetURL;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -164,6 +167,7 @@ type
     procedure ShowRegisteredScript(ScriptID: integer); virtual; abstract;
 
     function IncrementIterationLevel: integer; virtual;
+    function ResetIterationLevel: integer; virtual;
     procedure SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string); virtual;
     function GetIterationIDSuffix: string; virtual;
     procedure DecrementIterationLevel; virtual;
@@ -247,6 +251,7 @@ type
     procedure SetParent(const AValue: TComponent);
   Protected
     function CreateWriter (Doc : THTMLDocument) : THTMLWriter; virtual;
+    function GetIdentification: string; virtual;
     function GetIDSuffix: string; virtual;
     procedure SetIDSuffix(const AValue: string); virtual;
   protected
@@ -284,6 +289,7 @@ type
     function MoveContentProducer(MoveElement, MoveBeforeElement: THTMLContentProducer) : boolean;
     procedure HandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse); virtual;
     procedure ForeachContentProducer(AForeachChildsProc: TForeachContentProducerProc; Recursive: boolean);
+    property Identification: string read GetIdentification;
     property Childs[Index: integer]: THTMLContentProducer read GetContentProducers;
     property AcceptChildsAtDesignTime: boolean read FAcceptChildsAtDesignTime;
     property parent: TComponent read FParent write SetParent;
@@ -676,6 +682,11 @@ begin
   Result := FChilds;
 end;
 
+function THTMLContentProducer.GetIdentification: string;
+begin
+  result := '';
+end;
+
 function THTMLContentProducer.ProduceContent: String;
 var WCreated, created : boolean;
     el : THtmlCustomElement;
@@ -1440,6 +1451,11 @@ begin
   SetLength(FIterationIDs,Result);
 end;
 
+function TWebController.ResetIterationLevel: integer;
+begin
+  SetLength(FIterationIDs,0);
+end;
+
 procedure TWebController.SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string);
 begin
   FIterationIDs[AIterationLevel-1]:=IDSuffix;

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

@@ -112,9 +112,64 @@ Type
     property Kind: TWebModuleKind read FWebModuleKind write FWebModuleKind default wkPooled;
     Property BaseURL : String Read FBaseURL Write FBaseURL;
   end;
-  
   TCustomHTTPModuleClass = Class of TCustomHTTPModule;
 
+  { TSessionHTTPModule }
+
+  TSessionHTTPModule = Class(TCustomHTTPModule)
+  Private
+    FCreateSession : Boolean;
+    FOnNewSession: TNotifyEvent;
+    FOnSessionExpired: TNotifyEvent;
+    FSession: TCustomSession;
+    FSessionRequest : TRequest;
+    function GetSession: TCustomSession;
+    procedure SetSession(const AValue: TCustomSession);
+  Protected
+    Procedure CheckSession(ARequest : TRequest);
+    Procedure InitSession(AResponse : TResponse);
+    Procedure UpdateSession(AResponse : TResponse);
+    Procedure DoneSession; virtual;
+  Public
+    destructor destroy; override;
+    Procedure Notification(AComponent : TComponent;Operation : TOperation); override;
+    Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
+    Property CreateSession : Boolean Read FCreateSession Write FCreateSession;
+    Property Session : TCustomSession Read GetSession Write SetSession;
+    Property OnNewSession : TNotifyEvent Read FOnNewSession Write FOnNewSession;
+    Property OnSessionExpired : TNotifyEvent Read FOnSessionExpired Write FOnSessionExpired;
+  end;
+  TSessionHTTPModuleClass = Class of TSessionHTTPModule;
+
+  EWebSessionError = Class(HTTPError);
+
+  { TSessionFactory }
+
+  TSessionFactory = Class(TComponent)
+  private
+    FTimeOut: Integer;
+    FCleanupInterval: Integer;
+    FDoneCount: Integer;
+  protected
+    // Override in descendants
+    Function DoCreateSession(ARequest : TRequest) : TCustomSession; virtual; abstract;
+    Procedure DoDoneSession(Var ASession : TCustomSession); virtual; abstract;
+    Procedure DoCleanupSessions; virtual; abstract;
+    Property DoneCount : Integer Read FDoneCount;
+  Public
+    Function CreateSession(ARequest : TRequest) : TCustomSession;
+    Procedure DoneSession(Var ASession : TCustomSession);
+    Procedure CleanupSessions;
+    // Number of requests before sweeping sessions for stale sessions.
+    // Default 1000. Set to 0 to disable.
+    // Note that for cgi programs, this will never happen, since the count is reset to 0
+    // with each invocation. It takes a special factory to handle that, or a value of 1.
+    Property CleanupInterval : Integer read FCleanupInterval Write FCleanUpInterval;
+    // Default timeout for sessions, in minutes.
+    Property DefaultTimeOutMinutes : Integer Read FTimeOut Write FTimeOut;
+  end;
+  TSessionFactoryClass = Class of TSessionFactory;
+
   { TModuleItem }
 
   TModuleItem = Class(TCollectionItem)
@@ -148,7 +203,10 @@ Procedure RegisterHTTPModule(Const ModuleName : String; ModuleClass : TCustomHTT
 
 Var
   ModuleFactory : TModuleFactory;
-  
+  SessionFactoryClass : TSessionFactoryClass = nil;
+
+Function SessionFactory : TSessionFactory;
+
 Resourcestring
   SErrNosuchModule = 'No such module registered: "%s"';
   SErrNoSuchAction = 'No action found for action: "%s"';
@@ -156,13 +214,54 @@ Resourcestring
   SErrNoDefaultAction = 'No action name and no default action';
   SErrInvActNoDefaultAction = 'Invalid action name and no default action';
   SErrRequestNotHandled = 'Web request was not handled by actions.';
-
+  SErrNoSessionFactoryClass = 'No session manager class available. Include iniwebsession unit and recompile.';
+  SErrNoSessionOutsideRequest = 'Default session not available outside handlerequest';
 Implementation
 
 {$ifdef cgidebug}
 uses dbugintf;
 {$endif}
 
+Var
+  GSM : TSessionFactory;
+
+Function SessionFactory : TSessionFactory;
+
+begin
+  if GSM=Nil then
+    begin
+    if (SessionFactoryClass=Nil) then
+      Raise EFPHTTPError.Create(SErrNoSessionFactoryClass);
+    GSM:=SessionFactoryClass.Create(Nil)
+    end;
+  Result:=GSM;
+end;
+
+{ TSessionFactory }
+
+function TSessionFactory.CreateSession(ARequest: TRequest): TCustomSession;
+begin
+  Result:=DoCreateSession(ARequest);
+  if (FTimeOut<>0) and Assigned(Result) then
+    Result.TimeoutMinutes:=FTimeOut;
+end;
+
+procedure TSessionFactory.DoneSession(var ASession: TCustomSession);
+begin
+  DoDoneSession(ASession);
+  if (FCleanupInterval>0) then
+    begin
+    Inc(FDoneCount);
+    If (FDoneCount>=FCleanupInterval) then
+      CleanupSessions;
+    end;
+end;
+
+procedure TSessionFactory.CleanupSessions;
+begin
+  FDoneCount:=0;
+  DoCleanupSessions;
+end;
 
 { TModuleFactory }
 
@@ -464,9 +563,108 @@ begin
     Dec(Result);
 end;
 
+function TSessionHTTPModule.GetSession: TCustomSession;
+begin
+{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule.GetSession');{$endif}
+  If (csDesigning in ComponentState) then
+    begin
+{$ifdef cgidebug}SendDebug('Sending session');{$endif}
+    Result:=FSession
+    end
+  else
+    begin
+    If (FSession=Nil) then
+      begin
+{$ifdef cgidebug}SendDebug('Getting default session');{$endif}
+      if (FSessionRequest=Nil) then
+        Raise EFPHTTPError.Create(SErrNoSessionOutsideRequest);
+      FSession:=SessionFactory.CreateSession(FSessionRequest);
+      FSession.FreeNotification(Self);
+      end;
+    Result:=FSession
+    end;
+{$ifdef cgidebug}SendMethodExit('SessionHTTPModule.GetSession');{$endif}
+end;
+
+procedure TSessionHTTPModule.SetSession(const AValue: TCustomSession);
+
+begin
+  if FSession<>AValue then
+    begin
+    If Assigned(FSession) then
+      FSession.RemoveFreeNotification(Self);
+    FSession:=AValue;
+    If Assigned(FSession) then
+      FSession.FreeNotification(Self);
+    end;
+end;
+
+procedure TSessionHTTPModule.CheckSession(ARequest : TRequest);
+
+begin
+{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').CheckSession');{$endif}
+  If CreateSession then
+    begin
+    If (FSession=Nil) then
+      FSession:=SessionFactory.CreateSession(ARequest);
+    if Assigned(FSession) then
+      FSession.InitSession(ARequest,FOnNewSession,FOnSessionExpired);
+    end;
+{$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').CheckSession');{$endif}
+end;
+
+procedure TSessionHTTPModule.InitSession(AResponse: TResponse);
+begin
+{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').InitSession');{$endif}
+  If CreateSession and Assigned(FSession) then
+    FSession.InitResponse(AResponse);
+{$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').InitSession');{$endif}
+end;
+
+procedure TSessionHTTPModule.UpdateSession(AResponse: TResponse);
+begin
+  If CreateSession And Assigned(FSession) then
+    FSession.UpdateResponse(AResponse);
+end;
+
+procedure TSessionHTTPModule.DoneSession;
+begin
+  // Session manager may or may not destroy the session.
+  // Check if we actually have
+  if Assigned(FSession) then
+    SessionFactory.DoneSession(FSession);
+  // In each case, our reference is no longer valid.
+  FSession:=Nil;
+end;
+
+destructor TSessionHTTPModule.destroy;
+begin
+  // Prevent memory leaks.
+  DoneSession;
+  inherited destroy;
+end;
+
+procedure TSessionHTTPModule.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').Notification');{$endif}
+  inherited Notification(AComponent, Operation);
+  If (Operation=opRemove) then
+    if (AComponent=FSession) Then
+      FSession:=Nil;
+{$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').Notification');{$endif}
+end;
+
+procedure TSessionHTTPModule.HandleRequest(ARequest: TRequest;
+  AResponse: TResponse);
+begin
+  FSessionRequest:=ARequest;
+end;
+
 Initialization
   ModuleFactory:=TModuleFactory.Create(TModuleItem);
 
 Finalization
   FreeAndNil(ModuleFactory);
+  FreeAndNil(GSM);
 end.

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

@@ -0,0 +1,828 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2011 by the Free Pascal development team
+
+    HTTP client component.
+
+    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.
+
+ **********************************************************************}
+unit fphttpclient;
+
+{ ---------------------------------------------------------------------
+  Todo:
+  * Proxy support ?
+  * Easy calls for POST/DELETE/etc.
+  ---------------------------------------------------------------------}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, ssockets, httpdefs, uriparser, base64;
+
+Const
+  ReadBufLen = 4096;
+
+Type
+  { TFPCustomHTTPClient }
+  TFPCustomHTTPClient = Class(TComponent)
+  private
+    FCookies: TStrings;
+    FHTTPVersion: String;
+    FRequestBody: TStream;
+    FRequestHeaders: TStrings;
+    FResponseHeaders: TStrings;
+    FResponseStatusCode: Integer;
+    FResponseStatusText: String;
+    FServerHTTPVersion: String;
+    FSocket : TInetSocket;
+    FBuffer : Ansistring;
+    function CheckContentLength: Integer;
+    function GetCookies: TStrings;
+    procedure SetCookies(const AValue: TStrings);
+    procedure SetRequestHeaders(const AValue: TStrings);
+  protected
+    // Parse response status line. Saves status text and protocol, returns numerical code. Exception if invalid line.
+    Function ParseStatusLine(AStatusLine : String) : Integer;
+    // Construct server URL for use in request line.
+    function GetServerURL(URI: TURI): String;
+    // Read 1 line of response. Fills FBuffer
+    function ReadString: String;
+    // Check if response code is in AllowedResponseCodes. if not, an exception is raised.
+    function CheckResponseCode(ACode: Integer;  const AllowedResponseCodes: array of Integer): Boolean; virtual;
+    // Read response from server, and write any document to Stream.
+    procedure ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer); virtual;
+    // Read server response line and headers. Returns status code.
+    Function ReadResponseHeaders : integer; virtual;
+    // Allow header in request ? (currently checks only if non-empty and contains : token)
+    function AllowHeader(var AHeader: String): Boolean; virtual;
+    // Connect to the server. Must initialize FSocket.
+    procedure ConnectToServer(const AHost: String; APort: Integer); virtual;
+    // Disconnect from server. Must free FSocket.
+    procedure DisconnectFromServer; virtual;
+    // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
+    // If non-empty, AllowedResponseCodes contains an array of response codes considered valid responses.
+    Procedure DoMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
+    // Send request to server: construct request line and send headers and request body.
+    procedure SendRequest(const AMethod: String; URI: TURI); virtual;
+  Public
+    Constructor Create(AOwner: TComponent); override;
+    Destructor Destroy; override;
+    // Request Header management
+    // Return index of header, -1 if not present.
+    Function IndexOfHeader(Const AHeader : String) : Integer;
+    // Add header, replacing an existing one if it exists.
+    Procedure AddHeader(Const AHeader,AValue : String);
+    // Return header value, empty if not present.
+    Function GetHeader(Const AHeader : String) : String;
+    // General-purpose call.
+    Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
+    // Execute GET on server, store result in Stream, File, StringList or string
+    Procedure Get(Const AURL : String; Stream : TStream);
+    Procedure Get(Const AURL : String; const LocalFileName : String);
+    Procedure Get(Const AURL : String; Response : TStrings);
+    Function Get(Const AURL : String) : String;
+    // Simple post
+    // Post URL, and Requestbody. Return response in Stream, File, TstringList or String;
+    procedure Post(const URL: string; const Response: TStream);
+    procedure Post(const URL: string; Response : TStrings);
+    procedure Post(const URL: string; const LocalFileName: String);
+    function Post(const URL: string) : String;
+    // Post Form data (www-urlencoded).
+    // Formdata in string (urlencoded) or TStrings (plain text) format.
+    // Form data will be inserted in the requestbody.
+    // Return response in Stream, File, TStringList or String;
+    Procedure FormPost(const URL, FormData: string; const Response: TStream);
+    Procedure FormPost(const URL : string; FormData:  TStrings; const Response: TStream);
+    Procedure FormPost(const URL, FormData: string; const Response: TStrings);
+    Procedure FormPost(const URL : string; FormData:  TStrings; const Response: TStrings);
+    function FormPost(const URL, FormData: string): String;
+    function FormPost(const URL: string; FormData : TStrings): String;
+    // Post a file
+    Procedure FileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
+  Protected
+    // Before request properties.
+    // Additional headers for request. Host; and Authentication are automatically added.
+    Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders;
+    // Cookies. Set before request to send cookies to server.
+    // After request the property is filled with the cookies sent by the server.
+    Property Cookies : TStrings Read GetCookies Write SetCookies;
+    // Optional body to send (mainly in POST request)
+    Property RequestBody : TStream read FRequestBody Write FRequestBody;
+    // used HTTP version when constructing the request.
+    Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
+    // After request properties.
+    // After request, this contains the headers sent by server.
+    Property ResponseHeaders : TStrings Read FResponseHeaders;
+    // After request, HTTP version of server reply.
+    Property ServerHTTPVersion : String Read FServerHTTPVersion;
+    // After request, HTTP response status of the server.
+    Property ResponseStatusCode : Integer Read FResponseStatusCode;
+    // After request, HTTP response status text of the server.
+    Property ResponseStatusText : String Read FResponseStatusText;
+  end;
+
+  TFPHTTPClient = Class(TFPCustomHTTPClient)
+  Public
+    Property RequestHeaders;
+    Property RequestBody;
+    Property ResponseHeaders;
+    Property HTTPversion;
+    Property ServerHTTPVersion;
+    Property ResponseStatusCode;
+    Property ResponseStatusText;
+    Property Cookies;
+  end;
+  EHTTPClient = Class(Exception);
+
+Function EncodeURLElement(S : String) : String;
+Function DecodeURLElement(Const S : String) : String;
+
+implementation
+
+resourcestring
+  SErrInvalidProtocol = 'Invalid protocol : "%s"';
+  SErrReadingSocket = 'Error reading data from socket';
+  SErrInvalidProtocolVersion = 'Invalid protocol version in response: "%s"';
+  SErrInvalidStatusCode = 'Invalid response status code: %s';
+  SErrUnexpectedResponse = 'Unexpected response status code: %d';
+
+Const
+  CRLF = #13#10;
+
+function EncodeURLElement(S: String): String;
+
+Const
+  NotAllowed = [ ';', '/', '?', ':', '@', '=', '&', '#', '+', '_', '<', '>',
+                 '"', '%', '{', '}', '|', '\', '^', '~', '[', ']', '`' ];
+
+var
+  i, o, l : Integer;
+  h: string[2];
+  P : PChar;
+  c: AnsiChar;
+begin
+  l:=Length(S);
+  If (l=0) then Exit;
+  SetLength(Result,l*3);
+  P:=Pchar(Result);
+  for I:=1 to L do
+    begin
+    C:=S[i];
+    O:=Ord(c);
+    if (O<=$20) or (O>=$7F) or (c in NotAllowed) then
+      begin
+      P^ := '%';
+      Inc(P);
+      h := IntToHex(Ord(c), 2);
+      p^ := h[1];
+      Inc(P);
+      p^ := h[2];
+      Inc(P);
+      end
+    else
+      begin
+      P^ := c;
+      Inc(p);
+      end;
+    end;
+  SetLength(Result,P-PChar(Result));
+end;
+
+function DecodeURLElement(Const S: AnsiString): AnsiString;
+
+var
+  i,l,o : Integer;
+  c: AnsiChar;
+  p : pchar;
+  h : string;
+
+begin
+  l := Length(S);
+  if l=0 then exit;
+  SetLength(Result, l);
+  P:=PChar(Result);
+  i:=1;
+  While (I<=L) do
+    begin
+    c := S[i];
+    if (c<>'%') then
+      begin
+      P^:=c;
+      Inc(P);
+      end
+    else if (I<L-1) then
+      begin
+      H:='$'+Copy(S,I+1,2);
+      o:=StrToIntDef(H,-1);
+      If (O>=0) and (O<=255) then
+        begin
+        P^:=char(O);
+        Inc(P);
+        Inc(I,2);
+        end;
+      end;
+    Inc(i);
+  end;
+  SetLength(Result, P-Pchar(Result));
+end;
+
+{ TFPCustomHTTPClient }
+
+procedure TFPCustomHTTPClient.SetRequestHeaders(const AValue: TStrings);
+begin
+  if FRequestHeaders=AValue then exit;
+  FRequestHeaders.Assign(AValue);
+end;
+
+function TFPCustomHTTPClient.IndexOfHeader(const AHeader: String): Integer;
+Var
+  L : Integer;
+  H : String;
+begin
+  H:=LowerCase(Aheader);
+  l:=Length(AHeader);
+  Result:=Requestheaders.Count-1;
+  While (Result>=0) and ((LowerCase(Copy(RequestHeaders[Result],1,l)))<>h) do
+    Dec(Result);
+end;
+
+procedure TFPCustomHTTPClient.AddHeader(const AHeader, AValue: String);
+
+Var
+  I,J,L : Integer;
+  H : String;
+
+begin
+  j:=IndexOfHeader(Aheader);
+  if (J<>-1) then
+    RequestHeaders.Delete(j);
+  RequestHeaders.Add(AHeader+': '+Avalue);
+end;
+
+function TFPCustomHTTPClient.GetHeader(const AHeader: String): String;
+
+Var
+  I : Integer;
+
+begin
+  I:=indexOfHeader(AHeader);
+  Result:=RequestHeaders[i];
+  I:=Pos(':',Result);
+  if (I=0) then
+    I:=Length(Result);
+  Delete(Result,1,I);
+end;
+
+Function TFPCustomHTTPClient.GetServerURL(URI : TURI) : String;
+
+Var
+  D : String;
+
+begin
+  D:=URI.Path;
+  If (D[1]<>'/') then
+    D:='/'+D;
+  If (D[Length(D)]<>'/') then
+    D:=D+'/';
+  Result:=D+URI.Document;
+  if (URI.Params<>'') then
+    Result:=Result+'?'+URI.Params;
+end;
+
+procedure TFPCustomHTTPClient.ConnectToServer(Const AHost : String; APort : Integer);
+
+begin
+  if Aport=0 then
+    Aport:=80;
+  FSocket:=TInetSocket.Create(AHost,APort);
+end;
+
+procedure TFPCustomHTTPClient.DisconnectFromServer;
+
+begin
+  FreeAndNil(FSocket);
+end;
+
+function TFPCustomHTTPClient.AllowHeader(Var AHeader : String) : Boolean;
+
+begin
+  Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
+end;
+
+procedure TFPCustomHTTPClient.SendRequest(Const AMethod : String; URI : TURI);
+
+Var
+  S,L : String;
+  I : Integer;
+
+begin
+  S:=Uppercase(AMethod)+' '+GetServerURL(URI)+' '+'HTTP/'+FHTTPVersion+CRLF;
+  If (URI.Username<>'') then
+    S:=S+'Authorization: Basic ' + EncodeStringBase64(URI.UserName+ ':' + URI.Password)+CRLF;
+  S:=S+'Host: '+URI.Host;
+  If (URI.Port<>0) then
+    S:=S+':'+IntToStr(URI.Port);
+  S:=S+CRLF;
+  If Assigned(RequestBody) and (IndexOfHeader('Content-length')=-1) then
+    AddHeader('Content-length',IntToStr(RequestBody.Size));
+  For I:=0 to FRequestHeaders.Count-1 do
+    begin
+    l:=FRequestHeaders[i];
+    If AllowHeader(L) then
+      S:=S+L+CRLF;
+    end;
+  if Assigned(FCookies) then
+    begin
+    L:='Cookie:';
+    For I:=0 to FCookies.Count-1 do
+      begin
+      If (I>0) then
+        L:=L+'; ';
+      L:=L+FCookies[i];
+      end;
+    if AllowHeader(L) then
+      S:=S+L+CRLF;
+    end;
+  S:=S+CRLF;
+  FSocket.WriteBuffer(S[1],Length(S));
+  If Assigned(FRequestBody) then
+    FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
+end;
+
+function TFPCustomHTTPClient.ReadString : String;
+
+  Procedure FillBuffer;
+
+  Var
+    R : Integer;
+
+  begin
+    SetLength(FBuffer,ReadBufLen);
+    r:=FSocket.Read(FBuffer[1],ReadBufLen);
+    If r<0 then
+      Raise EHTTPClient.Create(SErrReadingSocket);
+    if (r<ReadBuflen) then
+      SetLength(FBuffer,r);
+  end;
+
+Var
+  CheckLF,Done : Boolean;
+  P,L : integer;
+
+begin
+  Result:='';
+  Done:=False;
+  CheckLF:=False;
+  Repeat
+    if Length(FBuffer)=0 then
+      FillBuffer;
+    if Length(FBuffer)=0 then
+      Done:=True
+    else if CheckLF then
+      begin
+      If (FBuffer[1]<>#10) then
+        Result:=Result+#13
+      else
+        begin
+        Delete(FBuffer,1,1);
+        Done:=True;
+        end;
+      end;
+    if not Done then
+      begin
+      P:=Pos(#13#10,FBuffer);
+      If P=0 then
+        begin
+        L:=Length(FBuffer);
+        CheckLF:=FBuffer[L]=#13;
+        if CheckLF then
+          Result:=Result+Copy(FBuffer,1,L-1)
+        else
+          Result:=Result+FBuffer;
+        FBuffer:='';
+        end
+      else
+        begin
+        Result:=Result+Copy(FBuffer,1,P-1);
+        Delete(FBuffer,1,P+1);
+        Done:=True;
+        end;
+      end;
+  until Done;
+end;
+Function GetNextWord(Var S : String) : string;
+
+Const
+  WhiteSpace = [' ',#9];
+
+Var
+  P : Integer;
+
+begin
+  While (Length(S)>0) and (S[1] in WhiteSpace) do
+    Delete(S,1,1);
+  P:=Pos(' ',S);
+  If (P=0) then
+   P:=Pos(#9,S);
+  If (P=0) then
+    P:=Length(S)+1;
+  Result:=Copy(S,1,P-1);
+  Delete(S,1,P);
+end;
+
+Function TFPCustomHTTPClient.ParseStatusLine(AStatusLine : String) : Integer;
+
+Var
+  S : String;
+
+begin
+  S:=Uppercase(GetNextWord(AStatusLine));
+  If (Copy(S,1,5)<>'HTTP/') then
+    Raise EHTTPClient.CreateFmt(SErrInvalidProtocolVersion,[S]);
+  Delete(S,1,5);
+  FServerHTTPVersion:=S;
+  S:=GetNextWord(AStatusLine);
+  Result:=StrToIntDef(S,-1);
+  if Result=-1 then
+   Raise EHTTPClient.CreateFmt(SErrInvalidStatusCode,[S]);
+  FResponseStatusText:=AStatusLine;
+end;
+
+Function TFPCustomHTTPClient.ReadResponseHeaders : Integer;
+
+  Procedure DoCookies(S : String);
+
+  Var
+    P : Integer;
+    C : String;
+
+  begin
+    If Assigned(FCookies) then
+      FCookies.Clear;
+    P:=Pos(':',S);
+    Delete(S,1,P);
+    Repeat
+      P:=Pos(';',S);
+      If (P=0) then
+        P:=Length(S)+1;
+      C:=Trim(Copy(S,1,P-1));
+      Cookies.Add(C);
+      Delete(S,1,P);
+    Until (S='');
+  end;
+
+Const
+  SetCookie = 'set-cookie';
+
+Var
+  StatusLine,S : String;
+
+begin
+  StatusLine:=ReadString;
+  Result:=ParseStatusLine(StatusLine);
+  Repeat
+    S:=ReadString;
+    if (S<>'') then
+      begin
+      ResponseHeaders.Add(S);
+      If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
+        DoCookies(S);
+      end
+  Until (S='');
+end;
+
+Function TFPCustomHTTPClient.CheckResponseCode(ACode : Integer; Const AllowedResponseCodes : Array of Integer) : Boolean;
+
+Var
+  I : Integer;
+
+begin
+  Result:=(High(AllowedResponseCodes)=-1);
+  if not Result then
+    begin
+    I:=Low(AllowedResponseCodes);
+    While (Not Result) and (I<=High(AllowedResponseCodes)) do
+      begin
+      Result:=(AllowedResponseCodes[i]=FResponseStatusCode);
+      Inc(I);
+      end
+    end;
+end;
+
+Function TFPCustomHTTPClient.CheckContentLength: Integer;
+
+Const CL ='content-length:';
+
+Var
+  S : String;
+  I : integer;
+
+begin
+  Result:=-1;
+  I:=0;
+  While (Result=-1) and (I<FResponseHeaders.Count) do
+    begin
+    S:=Trim(LowerCase(FResponseHeaders[i]));
+    If (Copy(S,1,Length(Cl))=Cl) then
+      begin
+      Delete(S,1,Length(CL));
+      Result:=StrToIntDef(Trim(S),-1);
+      end;
+    Inc(I);
+    end;
+end;
+
+function TFPCustomHTTPClient.GetCookies: TStrings;
+begin
+  If (FCookies=Nil) then
+    FCookies:=TStringList.Create;
+  Result:=FCookies;
+end;
+
+procedure TFPCustomHTTPClient.SetCookies(const AValue: TStrings);
+begin
+  if GetCookies=AValue then exit;
+  GetCookies.Assign(AValue);
+end;
+
+procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedResponseCodes : Array of Integer);
+
+  Function Transfer(LB : Integer) : Integer;
+
+  begin
+    Result:=FSocket.Read(FBuffer[1],LB);
+    If Result<0 then
+      Raise EHTTPClient.Create(SErrReadingSocket);
+    if (Result>0) then
+      Stream.Write(FBuffer[1],Result);
+  end;
+
+Var
+  L,LB,R : Integer;
+  ResponseOK : Boolean;
+
+begin
+  FResponseStatusCode:=ReadResponseHeaders;
+  if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
+    Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
+  // Write remains of buffer to output.
+  LB:=Length(FBuffer);
+  If (LB>0) then
+    Stream.WriteBuffer(FBuffer[1],LB);
+  // Now read the rest, if any.
+  SetLength(FBuffer,ReadBuflen);
+  L:=CheckContentLength;
+  If (L>LB) then
+    begin
+    // We cannot use copyfrom, it uses ReadBuffer, and this is dangerous with sockets
+    L:=L-LB;
+    Repeat
+      LB:=ReadBufLen;
+      If (LB>L) then
+        LB:=L;
+      R:=Transfer(LB);
+      L:=L-R;
+    until (L=0) or (R=0);
+    end
+  else if L<0 then
+    // No content-length, so we read till no more data available.
+    Repeat
+      R:=Transfer(ReadBufLen);
+    until (R=0);
+end;
+
+procedure TFPCustomHTTPClient.DoMethod(Const AMethod,AURL: String; Stream: TStream; Const AllowedResponseCodes : Array of Integer);
+
+Var
+  URI : TURI;
+
+begin
+  FResponseHeaders.Clear;
+  URI:=ParseURI(AURL);
+  If (Lowercase(URI.Protocol)<>'http') then
+   Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
+  ConnectToServer(URI.Host,URI.Port);
+  try
+    SendRequest(AMethod,URI);
+    ReadResponse(Stream,AllowedResponseCodes);
+  finally
+    DisconnectFromServer;
+  end;
+end;
+
+constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FRequestHeaders:=TStringList.Create;
+  FResponseHeaders:=TStringList.Create;
+  FHTTPVersion:='1.1';
+end;
+
+destructor TFPCustomHTTPClient.Destroy;
+begin
+  FreeAndNil(FRequestHeaders);
+  FreeAndNil(FResponseHeaders);
+  inherited Destroy;
+end;
+
+procedure TFPCustomHTTPClient.HTTPMethod(const AMethod, AURL: String;
+  Stream: TStream; const AllowedResponseCodes: array of Integer);
+begin
+  DoMethod(AMethod,AURL,Stream,AllowedResponseCodes);
+end;
+
+procedure TFPCustomHTTPClient.Get(Const AURL: String; Stream: TStream);
+begin
+  DoMethod('GET',AURL,Stream,[200]);
+end;
+
+procedure TFPCustomHTTPClient.Get(Const AURL: String; const LocalFileName: String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(LocalFileName,fmCreate);
+  try
+    Get(AURL,F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TFPCustomHTTPClient.Get(const AURL: String; Response: TStrings);
+begin
+  Response.Text:=Get(AURL);
+end;
+
+function TFPCustomHTTPClient.Get(Const AURL: String): String;
+
+Var
+  SS : TStringStream;
+
+begin
+  SS:=TStringStream.Create('');
+  try
+    Get(AURL,SS);
+    Result:=SS.Datastring;
+  finally
+    SS.Free;
+  end;
+end;
+
+procedure TFPCustomHTTPClient.Post(const URL: string; const Response: TStream);
+begin
+  DoMethod('POST',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Post(const URL: string; Response: TStrings);
+begin
+  Response.Text:=Post(URL);
+end;
+
+procedure TFPCustomHTTPClient.Post(const URL: string;
+  const LocalFileName: String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(LocalFileName,fmCreate);
+  try
+    Post(URL,F);
+  finally
+    F.Free;
+  end;
+end;
+
+function TFPCustomHTTPClient.Post(const URL: string): String;
+Var
+  SS : TStringStream;
+begin
+  SS:=TStringStream.Create('');
+  try
+    Post(URL,SS);
+    Result:=SS.Datastring;
+  finally
+    SS.Free;
+  end;
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
+  const Response: TStream);
+
+Var
+  S : TStringStream;
+
+begin
+  RequestBody:=TStringStream.Create(FormData);
+  try
+    AddHeader('Content-Type','application/x-www-form-urlencoded');
+    Post(URL,Response);
+  finally
+    RequestBody.Free;
+    RequestBody:=Nil;
+  end;
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
+  const Response: TStream);
+
+Var
+  I : Integer;
+  S,N,V : String;
+
+begin
+  For I:=0 to FormData.Count-1 do
+    begin
+    If (S<>'') then
+      S:=S+'&';
+    FormData.GetNameValue(i,n,v);
+    S:=S+EncodeURLElement(N)+'='+EncodeURLElement(V);
+    end;
+  FormPost(URL,S,Response);
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
+  const Response: TStrings);
+begin
+  Response.Text:=FormPost(URL,FormData);
+end;
+
+procedure TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings;
+  const Response: TStrings);
+begin
+  Response.Text:=FormPost(URL,FormData);
+end;
+
+function TFPCustomHTTPClient.FormPost(const URL, FormData: string): String;
+Var
+  SS : TStringStream;
+begin
+  SS:=TStringStream.Create('');
+  try
+    FormPost(URL,FormData,SS);
+    Result:=SS.Datastring;
+  finally
+    SS.Free;
+  end;
+end;
+
+function TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings
+  ): String;
+Var
+  SS : TStringStream;
+begin
+  SS:=TStringStream.Create('');
+  try
+    FormPost(URL,FormData,SS);
+    Result:=SS.Datastring;
+  finally
+    SS.Free;
+  end;
+end;
+
+procedure TFPCustomHTTPClient.FileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
+
+Var
+  S, Sep : string;
+  SS : TStringStream;
+  F : TFileStream;
+  DS : TBase64EncodingStream;
+
+begin
+  Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]);
+  AddHeader('Content-type','multipart/form-data; boundary='+Sep);
+  S:='--'+Sep+CRLF;
+  s:=s+Format('content-disposition: form-data; name="%s"; filename="%s"'+CRLF,[AFieldName,AFileName]);
+  s:=s+'Content-Type: Application/octet-string'+CRLF+CRLF;
+  SS:=TStringStream.Create(s);
+  try
+    SS.Seek(0,soFromEnd);
+    F:=TFileStream.Create(AFileName,fmOpenRead);
+    try
+      SS.CopyFrom(F,F.Size);
+    finally
+      F.Free;
+    end;
+    S:=CRLF+'--'+Sep+'--'+CRLF;
+    SS.WriteBuffer(S[1],Length(S));
+    SS.Position:=0;
+    RequestBody:=SS;
+    Post(AURL,Response);
+  finally
+   RequestBody:=Nil;
+   SS.Free;
+  end;
+end;
+
+end.
+

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

@@ -0,0 +1,623 @@
+{
+    $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2011- by the Free Pascal development team
+    
+    Simple HTTP server component.
+
+    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.
+
+ **********************************************************************}
+unit fphttpserver;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, ssockets, httpdefs;
+
+Const
+  ReadBufLen = 4096;
+
+Type
+  TFPHTTPConnection = Class;
+  TFPHTTPConnectionThread = Class;
+  TFPCustomHttpServer = Class;
+
+  { TFPHTTPConnectionRequest }
+
+  TFPHTTPConnectionRequest = Class(TRequest)
+  private
+    FConnection: TFPHTTPConnection;
+    
+  protected
+    procedure SetContent(AValue : String);
+    Property Connection : TFPHTTPConnection Read FConnection;
+  end;
+
+  { TFPHTTPConnectionResponse }
+
+  TFPHTTPConnectionResponse = Class(TResponse)
+  private
+    FConnection: TFPHTTPConnection;
+  Protected
+    Procedure DoSendHeaders(Headers : TStrings); override;
+    Procedure DoSendContent; override;
+    Property Connection : TFPHTTPConnection Read FConnection;
+  end;
+
+
+  { TFPHTTPConnection }
+
+  TFPHTTPConnection = Class(TObject)
+  private
+    FServer: TFPCustomHTTPServer;
+    FSocket: TSocketStream;
+    FBuffer : Ansistring;
+    procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String);
+    function ReadString: String;
+  Protected
+    procedure ReadRequestContent(ARequest: TFPHTTPConnectionRequest); virtual;
+    procedure UnknownHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String); virtual;
+    Function ReadRequestHeaders : TFPHTTPConnectionRequest;
+  Public
+    Constructor Create(AServer : TFPCustomHTTPServer; ASocket : TSocketStream);
+    Destructor Destroy; override;
+    Procedure HandleRequest; virtual;
+    Property Socket : TSocketStream Read FSocket;
+    Property Server : TFPCustomHTTPServer Read FServer;
+  end;
+
+  { TFPHTTPConnectionThread }
+
+  TFPHTTPConnectionThread = Class(TThread)
+  private
+    FConnection: TFPHTTPConnection;
+  Public
+    Constructor CreateConnection(AConnection : TFPHTTPConnection); virtual;
+    Procedure Execute; override;
+    Property Connection : TFPHTTPConnection Read FConnection;
+  end;
+
+  { TFPHttpServer }
+  THTTPServerRequestHandler = Procedure (Sender: TObject;
+      Var ARequest: TFPHTTPConnectionRequest;
+      Var AResponse : TFPHTTPConnectionResponse) of object;
+
+  { TFPCustomHttpServer }
+
+  TFPCustomHttpServer = Class(TComponent)
+  Private
+    FOnAllowConnect: TConnectQuery;
+    FOnRequest: THTTPServerRequestHandler;
+    FPort: Word;
+    FQueueSize: Word;
+    FServer : TInetServer;
+    FLoadActivate : Boolean;
+    FThreaded: Boolean;
+    function GetActive: Boolean;
+    procedure SetActive(const AValue: Boolean);
+    procedure SetOnAllowConnect(const AValue: TConnectQuery);
+    procedure SetPort(const AValue: Word);
+    procedure SetQueueSize(const AValue: Word);
+    procedure SetThreaded(const AValue: Boolean);
+  Protected
+    // Create a connection handling object.
+    function CreateConnection(Data : TSocketStream) : TFPHTTPConnection; virtual;
+    // Create a connection handling thread.
+    Function CreateConnectionThread(Conn : TFPHTTPConnection) : TFPHTTPConnectionThread; virtual;
+    // Check if server is inactive
+    Procedure CheckInactive;
+    // Called by TInetServer when a new connection is accepted.
+    Procedure DoConnect(Sender : TObject; Data : TSocketStream); virtual;
+    // Create and configure TInetServer
+    Procedure CreateServerSocket; virtual;
+    // Stop and free TInetServer
+    Procedure FreeServerSocket; virtual;
+    // Handle request. This calls OnRequest. It can be overridden by descendants to provide standard handling.
+    procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest;
+                            Var AResponse : TFPHTTPConnectionResponse); virtual;
+  public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  protected
+    // Set to true to start listening.
+    Property Active : Boolean Read GetActive Write SetActive Default false;
+    // Port to listen on.
+    Property Port : Word Read FPort Write SetPort Default 80;
+    // Max connections on queue (for Listen call)
+    Property QueueSize : Word Read FQueueSize Write SetQueueSize Default 5;
+    // Called when deciding whether to accept a connection.
+    Property OnAllowConnect : TConnectQuery Read FOnAllowConnect Write SetOnAllowConnect;
+    // Use a thread to handle a connection ?
+    property Threaded : Boolean read FThreaded Write SetThreaded;
+    // Called to handle the request. If Threaded=True, it is called in a the connection thread.
+    Property OnRequest : THTTPServerRequestHandler Read FOnRequest Write FOnRequest;
+  end;
+
+  TFPHttpServer = Class(TFPCustomHttpServer)
+  Published
+    Property Active;
+    Property Port;
+    Property QueueSize;
+    Property OnAllowConnect;
+    property Threaded;
+    Property OnRequest;
+  end;
+
+  EHTTPServer = Class(Exception);
+
+implementation
+
+resourcestring
+  SErrSocketActive    =  'Operation not allowed while server is active';
+  SErrReadingSocket   = 'Error reading data from the socket';
+  SErrMissingProtocol = 'Missing HTTP protocol version in request';
+
+{ TFPHTTPConnectionRequest }
+Function GetStatusCode (ACode: Integer) : String;
+
+begin
+  Case ACode of
+    100 :  Result:='Continue';
+    101 :  Result:='Switching Protocols';
+    200 :  Result:='OK';
+    201 :  Result:='Created';
+    202 :  Result:='Accepted';
+    203 :  Result:='Non-Authoritative Information';
+    204 :  Result:='No Content';
+    205 :  Result:='Reset Content';
+    206 :  Result:='Partial Content';
+    300 :  Result:='Multiple Choices';
+    301 :  Result:='Moved Permanently';
+    302 :  Result:='Found';
+    303 :  Result:='See Other';
+    304 :  Result:='Not Modified';
+    305 :  Result:='Use Proxy';
+    307 :  Result:='Temporary Redirect';
+    400 :  Result:='Bad Request';
+    401 :  Result:='Unauthorized';
+    402 :  Result:='Payment Required';
+    403 :  Result:='Forbidden';
+    404 :  Result:='Not Found';
+    405 :  Result:='Method Not Allowed';
+    406 :  Result:='Not Acceptable';
+    407 :  Result:='Proxy Authentication Required';
+    408 :  Result:='Request Time-out';
+    409 :  Result:='Conflict';
+    410 :  Result:='Gone';
+    411 :  Result:='Length Required';
+    412 :  Result:='Precondition Failed';
+    413 :  Result:='Request Entity Too Large';
+    414 :  Result:='Request-URI Too Large';
+    415 :  Result:='Unsupported Media Type';
+    416 :  Result:='Requested range not satisfiable';
+    417 :  Result:='Expectation Failed';
+    500 :  Result:='Internal Server Error';
+    501 :  Result:='Not Implemented';
+    502 :  Result:='Bad Gateway';
+    503 :  Result:='Service Unavailable';
+    504 :  Result:='Gateway Time-out';
+    505 :  Result:='HTTP Version not supported';
+  else
+    Result:='Unknown status';
+  end;
+end;
+
+procedure TFPHTTPConnectionRequest.SetContent(AValue : String);
+
+begin
+  FContent:=Avalue;
+  FContentRead:=true;
+end;
+(*
+Procedure TFPHTTPConnectionRequest.SetFieldValue(Index : Integer; Value : String);
+
+begin
+  if Index=35 then
+    FContent:=Value
+  else
+    Inherited (Index,Value);
+end;
+
+Function TFPHTTPConnectionRequest.GetFieldValue(Index : Integer) : String;
+
+begin
+  if Index=35 then
+    Result:=FContent
+  else
+    Result:=Inherited GetFieldValue(Index);
+end;
+*)
+
+procedure TFPHTTPConnectionResponse.DoSendHeaders(Headers: TStrings);
+
+Var
+  S : String;
+  I : Integer;
+begin
+  S:=Format('HTTP/1.1 %3d %s'#13#10,[Code,GetStatusCode(Code)]);
+  For I:=0 to Headers.Count-1 do
+    S:=S+Headers[i]+#13#10;
+  // Last line in headers is empty.
+  Connection.Socket.WriteBuffer(S[1],Length(S));
+end;
+
+procedure TFPHTTPConnectionResponse.DoSendContent;
+begin
+  If Assigned(ContentStream) then
+    Connection.Socket.CopyFrom(ContentStream,0)
+  else
+    Contents.SaveToStream(Connection.Socket);
+end;
+
+{ TFPHTTPConnection }
+
+function TFPHTTPConnection.ReadString : String;
+
+  Procedure FillBuffer;
+
+  Var
+    R : Integer;
+
+  begin
+    SetLength(FBuffer,ReadBufLen);
+    r:=FSocket.Read(FBuffer[1],ReadBufLen);
+    If r<0 then
+      Raise EHTTPServer.Create(SErrReadingSocket);
+    if (r<ReadBuflen) then
+      SetLength(FBuffer,r);
+  end;
+
+Var
+  CheckLF,Done : Boolean;
+  P,L : integer;
+
+begin
+  Result:='';
+  Done:=False;
+  CheckLF:=False;
+  Repeat
+    if Length(FBuffer)=0 then
+      FillBuffer;
+    if Length(FBuffer)=0 then
+      Done:=True
+    else if CheckLF then
+      begin
+      If (FBuffer[1]<>#10) then
+        Result:=Result+#13
+      else
+        begin
+        Delete(FBuffer,1,1);
+        Done:=True;
+        end;
+      CheckLF:=False;  
+      end;
+    if not Done then
+      begin
+      P:=Pos(#13#10,FBuffer);
+      If P=0 then
+        begin
+        L:=Length(FBuffer);
+        CheckLF:=FBuffer[L]=#13;
+        if CheckLF then
+          Result:=Result+Copy(FBuffer,1,L-1)
+        else
+          Result:=Result+FBuffer;
+        FBuffer:='';
+        end
+      else
+        begin
+        Result:=Result+Copy(FBuffer,1,P-1);
+        Delete(FBuffer,1,P+1);
+        Done:=True;
+        end;
+      end;
+  until Done;
+end;
+
+procedure TFPHTTPConnection.UnknownHeader(ARequest: TFPHTTPConnectionRequest;
+  const AHeader: String);
+begin
+  // Do nothing
+end;
+
+Procedure TFPHTTPConnection.InterPretHeader(ARequest : TFPHTTPConnectionRequest; Const AHeader : String);
+
+Var
+  P : Integer;
+  N,V : String;
+
+begin
+  V:=AHeader;
+  P:=Pos(':',V);
+  if (P=0) then
+    begin
+    UnknownHeader(ARequest,Aheader);
+    Exit;
+    end;
+  N:=Copy(V,1,P-1);
+  Delete(V,1,P+1);
+  V:=Trim(V);
+  ARequest.SetFieldByName(N,V);
+end;
+
+procedure ParseStartLine(Request : TFPHTTPConnectionRequest; AStartLine : String);
+
+  Function GetNextWord(Var S : String) : string;
+
+  Var
+    P : Integer;
+
+  begin
+    P:=Pos(' ',S);
+    If (P=0) then
+      P:=Length(S)+1;
+    Result:=Copy(S,1,P-1);
+    Delete(S,1,P);
+  end;
+
+Var
+  S : String;
+
+begin
+  Request.Method:=GetNextWord(AStartLine);
+  Request.URL:=GetNextWord(AStartLine);
+  S:=GetNextWord(AStartLine);
+  If (Pos('HTTP/',S)<>1) then
+    Raise Exception.Create(SErrMissingProtocol);
+  Delete(S,1,5);
+  Request.ProtocolVersion:=trim(S);
+end;
+
+Procedure TFPHTTPConnection.ReadRequestContent(ARequest : TFPHTTPConnectionRequest);
+
+Var
+  P,L,R : integer;
+  S : String;
+
+begin
+  L:=ARequest.ContentLength;
+  If (L>0) then
+    begin
+    SetLength(S,L);
+    P:=Length(FBuffer);
+    if (P>0) then
+      begin
+      Move(FBuffer[1],S[1],P);
+      L:=L-P;
+      end;
+    P:=P+1;
+    R:=1;
+    While (L<>0) and (R>0) do
+      begin
+      R:=FSocket.Read(S[p],L);
+      If R<0 then
+        Raise EHTTPServer.Create(SErrReadingSocket);
+      if (R>0) then
+        begin
+        P:=P+R;
+        L:=L-R;
+        end;
+      end;  
+    end;
+  ARequest.SetContent(S);
+end;
+
+function TFPHTTPConnection.ReadRequestHeaders: TFPHTTPConnectionRequest;
+
+Var
+  StartLine,S : String;
+begin
+  Result:=TFPHTTPConnectionRequest.Create;
+  Result.FConnection:=Self;
+  StartLine:=ReadString;
+  ParseStartLine(Result,StartLine);
+  Repeat
+    S:=ReadString;
+    if (S<>'') then
+      InterPretHeader(Result,S);
+  Until (S='');
+end;
+
+constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream
+  );
+begin
+  FSocket:=ASocket;
+  FServer:=AServer;
+end;
+
+destructor TFPHTTPConnection.Destroy;
+begin
+  FreeAndNil(FSocket);
+  Inherited;
+end;
+
+procedure TFPHTTPConnection.HandleRequest;
+
+Var
+  Req : TFPHTTPConnectionRequest;
+  Resp : TFPHTTPConnectionResponse;
+
+begin
+  // Read headers.
+  Req:=ReadRequestHeaders;
+  try
+    // Read content, if any
+    If Req.ContentLength>0 then
+      begin
+      ReadRequestContent(Req);
+      end;
+    // Create Response
+    Resp:= TFPHTTPConnectionResponse.Create(Req);
+    try
+      Resp.FConnection:=Self;
+      // And dispatch
+      if Server.Active then
+        Server.HandleRequest(Req,Resp);
+      if Assigned(Resp) and (not Resp.ContentSent) then
+        Resp.SendContent;
+    finally
+      FreeAndNil(Resp);
+    end;
+  Finally
+    FreeAndNil(Req);
+  end;
+end;
+
+{ TFPHTTPConnectionThread }
+
+constructor TFPHTTPConnectionThread.CreateConnection(AConnection: TFPHTTPConnection
+  );
+begin
+  FConnection:=AConnection;
+  FreeOnTerminate:=True;
+  Inherited Create(False);
+end;
+
+procedure TFPHTTPConnectionThread.Execute;
+begin
+  try
+    try
+      FConnection.HandleRequest;
+    finally
+      FreeAndNil(FConnection);
+    end;
+  except
+    // Silently ignore errors.
+  end;
+end;
+
+{ TFPCustomHttpServer }
+
+function TFPCustomHttpServer.GetActive: Boolean;
+begin
+  if (csDesigning in ComponentState) then
+    Result:=FLoadActivate
+  else
+    Result:=Assigned(FServer);
+end;
+
+procedure TFPCustomHttpServer.SetActive(const AValue: Boolean);
+begin
+  If AValue=GetActive then exit;
+  FLoadActivate:=AValue;
+  if not (csDesigning in Componentstate) then
+    if AValue then
+      CreateServerSocket
+    else
+      FreeServerSocket;
+end;
+
+procedure TFPCustomHttpServer.SetOnAllowConnect(const AValue: TConnectQuery);
+begin
+  if FOnAllowConnect=AValue then exit;
+  CheckInactive;
+  FOnAllowConnect:=AValue;
+end;
+
+procedure TFPCustomHttpServer.SetPort(const AValue: Word);
+begin
+  if FPort=AValue then exit;
+  CheckInactive;
+  FPort:=AValue;
+end;
+
+procedure TFPCustomHttpServer.SetQueueSize(const AValue: Word);
+begin
+  if FQueueSize=AValue then exit;
+  CheckInactive;
+  FQueueSize:=AValue;
+end;
+
+procedure TFPCustomHttpServer.SetThreaded(const AValue: Boolean);
+begin
+  if FThreaded=AValue then exit;
+  CheckInactive;
+  FThreaded:=AValue;
+end;
+
+function TFPCustomHttpServer.CreateConnection(Data: TSocketStream): TFPHTTPConnection;
+begin
+  Result:=TFPHTTPConnection.Create(Self,Data);
+end;
+
+function TFPCustomHttpServer.CreateConnectionThread(Conn: TFPHTTPConnection
+  ): TFPHTTPConnectionThread;
+begin
+   Result:=TFPHTTPConnectionThread.CreateConnection(Conn);
+end;
+
+procedure TFPCustomHttpServer.CheckInactive;
+begin
+  If GetActive then
+    Raise EHTTPServer.Create(SErrSocketActive);
+end;
+
+procedure TFPCustomHttpServer.DoConnect(Sender: TObject; Data: TSocketStream);
+
+Var
+  Con : TFPHTTPConnection;
+
+begin
+  Con:=CreateConnection(Data);
+  try
+    Con.FServer:=Self;
+    if Threaded then
+      CreateConnectionThread(Con)
+    else
+      begin
+      Con.HandleRequest;
+      end;
+  finally
+    if not Threaded then
+      Con.Free;
+  end;
+end;
+
+procedure TFPCustomHttpServer.CreateServerSocket;
+begin
+  FServer:=TInetServer.Create(FPort);
+  FServer.MaxConnections:=-1;
+  FServer.OnConnectQuery:=OnAllowConnect;
+  FServer.OnConnect:=@DOConnect;
+  FServer.QueueSize:=Self.QueueSize;
+  FServer.Bind;
+  FServer.Listen;
+  FServer.StartAccepting;
+end;
+
+procedure TFPCustomHttpServer.FreeServerSocket;
+begin
+  FServer.StopAccepting;
+  FreeAndNil(FServer);
+end;
+
+procedure TFPCustomHttpServer.HandleRequest(var ARequest: TFPHTTPConnectionRequest;
+  var AResponse: TFPHTTPConnectionResponse);
+begin
+  If Assigned(FOnRequest) then
+    FonRequest(Self,ARequest,AResponse);
+end;
+
+constructor TFPCustomHttpServer.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FPort:=80;
+  FQueueSize:=5;
+end;
+
+destructor TFPCustomHttpServer.Destroy;
+begin
+  Active:=False;
+  inherited Destroy;
+end;
+
+end.
+

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

@@ -18,7 +18,7 @@ unit fpWeb;
 interface
 
 uses
-  Classes, SysUtils, httpdefs, fphttp, fptemplate, websession;
+  Classes, SysUtils, httpdefs, fphttp, fptemplate;
 
 Type
 
@@ -127,7 +127,7 @@ Type
     Property AfterResponse : TResponseEvent Read FAfterResponse Write FAfterResponse;
     Property OnGetAction : TGetActionEvent Read GetOnGetAction Write SetOnGetAction;
     Property DefActionWhenUnknown : Boolean read GetDefActionWhenUnknown write SetDefActionWhenUnknown default true;
-    Property Template : TFPTemplate Read FTemplate Write SetTemplate;
+    Property ModuleTemplate : TFPTemplate Read FTemplate Write SetTemplate;
     Property OnGetParam : TGetParamEvent Read FOnGetParam Write FOnGetParam;
     Property OnTemplateContent : TGetParamEvent Read FOnGetParam Write FOnGetParam;
     Property Request: TRequest Read FRequest;

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

@@ -175,6 +175,7 @@ type
     FHTTPXRequestedWith: String;
     FFields : THttpFields;
     FQueryFields: TStrings;
+    FURL : String;
     function GetSetField(AIndex: Integer): String;
     function GetSetFieldName(AIndex: Integer): String;
     procedure SetCookieFields(const AValue: TStrings);
@@ -624,6 +625,7 @@ begin
   else
     case Index of
       0  : Result:=FHTTPVersion;
+      32 : Result:=FURL;
       36 : Result:=FHTTPXRequestedWith;
     else
       Result := '';
@@ -654,6 +656,7 @@ begin
       28 : ; // Property RemoteHost : String Index 28 read  GetFieldValue Write SetFieldValue;
       29 : ; // Property ScriptName : String Index 29 read  GetFieldValue Write SetFieldValue;
       30 : ; // Property ServerPort : Word Read GetServerPort; // Index 30
+      32 : FURL:=Value;
       36 : FHTTPXRequestedWith:=Value;
     end;
 end;
@@ -1700,6 +1703,7 @@ Var
 begin
   CreateGUID(G);
   Result:=GuiDToString(G);
+  Result:=Copy(Result,2,36);
 end;
 
 constructor TCustomSession.Create(AOwner: TComponent);

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

@@ -0,0 +1,382 @@
+{
+    $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    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.
+
+ **********************************************************************}
+unit iniwebsession;
+
+{$mode objfpc}{$H+}
+{ $define cgidebug}
+interface
+
+uses
+  Classes, SysUtils, fphttp, inifiles, httpdefs;
+  
+Type
+
+  { TIniWebSession }
+
+  TIniWebSession = Class(TCustomSession)
+  Private
+    FSessionStarted : Boolean;
+    FCached: Boolean;
+    FIniFile : TMemInifile;
+    FSessionCookie: String;
+    FSessionCookiePath: String;
+    FSessionDir: String;
+    FTerminated :Boolean;
+    SID : String;
+  private
+    procedure FreeIniFile;
+  Protected
+    Procedure CheckSession;
+    Function GetSessionID : String; override;
+    Function GetSessionVariable(VarName : String) : String; override;
+    procedure SetSessionVariable(VarName : String; const AValue: String); override;
+    Property Cached : Boolean Read FCached Write FCached;
+    property SessionCookie : String Read FSessionCookie Write FSessionCookie;
+    Property SessionDir : String Read FSessionDir Write FSessionDir;
+    Property SessionCookiePath : String Read FSessionCookiePath write FSessionCookiePath;
+  Public
+    Destructor Destroy; override;
+    Procedure Terminate; override;
+    Procedure UpdateResponse(AResponse : TResponse); override;
+    Procedure InitSession(ARequest : TRequest; OnNewSession, OnExpired: TNotifyEvent); override;
+    Procedure InitResponse(AResponse : TResponse); override;
+    Procedure RemoveVariable(VariableName : String); override;
+  end;
+  TIniWebSessionClass = Class of TIniWebSession;
+
+  { TIniSessionFactory }
+
+  TIniSessionFactory = Class(TSessionFactory)
+  private
+    FCached: Boolean;
+    FOldFileNameScheme: Boolean;
+    FSessionDir: String;
+    procedure SetCached(const AValue: Boolean);
+    procedure SetSessionDir(const AValue: String);
+  protected
+    Procedure DeleteSessionFile(const AFileName : String);virtual;
+    Function SessionExpired(Ini : TMemIniFile) : boolean;
+    procedure CheckSessionDir; virtual;
+    Function DoCreateSession(ARequest : TRequest) : TCustomSession; override;
+    // Sweep session direcory and delete expired files.
+    procedure DoCleanupSessions; override;
+    Procedure DoDoneSession(Var ASession : TCustomSession); override;
+  Public
+    // Directory where sessions are kept.
+    Property SessionDir : String Read FSessionDir Write SetSessionDir;
+    // Are ini files cached (written in 1 go before destroying)
+    Property Cached : Boolean Read FCached Write SetCached;
+    // If True, the '{' and '}' will not be stripped from the session filename.
+    Property OldFileNameScheme : Boolean Read FOldFileNameScheme Write FOldFileNameScheme;
+  end;
+
+Var
+  IniWebSessionClass : TIniWebSessionClass = Nil;
+
+implementation
+
+{$ifdef cgidebug}
+uses dbugintf;
+{$endif}
+
+Const
+  // Sections in ini file
+  SSession   = 'Session';
+  SData      = 'Data';
+
+  KeyStart   = 'Start';         // Start time of session
+  KeyLast    = 'Last';          // Last seen time of session
+  KeyTimeOut = 'Timeout';       // Timeout in seconds;
+
+  SFPWebSession = 'FPWebSession'; // Cookie name for session.
+
+resourcestring
+  SErrSessionTerminated = 'No web session active: Session was terminated';
+  SErrNoSession         = 'No web session active: Session was not started';
+
+{ TIniSessionFactory }
+
+procedure TIniSessionFactory.SetCached(const AValue: Boolean);
+begin
+  if FCached=AValue then exit;
+  FCached:=AValue;
+end;
+
+procedure TIniSessionFactory.SetSessionDir(const AValue: String);
+begin
+  if FSessionDir=AValue then exit;
+  FSessionDir:=AValue;
+end;
+
+procedure TIniSessionFactory.DeleteSessionFile(const AFileName: String);
+begin
+  DeleteFile(AFileName); // TODO : silently ignoring errors ?
+end;
+
+function TIniSessionFactory.SessionExpired(Ini: TMemIniFile): boolean;
+
+Var
+  L : TDateTime;
+  T : Integer;
+begin
+  L:=Ini.ReadDateTime(SSession,KeyLast,0);
+  T:=Ini.ReadInteger(SSession,KeyTimeOut,DefaultTimeOutMinutes);
+  {$ifdef cgidebug}
+  If (L=0) then
+    SendDebug('No datetime in inifile (or not valid datetime : '+Ini.ReadString(SSession,KeyLast,''))
+  else
+    SendDebug('Last    :'+FormatDateTime('yyyy/mm/dd hh:nn:ss.zzz',L));
+  SendDebug('Timeout :'+IntToStr(t));
+  {$endif}
+  Result:=((Now-L)>(T/(24*60)))
+  {$ifdef cgidebug}
+  if Result then
+    begin
+    SendDebug('Timeout :'+FloatToStr(T/(24*60)));
+    SendDebug('Timeout :'+FormatDateTime('hh:nn:ss.zzz',(T/(24*60))));
+    SendDebug('Diff    :'+FormatDateTime('hh:nn:ss.zzz',Now-L));
+    SendDebug('Ini file session expired: '+ExtractFileName(Ini.FileName));
+    end;
+  {$endif}
+end;
+
+procedure TIniSessionFactory.CheckSessionDir;
+
+Var
+  TD : String;
+
+begin
+  If (FSessionDir='') then
+    begin
+    TD:=IncludeTrailingPathDelimiter(GetTempDir(True));
+    FSessionDir:=TD+'fpwebsessions'+PathDelim;
+    if Not ForceDirectories(FSessionDir) then
+      FSessionDir:=TD; // Assuming temp dir is writeable as fallback
+    end;
+end;
+
+
+function TIniSessionFactory.DoCreateSession(ARequest: TRequest): TCustomSession;
+
+Var
+  S : TIniWebSession;
+begin
+  CheckSessionDir;
+  if IniWebSessionClass=Nil then
+    S:=TIniWebSession.Create(Nil)
+  else
+    S:=IniWebSessionClass.Create(Nil);
+  S.SessionDir:=SessionDir;
+  S.Cached:=Cached;
+  Result:=S;
+end;
+
+procedure TIniSessionFactory.DoCleanupSessions;
+
+Var
+  Info : TSearchRec;
+  Ini : TMemIniFile;
+  FN : string;
+
+begin
+  CheckSessionDir;
+  If FindFirst(SessionDir+AllFilesMask,0,info)=0 then
+    try
+      Repeat
+        if (Info.Attr and faDirectory=0) then
+          begin
+          Ini:=TMeminiFile.Create(SessionDir+Info.Name);
+          try
+            If SessionExpired(Ini) then
+              DeleteSessionFile(SessionDir+Info.Name);
+          finally
+            Ini.Free;
+          end;
+          end;
+      Until FindNext(Info)<>0;
+   finally
+     FindClose(Info);
+   end;
+end;
+
+procedure TIniSessionFactory.DoDoneSession(var ASession: TCustomSession);
+begin
+  FreeAndNil(ASession);
+end;
+
+{ TIniWebSession }
+
+function TIniWebSession.GetSessionID: String;
+begin
+  If (SID='') then
+    SID:=inherited GetSessionID;
+  Result:=SID;
+end;
+
+procedure TIniWebSession.FreeIniFile;
+begin
+  If Cached and Assigned(FIniFile) then
+    TMemIniFile(FIniFile).UpdateFile;
+  FreeAndNil(FIniFile);
+end;
+
+
+Procedure TIniWebSession.CheckSession;
+
+begin
+  If Not Assigned(FInifile) then
+    if FTerminated then
+      Raise EWebSessionError.Create(SErrSessionTerminated)
+    else
+      Raise EWebSessionError.Create(SErrNoSession)
+end;
+
+function TIniWebSession.GetSessionVariable(VarName: String): String;
+begin
+  CheckSession;
+  Result:=FIniFile.ReadString(SData,VarName,'');
+end;
+
+procedure TIniWebSession.SetSessionVariable(VarName: String;
+  const AValue: String);
+begin
+  CheckSession;
+  FIniFile.WriteString(SData,VarName,AValue);
+  If Not Cached then
+    TMemIniFile(FIniFile).UpdateFile;
+end;
+
+destructor TIniWebSession.Destroy;
+begin
+  // In case an exception occured and UpdateResponse is not called,
+  // write the updates to disk and free FIniFile
+  FreeIniFile;
+  inherited Destroy;
+end;
+
+procedure TIniWebSession.Terminate;
+begin
+  FTerminated:=True;
+  If Assigned(FIniFile) Then
+    begin
+    DeleteFile(Finifile.FileName);
+    FreeAndNil(FIniFile);
+    end;
+end;
+
+procedure TIniWebSession.UpdateResponse(AResponse: TResponse);
+begin
+  // Do nothing. Init has done the job.
+  FreeIniFile;
+end;
+
+procedure TIniWebSession.InitSession(ARequest: TRequest; OnNewSession,OnExpired: TNotifyEvent);
+
+Var
+  L,D   : TDateTime;
+  T   : Integer;
+  S : String;
+
+begin
+{$ifdef cgidebug}SendMethodEnter('TIniWebSession.InitSession');{$endif}
+  // First initialize all session-dependent properties to their default, because
+  // in Apache-modules or fcgi programs the session-instance is re-used
+  SID := '';
+  FSessionStarted := False;
+  FTerminated := False;
+  // If a exception occured during a prior request FIniFile is still not freed
+  if assigned(FIniFile) then FreeIniFile;
+
+  If (SessionCookie='') then
+    SessionCookie:=SFPWebSession;
+  S:=ARequest.CookieFields.Values[SessionCookie];
+  // have session cookie ?
+  If (S<>'') then
+    begin
+{$ifdef cgidebug}SendDebug('Reading ini file:'+S);{$endif}
+    FIniFile:=TMemIniFile.Create(IncludeTrailingPathDelimiter(SessionDir)+S);
+    if (SessionFactory as TIniSessionFactory).SessionExpired(FIniFile) then
+      begin
+      // Expire session.
+      If Assigned(OnExpired) then
+        OnExpired(Self);
+      (SessionFactory as TIniSessionFactory).DeleteSessionFile(FIniFIle.FileName);
+      FreeAndNil(FInifile);
+      S:='';
+      end
+    else
+      SID:=S;
+    end;
+  If (S='') then
+    begin
+    If Assigned(OnNewSession) then
+      OnNewSession(Self);
+    GetSessionID;
+    S:=IncludeTrailingPathDelimiter(SessionDir)+SessionID;
+{$ifdef cgidebug}SendDebug('Creating new Ini file : '+S);{$endif}
+    FIniFile:=TMemIniFile.Create(S);
+    FIniFile.WriteDateTime(SSession,KeyStart,Now);
+    FIniFile.WriteInteger(SSession,KeyTimeOut,Self.TimeOutMinutes);
+    FSessionStarted:=True;
+    end;
+  FIniFile.WriteDateTime(SSession,KeyLast,Now);
+  If not FCached then
+    FIniFile.UpdateFile;
+{$ifdef cgidebug}SendMethodExit('TIniWebSession.InitSession');{$endif}
+end;
+
+procedure TIniWebSession.InitResponse(AResponse: TResponse);
+
+Var
+  C : TCookie;
+
+begin
+{$ifdef cgidebug}SendMethodEnter('TIniWebSession.InitResponse');{$endif}
+  If FSessionStarted then
+    begin
+{$ifdef cgidebug}SendDebug('Session started');{$endif}
+    C:=AResponse.Cookies.FindCookie(SessionCookie);
+    If (C=Nil) then
+      begin
+      C:=AResponse.Cookies.Add;
+      C.Name:=SessionCookie;
+      end;
+    C.Value:=SID;
+    C.Path:=FSessionCookiePath;
+    end
+  else If FTerminated then
+    begin
+{$ifdef cgidebug}SendDebug('Session terminated');{$endif}
+    C:=AResponse.Cookies.Add;
+    C.Name:=SessionCookie;
+    C.Value:='';
+    end;
+{$ifdef cgidebug}SendMethodExit('TIniWebSession.InitResponse');{$endif}
+end;
+
+procedure TIniWebSession.RemoveVariable(VariableName: String);
+begin
+{$ifdef cgidebug}SendMethodEnter('TIniWebSession.RemoveVariable');{$endif}
+  CheckSession;
+  FIniFile.DeleteKey(SData,VariableName);
+  If Not Cached then
+    TMemIniFile(FIniFile).UpdateFile;
+{$ifdef cgidebug}SendMethodExit('TIniWebSession.RemoveVariable');{$endif}
+end;
+
+
+initialization
+  SessionFactoryClass:=TIniSessionFactory;
+end.
+

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

@@ -61,6 +61,8 @@ type
     function CreateNewScript: TStringList; override;
     procedure ShowRegisteredScript(ScriptID: integer); override;
     procedure FreeScript(var AScript: TStringList); override;
+  published
+    property OnGetURL;
   end;
 
   { TWebPage }
@@ -89,7 +91,6 @@ type
     procedure DoHandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse; var Handled: boolean); virtual;
     procedure DoBeforeRequest(ARequest: TRequest); virtual;
     procedure DoBeforeShowPage(ARequest: TRequest); virtual;
-    property WebModule: TFPWebModule read FWebModule;
     procedure DoCleanupAfterRequest(const AContentProducer: THTMLContentProducer);
     procedure SetRequest(ARequest: TRequest); virtual;
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
@@ -114,6 +115,7 @@ type
     property ContentProducers[Index: integer]: THTMLContentProducer read GetContentProducer;
     property HasWebController: boolean read GetHasWebController;
     property WebController: TWebController read GetWebController write FWebController;
+    property WebModule: TFPWebModule read FWebModule;
   published
     property BeforeRequest: TRequestEvent read FBeforeRequest write FBeforeRequest;
     property BeforeShowPage: TRequestEvent read FBeforeShowPage write FBeforeShowPage;
@@ -263,7 +265,7 @@ begin
               AComponent:=self;
               while (i > 0) and (assigned(AComponent)) do
                 begin
-                AComponent := FindComponent(copy(CompName,1,i-1));
+                AComponent := AComponent.FindComponent(copy(CompName,1,i-1));
                 CompName := copy(compname,i+1,length(compname)-i);
                 i := pos('$',CompName);
                 end;
@@ -277,6 +279,7 @@ begin
                 if ASuffixID<>'' then
                   begin
                   SetIdSuffixes(THTMLContentProducer(AComponent));
+                  webcontroller.ResetIterationLevel;
                   end;
                 THTMLContentProducer(AComponent).HandleAjaxRequest(ARequest, AnAjaxResponse);
                 end;
@@ -611,7 +614,9 @@ begin
 
   p := copy(qs,1,length(qs)-1);
   if p <> '' then
-    result := result + ConnectChar + p
+    result := result + ConnectChar + p;
+  if assigned(OnGetURL) then
+    OnGetURL(ParamNames, ParamValues, KeepParams, Action, Result);
 end;
 
 procedure TStandardWebController.BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string);

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

@@ -11,76 +11,19 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-unit websession;
+unit websession {$ifndef ver2_4} deprecated{$endif};
 
 {$mode objfpc}{$H+}
 { $define cgidebug}
 interface
 
 uses
-  Classes, SysUtils, fphttp, inifiles, httpdefs;
+  Classes, SysUtils, fphttp, iniwebsession, httpdefs;
   
 Type
+  TIniWebSession = iniwebsession.TIniWebSession;
 
-  { TSessionHTTPModule }
-
-  TSessionHTTPModule = Class(TCustomHTTPModule)
-  Private
-    FCreateSession : Boolean;
-    FOnNewSession: TNotifyEvent;
-    FOnSessionExpired: TNotifyEvent;
-    FSession: TCustomSession;
-    function GetSession: TCustomSession;
-    procedure SetSession(const AValue: TCustomSession);
-  Protected
-    Procedure CheckSession(ARequest : TRequest);
-    Procedure InitSession(AResponse : TResponse);
-    Procedure UpdateSession(AResponse : TResponse);
-    Procedure DoneSession; virtual;
-  Public
-    destructor destroy; override;
-    Procedure Notification(AComponent : TComponent;Operation : TOperation); override;
-    Procedure Loaded; Override;
-    Property CreateSession : Boolean Read FCreateSession Write FCreateSession;
-    Property Session : TCustomSession Read GetSession Write SetSession;
-    Property OnNewSession : TNotifyEvent Read FOnNewSession Write FOnNewSession;
-    Property OnSessionExpired : TNotifyEvent Read FOnSessionExpired Write FOnSessionExpired;
-  end;
-  
-  { TIniWebSession }
-
-  TIniWebSession = Class(TCustomSession)
-  Private
-    FSessionStarted : Boolean;
-    FCached: Boolean;
-    FIniFile : TMemInifile;
-    FSessionCookie: String;
-    FSessionCookiePath: String;
-    FSessionDir: String;
-    FTerminated :Boolean;
-    SID : String;
-  private
-    procedure FreeIniFile;
-    function GetSessionDir: String;
-  Protected
-    Procedure CheckSession;
-    Function GetSessionID : String; override;
-    Function GetSessionVariable(VarName : String) : String; override;
-    procedure SetSessionVariable(VarName : String; const AValue: String); override;
-    Property Cached : Boolean Read FCached Write FCached;
-    property SessionCookie : String Read FSessionCookie Write FSessionCookie;
-    Property SessionDir : String Read GetSessionDir Write FSessionDir;
-    Property SessionCookiePath : String Read FSessionCookiePath write FSessionCookiePath;
-  Public
-    Destructor Destroy; override;
-    Procedure Terminate; override;
-    Procedure UpdateResponse(AResponse : TResponse); override;
-    Procedure InitSession(ARequest : TRequest; OnNewSession, OnExpired: TNotifyEvent); override;
-    Procedure InitResponse(AResponse : TResponse); override;
-    Procedure RemoveVariable(VariableName : String); override;
-  end;
-
-  TFPWebSession = Class(TIniWebSession)
+  TFPWebSession = Class(iniwebsession.TIniWebSession)
   Public
     Property Cached;
     property SessionCookie;
@@ -88,44 +31,41 @@ Type
     Property SessionDir;
   end;
 
-  EWebSessionError = Class(HTTPError);
+Type
   TGetSessionEvent = Procedure(Var ASession : TCustomSession) of object;
 
-
 Var
-  GlobalSessionDir : String;
-  OnGetDefaultSession : TGetSessionEvent;
+  GlobalSessionDir : String deprecated;
+  OnGetDefaultSession : TGetSessionEvent deprecated;
 
 Function GetDefaultSession : TCustomSession;
 
 implementation
+type
 
-{$ifdef cgidebug}
-uses dbugintf;
-{$endif}
-
-Const
-  // Sections in ini file
-  SSession   = 'Session';
-  SData      = 'Data';
-
-  KeyStart   = 'Start';         // Start time of session
-  KeyLast    = 'Last';          // Last seen time of session
-  KeyTimeOut = 'Timeout';       // Timeout in seconds;
+  { TWebSessionFactory }
 
-  SFPWebSession = 'FPWebSession'; // Cookie name for session.
+  TWebSessionFactory = Class(TIniSessionFactory)
+  Protected
+    Function DoCreateSession(ARequest : TRequest) : TCustomSession; override;
+  end;
 
-resourcestring
-  SErrSessionTerminated = 'No web session active: Session was terminated';
-  SErrNoSession         = 'No web session active: Session was not started';
 
 Function GetDefaultSession : TCustomSession;
 
+Var
+  TD : String;
+
 begin
 {$ifdef cgidebug}SendMethodEnter('GetDefaultSession');{$endif}
   Result:=Nil;
   If (GlobalSessionDir='') then
-    GlobalSessionDir:=IncludeTrailingPathDelimiter(GetTempDir(True))
+    begin
+    TD:=IncludeTrailingPathDelimiter(GetTempDir(True));
+    GlobalSessionDir:=TD+'fpwebsessions'+PathDelim;
+    if Not ForceDirectories(GlobalSessionDir) then
+      GlobalSessionDir:=TD; // Assuming temp dir is writeable
+    end
   else
     GlobalSessionDir:=IncludeTrailingPathDelimiter(GlobalSessionDir);
 {$ifdef cgidebug}SendDebug('GetDefaultSession, session dir: '+GlobalSessionDir);{$endif}
@@ -134,285 +74,29 @@ begin
   if (Result=Nil) then
     begin
     {$ifdef cgidebug}Senddebug('Creating iniwebsession');{$endif}
-    Result:=TFPWebSession.Create(Nil);
+    if (SessionFactory is TIniSessionFactory) then
+      if ((SessionFactory as TIniSessionFactory).SessionDir='') then
+        (SessionFactory as TIniSessionFactory).SessionDir:=GlobalSessionDir;
+    Result:=SessionFactory.CreateSession(Nil);
     end;
 {$ifdef cgidebug}SendMethodExit('GetDefaultSession');{$endif}
 end;
 
-{ TIniWebSession }
-
-function TIniWebSession.GetSessionID: String;
-begin
-  If (SID='') then
-    SID:=inherited GetSessionID;
-  Result:=SID;
-end;
-
-procedure TIniWebSession.FreeIniFile;
-begin
-  If Cached and Assigned(FIniFile) then
-    TMemIniFile(FIniFile).UpdateFile;
-  FreeAndNil(FIniFile);
-end;
-
-function TIniWebSession.GetSessionDir: String;
-begin
-  Result:=FSessionDir;
-  If (Result='') then
-    Result:=GlobalSessionDir;
-end;
-
-Procedure TIniWebSession.CheckSession;
-
-begin
-  If Not Assigned(FInifile) then
-    if FTerminated then
-      Raise EWebSessionError.Create(SErrSessionTerminated)
-    else
-      Raise EWebSessionError.Create(SErrNoSession)
-
-end;
-
-function TIniWebSession.GetSessionVariable(VarName: String): String;
-begin
-  CheckSession;
-  Result:=FIniFile.ReadString(SData,VarName,'');
-end;
-
-procedure TIniWebSession.SetSessionVariable(VarName: String;
-  const AValue: String);
-begin
-  CheckSession;
-  FIniFile.WriteString(SData,VarName,AValue);
-  If Not Cached then
-    TMemIniFile(FIniFile).UpdateFile;
-end;
-
-destructor TIniWebSession.Destroy;
-begin
-  // In case an exception occured and UpdateResponse is not called,
-  // write the updates to disk and free FIniFile
-  FreeIniFile;
-  inherited Destroy;
-end;
-
-procedure TIniWebSession.Terminate;
-begin
-  FTerminated:=True;
-  If Assigned(FIniFile) Then
-    begin
-    DeleteFile(Finifile.FileName);
-    FreeAndNil(FIniFile);
-    end;
-end;
-
-procedure TIniWebSession.UpdateResponse(AResponse: TResponse);
-begin
-  // Do nothing. Init has done the job.
-  FreeIniFile;
-end;
-
-procedure TIniWebSession.InitSession(ARequest: TRequest; OnNewSession,OnExpired: TNotifyEvent);
-
-Var
-  L,D   : TDateTime;
-  T   : Integer;
-  S : String;
-begin
-{$ifdef cgidebug}SendMethodEnter('TIniWebSession.InitSession');{$endif}
-  // First initialize all session-dependent properties to their default, because
-  // in Apache-modules or fcgi programs the session-instance is re-used
-  SID := '';
-  FSessionStarted := False;
-  FTerminated := False;
-  // If a exception occured during a prior request FIniFile is still not freed
-  if assigned(FIniFile) then FreeIniFile;
-
-  If (SessionCookie='') then
-    SessionCookie:=SFPWebSession;
-  S:=ARequest.CookieFields.Values[SessionCookie];
-  // have session cookie ?
-  If (S<>'') then
-    begin
-{$ifdef cgidebug}SendDebug('Reading ini file:'+S);{$endif}
-    FiniFile:=TMemIniFile.Create(IncludeTrailingPathDelimiter(SessionDir)+S);
-    L:=Finifile.ReadDateTime(SSession,KeyLast,0);
-{$ifdef cgidebug}
-    If (L=0) then
-    SendDebug('No datetime in inifile (or not valid datetime : '+Finifile.ReadString(SSession,KeyLast,''));
-{$endif}
-    T:=FIniFile.ReadInteger(SSession,KeyTimeOut,Self.TimeOutMinutes);
-{$ifdef cgidebug}SendDebug('Timeout :'+IntToStr(t));{$endif}
-{$ifdef cgidebug}SendDebug('Last    :'+FormatDateTime('yyyy/mm/dd hh:nn:ss.zzz',L));{$endif}
-    If ((Now-L)>(T/(24*60))) then
-      begin
-{$ifdef cgidebug}SendDebug('Timeout :'+FloatToStr(T/(24*60)));{$endif}
-{$ifdef cgidebug}SendDebug('Timeout :'+FormatDateTime('hh:nn:ss.zzz',(T/(24*60))));{$endif}
-{$ifdef cgidebug}SendDebug('Diff    :'+FormatDateTime('hh:nn:ss.zzz',Now-L));{$endif}
-{$ifdef cgidebug}SendDebug('Ini file session expired: '+S);{$endif}
-      // Expire session.
-      If Assigned(OnExpired) then
-        OnExpired(Self);
-      DeleteFile(FIniFIle.FileName);
-      FreeAndNil(FInifile);
-      S:='';
-      end
-    else
-      SID:=S;
-    end;
-  If (S='') then
-    begin
-    If Assigned(OnNewSession) then
-      OnNewSession(Self);
-    GetSessionID;
-    S:=IncludeTrailingPathDelimiter(SessionDir)+SessionID;
-{$ifdef cgidebug}SendDebug('Creating new Ini file : '+S);{$endif}
-    FIniFile:=TMemIniFile.Create(S);
-    FIniFile.WriteDateTime(SSession,KeyStart,Now);
-    FIniFile.WriteInteger(SSession,KeyTimeOut,Self.TimeOutMinutes);
-    FSessionStarted:=True;
-    end;
-  FIniFile.WriteDateTime(SSession,KeyLast,Now);
-  If not FCached then
-    FIniFile.UpdateFile;
-{$ifdef cgidebug}SendMethodExit('TIniWebSession.InitSession');{$endif}
-end;
-
-procedure TIniWebSession.InitResponse(AResponse: TResponse);
-
-Var
-  C : TCookie;
-
-begin
-{$ifdef cgidebug}SendMethodEnter('TIniWebSession.InitResponse');{$endif}
-  If FSessionStarted then
-    begin
-{$ifdef cgidebug}SendDebug('Session started');{$endif}
-    C:=AResponse.Cookies.FindCookie(SessionCookie);
-    If (C=Nil) then
-      begin
-      C:=AResponse.Cookies.Add;
-      C.Name:=SessionCookie;
-      end;
-    C.Value:=SID;
-    C.Path:=FSessionCookiePath;
-    end
-  else If FTerminated then
-    begin
-{$ifdef cgidebug}SendDebug('Session terminated');{$endif}
-    C:=AResponse.Cookies.Add;
-    C.Name:=SessionCookie;
-    C.Value:='';
-    end;
-{$ifdef cgidebug}SendMethodExit('TIniWebSession.InitResponse');{$endif}
-end;
-
-procedure TIniWebSession.RemoveVariable(VariableName: String);
-begin
-{$ifdef cgidebug}SendMethodEnter('TIniWebSession.RemoveVariable');{$endif}
-  CheckSession;
-  FIniFile.DeleteKey(SData,VariableName);
-  If Not Cached then
-    TMemIniFile(FIniFile).UpdateFile;
-{$ifdef cgidebug}SendMethodExit('TIniWebSession.RemoveVariable');{$endif}
-end;
-
-
-function TSessionHTTPModule.GetSession: TCustomSession;
-begin
-{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule.GetSession');{$endif}
-  If (csDesigning in ComponentState) then
-    begin
-{$ifdef cgidebug}SendDebug('Sending session');{$endif}
-    Result:=FSession
-    end
-  else
-    begin
-    If (FSession=Nil) then
-      begin
-{$ifdef cgidebug}SendDebug('Getting default session');{$endif}
-      FSession:=GetDefaultSession;
-      FSession.FreeNotification(Self);
-      end;
-    Result:=FSession
-    end;
-{$ifdef cgidebug}SendMethodExit('SessionHTTPModule.GetSession');{$endif}
-end;
-
-procedure TSessionHTTPModule.SetSession(const AValue: TCustomSession);
+{ TWebSessionFactory }
 
+function TWebSessionFactory.DoCreateSession(ARequest: TRequest
+  ): TCustomSession;
 begin
-  if FSession<>AValue then
-    begin
-    If Assigned(FSession) then
-      FSession.RemoveFreeNotification(Self);
-    FSession:=AValue;
-    If Assigned(FSession) then
-      FSession.FreeNotification(Self);
-    end;
-end;
-
-procedure TSessionHTTPModule.CheckSession(ARequest : TRequest);
-
-begin
-{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').CheckSession');{$endif}
-  If CreateSession then
-    begin
-    If (FSession=Nil) then
-      FSession:=GetDefaultSession;
-    if Assigned(FSession) then
-      FSession.InitSession(ARequest,FOnNewSession,FOnSessionExpired);
-    end;
-{$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').CheckSession');{$endif}
-end;
-
-procedure TSessionHTTPModule.InitSession(AResponse: TResponse);
-begin
-{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').InitSession');{$endif}
-  If CreateSession and Assigned(FSession) then
-    FSession.InitResponse(AResponse);
-{$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').InitSession');{$endif}
-end;
-
-procedure TSessionHTTPModule.UpdateSession(AResponse: TResponse);
-begin
-  If CreateSession And Assigned(FSession) then
-    FSession.UpdateResponse(AResponse);
-end;
-
-procedure TSessionHTTPModule.DoneSession;
-begin
-  FreeAndNil(FSession);
-end;
-
-destructor TSessionHTTPModule.destroy;
-begin
-  // Prevent memory leaks.
-  If Assigned(FSession) then
-    DoneSession;
-  inherited destroy;
-end;
-
-procedure TSessionHTTPModule.Notification(AComponent: TComponent;
-  Operation: TOperation);
-begin
-{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule('+Name+').Notification');{$endif}
-  inherited Notification(AComponent, Operation);
-  If (Operation=opRemove) then
-    if (AComponent=FSession) Then
-      FSession:=Nil;
-{$ifdef cgidebug}SendMethodExit('SessionHTTPModule('+Name+').Notification');{$endif}
+  Result:=Nil;
+  if Assigned(OnGetDefaultSession) then
+    OnGetDefaultSession(Result);
+  if Result=Nil then
+  Result:=inherited DoCreateSession(ARequest);
 end;
 
-procedure TSessionHTTPModule.Loaded;
-
-begin
-{$ifdef cgidebug}SendMethodEnter('SessionHTTPModule.Loaded');{$endif}
-  inherited Loaded;
-  If CreateSession And (FSession=Nil) then
-    FSession:=GetDefaultSession;
-{$ifdef cgidebug}SendMethodExit('SessionHTTPModule.Loaded');{$endif}
-end;
 
+initialization
+  IniWebSessionClass:=TFPWebSession;
+  SessionFactoryClass:=TWebSessionFactory;
 end.
 

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

@@ -88,6 +88,17 @@ begin
         end;
       Add('</TABLE><P>');
       end;
+    If (ContentFields.Count>0) then
+      begin
+      Add('<H1>Form post variables: ('+IntToStr(ContentFields.Count)+') </H1>');
+      Add('<TABLE BORDER="1"><TR><TD>Name</TD><TD>Value</TD></TR>');
+      For I:=0 to ContentFields.Count-1 do
+        begin
+        ContentFields.GetNameValue(i,N,V);
+        AddNV(N,V);
+        end;
+      Add('</TABLE><P>');
+      end;
     If Environment then
       begin
       Add('<H1>Environment variables: ('+IntToStr(GetEnvironmentVariableCount)+') </H1>');

packages/fcl-web/src/jsonrpc/fpextdirect.pp

@@ -6,7 +6,7 @@ unit fpextdirect;
 interface
 
 uses
-  Classes, SysUtils, fpjson, fpjsonrpc, webjsonrpc, httpdefs,websession;
+  Classes, SysUtils, fpjson, fpjsonrpc, webjsonrpc, httpdefs;
 
 Const
   DefaultExtDirectOptions = DefaultDispatchOptions + [jdoRequireClass];
@@ -132,6 +132,8 @@ Type
     Property RouterPath;
     Property CreateSession;
     Property NameSpace;
+    Property OnNewSession;
+    Property OnSessionExpired;
   end;
 
 implementation
@@ -447,7 +449,6 @@ begin
     finally
       Res.Free;
     end;
-    AResponse.SendResponse;
     end
   else
     JSONRPCError(SErrInvalidPath);

packages/fcl-web/src/jsonrpc/webjsonrpc.pp

@@ -6,7 +6,7 @@ unit webjsonrpc;
 interface
 
 uses
-  Classes, SysUtils, fpjson, fpjsonrpc, httpdefs, fphttp, jsonparser, websession;
+  Classes, SysUtils, fpjson, fpjsonrpc, httpdefs, fphttp, jsonparser;
 
 Type
 { ---------------------------------------------------------------------

packages/fcl-web/src/webdata/extjsjson.pp

@@ -571,6 +571,7 @@ Var
   I : Integer;
 
 begin
+  Avalue:='';
   Result:=False;
   if CheckData then
     begin

packages/fcl-web/src/webdata/fpwebdata.pp

@@ -5,7 +5,7 @@ unit fpwebdata;
 interface
 
 uses
-  Classes, SysUtils, httpdefs, fphttp, db, websession;
+  Classes, SysUtils, httpdefs, fphttp, db;
 
 
 type
@@ -17,10 +17,12 @@ type
   TWebDataAction = (wdaUnknown,wdaRead,wdaUpdate,wdaInsert,wdaDelete);
 
   { TCustomWebdataInputAdaptor }
+  TTransCodeEvent = Procedure (Sender : TObject; Var S : String);
 
   TCustomWebdataInputAdaptor = class(TComponent)
   private
     FAction: TWebDataAction;
+    FOntransCode: TTransCodeEvent;
     FRequest: TRequest;
     FBatchCount : Integer;
     FRequestPathInfo : String;
@@ -39,6 +41,7 @@ type
     Function GetFieldValue(Const AFieldName : String) : String;
     Property Request : TRequest Read FRequest Write SetRequest;
     Property Action : TWebDataAction Read GetAction Write FAction;
+    Property OnTransCode : TTransCodeEvent Read FOntransCode Write FOnTransCode;
   end;
   TCustomWebdataInputAdaptorClass = Class of TCustomWebdataInputAdaptor;
 
@@ -605,6 +608,8 @@ begin
   Result:=(I<>-1);
   If Result then
     L.GetNameValue(I,N,AValue);
+  If (AValue<>'') and Assigned(FOnTranscode) then
+    FOnTransCode(Self,Avalue);
 end;
 
 function TCustomWebdataInputAdaptor.TryFieldValue(const AFieldName: String;