--- Merging r23210 into '.':

U    packages/fcl-web/src/base/custfcgi.pp
--- Merging r23238 into '.':
U    packages/fcl-web/src/base/custhttpapp.pp
U    packages/fcl-web/src/base/fphttpserver.pp
--- Merging r23245 into '.':
G    packages/fcl-web/src/base/fphttpserver.pp
--- Merging r23327 into '.':
U    packages/fcl-web/src/base/custweb.pp
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r23332 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r23335 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r23340 into '.':
G    packages/fcl-web/src/base/fphttpserver.pp
G    packages/fcl-web/src/base/custhttpapp.pp
--- Merging r23403 into '.':
G    packages/fcl-web/src/base/custfcgi.pp
--- Merging r23502 into '.':
U    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r23503 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r23504 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r23505 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r23506 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r23513 into '.':
U    packages/fcl-json/src/fpjsonrtti.pp
--- Merging r23666 into '.':
U    packages/fcl-web/src/base/httpdefs.pp
--- Merging r23667 into '.':
U    packages/fcl-web/src/base/custcgi.pp
G    packages/fcl-web/src/base/custfcgi.pp
G    packages/fcl-web/src/base/custweb.pp
--- Merging r23668 into '.':
U    packages/fcl-json/src/fpjson.pp
--- Merging r23669 into '.':
G    packages/fcl-json/src/fpjson.pp
--- Merging r23677 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r23699 into '.':
U    packages/fcl-web/examples/webdata/demos.txt
U    packages/fcl-web/examples/helloworld/README.txt
U    packages/fcl-web/examples/echo/README.txt
U    packages/fcl-web/examples/jsonrpc/demo1/wmdemo.pp
U    packages/fcl-web/examples/jsonrpc/demo1/README.txt
U    packages/fcl-web/examples/httpapp/testhttp.pp
U    packages/fcl-web/examples/fptemplate/README.txt
U    packages/fcl-web/examples/session/wmsession.pp
--- Merging r23900 into '.':
U    packages/fcl-web/src/base/fphttp.pp
--- Merging r24223 into '.':
U    packages/fcl-web/src/base/webutil.pp
G    packages/fcl-web/src/base/httpdefs.pp
--- Merging r24347 into '.':
G    packages/fcl-web/src/base/fphttpclient.pp

# revisions: 23210,23238,23245,23327,23332,23335,23340,23403,23502,23503,23504,23505,23506,23513,23666,23667,23668,23669,23677,23699,23900,24223,24347
r23210 | michael | 2012-12-22 18:01:57 +0100 (Sat, 22 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Small improvement to dumprecord
r23238 | michael | 2012-12-28 12:38:46 +0100 (Fri, 28 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custhttpapp.pp
   M /trunk/packages/fcl-web/src/base/fphttpserver.pp

* Better error handling, continue to serve requests (bug ID 22260)
r23245 | michael | 2012-12-28 23:57:46 +0100 (Fri, 28 Dec 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpserver.pp

* No PIPE signal on darwin
r23327 | michael | 2013-01-06 17:29:23 +0100 (Sun, 06 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Better error handling in FastCGI in case writing response fails (bug ID 23564)
r23332 | michael | 2013-01-07 09:26:35 +0100 (Mon, 07 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Better check (see bug #23597)
r23335 | michael | 2013-01-07 11:36:46 +0100 (Mon, 07 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Patch from Luiz Americo to remove redundant test
r23340 | michael | 2013-01-07 16:46:56 +0100 (Mon, 07 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custhttpapp.pp
   M /trunk/packages/fcl-web/src/base/fphttpserver.pp

* Patch from Vladimir Zhirov to add RemoteAddress, RemoteHost, ServerPort fields to content
r23403 | michael | 2013-01-16 11:57:47 +0100 (Wed, 16 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Fixed case where connection is closed gracefully (Bug ID 23386)
r23502 | michael | 2013-01-23 09:48:16 +0100 (Wed, 23 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Speed up HEAD
r23503 | michael | 2013-01-23 09:52:18 +0100 (Wed, 23 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Implemented a HEAD class method
r23504 | michael | 2013-01-23 09:56:26 +0100 (Wed, 23 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Close connection on one-shot operations
r23505 | michael | 2013-01-23 12:19:55 +0100 (Wed, 23 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Updated TODO: Easy Post is already there.
r23506 | michael | 2013-01-23 14:03:32 +0100 (Wed, 23 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Patch from Silvio Clecio to implement easy-access methods
r23513 | michael | 2013-01-24 19:01:09 +0100 (Thu, 24 Jan 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjsonrtti.pp

* Added case-insentitive property
r23666 | michael | 2013-02-28 12:20:49 +0100 (Thu, 28 Feb 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/httpdefs.pp

* Handle all methods
r23667 | michael | 2013-02-28 12:21:16 +0100 (Thu, 28 Feb 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/custcgi.pp
   M /trunk/packages/fcl-web/src/base/custfcgi.pp
   M /trunk/packages/fcl-web/src/base/custweb.pp

* Handle HTTP_AUTHORIZATION
r23668 | michael | 2013-02-28 15:41:14 +0100 (Thu, 28 Feb 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Remove erroneous space in front of float number
r23669 | michael | 2013-02-28 17:29:17 +0100 (Thu, 28 Feb 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Removed erroneously committed compacting code
r23677 | michael | 2013-03-01 15:40:19 +0100 (Fri, 01 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Patch from Silvio Clecio to fix filename in FileFormPost
r23699 | michael | 2013-03-06 09:34:20 +0100 (Wed, 06 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/examples/echo/README.txt
   M /trunk/packages/fcl-web/examples/fptemplate/README.txt
   M /trunk/packages/fcl-web/examples/helloworld/README.txt
   M /trunk/packages/fcl-web/examples/httpapp/testhttp.pp
   M /trunk/packages/fcl-web/examples/jsonrpc/demo1/README.txt
   M /trunk/packages/fcl-web/examples/jsonrpc/demo1/wmdemo.pp
   M /trunk/packages/fcl-web/examples/session/wmsession.pp
   M /trunk/packages/fcl-web/examples/webdata/demos.txt

* Fixes for typos from Reinier Olislagers (bug 23895)
r23900 | michael | 2013-03-17 18:09:08 +0100 (Sun, 17 Mar 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttp.pp

* Some optimizations from Luiz Americo, bug ID #23678
r24223 | michael | 2013-04-11 11:50:31 +0200 (Thu, 11 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/httpdefs.pp
   M /trunk/packages/fcl-web/src/base/webutil.pp

* Better and more configurable multipart-formdata handling.
r24347 | michael | 2013-04-27 21:01:49 +0200 (Sat, 27 Apr 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

** Fix for mem leak in case of cookies (By Michalis Kamburelis, bug ID #24333)

git-svn-id: branches/fixes_2_6@24544 -

packages/fcl-json/src/fpjson.pp

@@ -946,6 +946,9 @@ end;
 function TJSONFloatNumber.GetAsString: TJSONStringType;
 begin
   Str(FValue,Result);
+  // Str produces a ' ' in front where the - can go.
+  if (Result<>'') and (Result[1]=' ') then
+    Delete(Result,1,1);
 end;
 
 procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);

packages/fcl-json/src/fpjsonrtti.pp

@@ -107,6 +107,7 @@ Type
     FOnGetObject: TJSONGetObjectEvent;
     FOnPropError: TJSONpropertyErrorEvent;
     FOnRestoreProp: TJSONRestorePropertyEvent;
+    FCaseInsensitive : Boolean;
     procedure DeStreamClassProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData);
   protected
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
@@ -139,6 +140,8 @@ Type
     // Called when a object-typed property must be restored, and the property is Nil. Must return an instance for the property.
     // Published Properties of the instance will be further restored with available data.
     Property OngetObject : TJSONGetObjectEvent Read FOnGetObject Write FOnGetObject;
+    // JSON is by definition case sensitive. Should properties be looked up case-insentive ?
+    Property CaseInsensitive : Boolean Read FCaseInsensitive Write FCaseInsensitive;
   end;
 
   EJSONRTTI = Class(Exception);
@@ -447,7 +450,7 @@ begin
     try
       For I:=0 to PIL.Count-1 do
         begin
-        J:=JSON.IndexOfName(Pil.Items[i]^.Name);
+        J:=JSON.IndexOfName(Pil.Items[i]^.Name,FCaseInsensitive);
         If (J<>-1) then
           RestoreProperty(AObject,PIL.Items[i],JSON.Items[J]);
         end;

packages/fcl-web/examples/echo/README.txt

@@ -1,9 +1,9 @@
-Responds with the calling and system parameters, example
-================================================
-Demonstrates how to create a basic fpweb application. It responds to a request 
-with a list of received/sent parameters, server settings and variables.
+Example that responds with the calling and system parameters
+============================================================
+This demonstrates how to create a basic fpweb application. It responds to a 
+request with a list of received/sent parameters, server settings and variables.
 
-Note, that other than the main project file (echo.lpr) there is not much that 
+Note: apart from the main project file (echo.lpr), there is not much that 
 needs to change with using fpweb, no matter if we create CGI/FCGI applications 
 or Apache modules. The web server config is different for each, of course.
 
@@ -25,7 +25,7 @@ in the cgi/fcgi/apache directories.
 
 1.a; with FPC
 -------------
-Enter to the directory (cgi/fcgi/apache) that has the .lpr file you wish to 
+Go to the directory (cgi/fcgi/apache) that has the .lpr file you wish to 
 compile, and then execute the command 
 
 fpc -Fu../webmodule echo.lpr
@@ -35,8 +35,9 @@ three web applications share the same web module code.
 
 1.b; with Lazarus
 -----------------
-It needs the WebLaz Package installed. Open the .lpi file from the choosen 
-application directory (cgi/fcgi/apache), and then 
+The example needs the WebLaz Package installed. 
+If that is done, open the .lpi file from the choosen application directory 
+(cgi/fcgi/apache), and then 
 
 Run -> Build from the menu.
 
@@ -48,7 +49,7 @@ Run -> Build from the menu.
 -----------
 http://<WebServer>/cgi-bin/<CGIExecutableName>/ should start the example if 
 everything is set up properly.
-ex: http://127.0.0.1:8080/cgi-bin/echo.exe/
+example: http://127.0.0.1:8080/cgi-bin/echo.exe/
 
 Note: You need to change the CGI application name if needed (for example, on 
 Linux it is not echo.exe).
@@ -62,7 +63,7 @@ http://<WebServer>/<ApacheLocationName>/ should start the example if
 everything is set up properly.
 ex: http://127.0.0.1:8080/myapache/
 
-if in the Apache configuration file (ex: httpd.conf) it was set up as:
+An example for the needed Apache configuration file (example: httpd.conf) snippet:
 
 LoadModule mod_echo "<path_to_mod>/echo.dll"
 <Location /myapache>
@@ -76,9 +77,9 @@ the module can be libecho.so or just simply libecho and not echo.dll .
 
 Note: If you recompile an Apache module while the module itself is loaded into
 the Apache server, the compilation will fail, because the file is in use 
-(Apache modules stay in the memory). So first, you always need to stop the 
-Apache server before you recompile or before you copy over the new version of 
-the created module.
+(Apache modules stay in memory). 
+So first, you always need to stop the Apache server before you recompile 
+or before you copy over the new version of the created module.
 
 
 2.c; as FCGI
@@ -86,7 +87,8 @@ the created module.
 http://<WebServer>/<ApacheScriptAliasName>/ should start the example if 
 everything is set up properly.
 ex: http://127.0.0.1:8080/myfcgi/
-if in the Apache configuration file (ex: httpd.conf) it was set up as:
+
+An example for the needed Apache configuration file (example: httpd.conf) snippet:
 
 LoadModule fastcgi_module "<path_to_mod>/mod_fastcgi-2.4.6-AP22.dll"
 <IfModule mod_fastcgi.c>
@@ -102,7 +104,7 @@ LoadModule fastcgi_module "<path_to_mod>/mod_fastcgi-2.4.6-AP22.dll"
 </IfModule>
 
 Note: You need to change the module name if needed. For example on Linux, 
-the module is not mod_fastcgi-2.4.6-AP22.dll but mod_fastcgi.so (need to be 
+the module is not mod_fastcgi-2.4.6-AP22.dll but mod_fastcgi.so (needs to be 
 compiled from sources found at http://www.fastcgi.com/dist/ ).
 The port (2015 in this example) must match the one set in the project main 
 file (echo.lpr).

packages/fcl-web/examples/fptemplate/README.txt

@@ -1,13 +1,14 @@
 FPTemplate examples
 ===================
-These examples are demonstrating some uses of templates (with FPTemplate) when 
+These examples demonstrate some uses of templates (with FPTemplate) when 
 generating HTML pages by CGI/FCGI programs or Apache modules.
 
-The main idea is to leave the web page designing and look&feel to the web page 
+The main idea is to leave the web page design and look&feel to the web page 
 designers. Separating the web page design from the back-end CGI/FCGI/Apache 
 application makes it possible to design, change or redesign a whole website 
 without modifying a single line of code in the CGI/FCGI/Apache application. 
-Back-end programmers and web page designers can work parallel easily, and 
+
+Back-end programmers and web page designers can easily work parallel, and 
 neither side needs extensive knowledge of the other (does not hurt, just not 
 necessary most of the time). 
 
@@ -24,7 +25,7 @@ CGI/FCGI/Apache application when generating the response page -> {TagName1}
 See README.txt
 
 2. /tagparam/*.*
-Demonstrating the set up and use of template tag parameter(s) 
+Demonstrates the set up and use of template tag parameter(s) 
 -> {+DATETIME [-FORMAT=MM/DD hh:mm:ss-]+}
 
 3. /listrecords/*.*
@@ -34,7 +35,7 @@ See README.txt
 
 4. /fileupload/*.*
 Demonstrates uploading file(s) to a web server with the help of a CGI/FCGI 
-program or Apache module by using so called "multipart" html forms.
+program or Apache module by using so called "multipart" HTML forms.
 See README.txt
                                 
 5. /sessions/*.*

packages/fcl-web/examples/helloworld/README.txt

@@ -1,9 +1,9 @@
-Hello world, example
-============
+Hello world example
+===================
 The simplest "Hello World" example using fcl-web (fpweb) that uses a web action 
 called "func1call" in the web module to generate the response page.
 
-Note, that the only difference between CGI/FCGI and Apache module is in the 
+Note that the only difference between CGI/FCGI and Apache module is in the 
 main project .lpr file and the web server (Apache) configuration.
 
 =====================
@@ -24,7 +24,7 @@ in the cgi/fcgi/apache directories.
 
 1.a; with FPC
 -------------
-Enter to the directory (cgi/fcgi/apache) that has the .lpr file you wish to 
+Go to the directory (cgi/fcgi/apache) that has the .lpr file you wish to 
 compile, and then execute the command 
 
 fpc -Fu../webmodule helloworld.lpr
@@ -60,7 +60,7 @@ the :8080 part from the calling URL.
 http://<WebServer>/<ApacheLocationName>/func1call should start the 
 example if everything is set up properly.
 ex: http://127.0.0.1:8080/myapache/func1call
-if in httpd.conf it was set up as:
+Example Apache configuration file (e.g. httpd.conf) snippet for this:
 LoadModule mod_helloworld "<path_to_mod>/helloworld.dll"
 <Location /myapache>
     SetHandler mod_helloworld
@@ -85,7 +85,7 @@ On Linux, it is enough to simply reload Apache after recompile.
 http://<WebServer>/<ApacheScriptAliasName>/func1call should start the example 
 if everything is set up properly.
 ex: http://127.0.0.1:8080/myfcgi/func1call
-if in the Apache configuration file (ex: httpd.conf) it was set up as:
+Example Apache configuration file (e.g. httpd.conf) snippet for this:
 
 LoadModule fastcgi_module "<path_to_mod>/mod_fastcgi-2.4.6-AP22.dll"
 <IfModule mod_fastcgi.c>

packages/fcl-web/examples/httpapp/testhttp.pp

@@ -11,7 +11,7 @@ begin
   Writeln('Usage : testhttp DocumentRoot [Port]');
   Writeln('Where');
   Writeln(' Documentroot   location to serve files from. It is mapped to location /files');
-  Writeln(' Port            port to listen on (default 8080)');
+  Writeln(' Port           port to listen on (default 8080)');
   Halt(1);
 end;
 

packages/fcl-web/examples/jsonrpc/demo1/README.txt

@@ -1,21 +1,21 @@
 
 This is an example of how to use JSON-RPC.
 
-It requires lazarus to compile.
+It requires Lazarus to compile.
 
 The various *.in files are input for JSON-RPC requests.
 
-The application can be tested as follows from the command-line
+The application can be tested as follows from the command line:
 
 testcgiapp -i demo -p echo/manual < echo.in
 testcgiapp -i demo -p echo/dispatch < echobatch.in
 testcgiapp -i demo -p echo/registered < echobatch.in
 testcgiapp -i demo -p echo/extdirect < extdirect.in
-testcgiapp -i demo -p echo/dispatch <notification.in
+testcgiapp -i demo -p echo/dispatch < notification.in
 testcgiapp -i demo -p echo/extdirectapi
-testcgiapp -i demo -p echo/content <echobatch.in
-testcgiapp -i demo -p echo/module <echobatch.in    
+testcgiapp -i demo -p echo/content < echobatch.in
+testcgiapp -i demo -p echo/module < echobatch.in    
 
 The response is printed on standard output.
 
-the testcgiapp application is located in fcl-web/tests
+The testcgiapp application is located in fcl-web/tests

packages/fcl-web/examples/jsonrpc/demo1/wmdemo.pp

@@ -12,7 +12,6 @@ type
   { TFPWebModule1 }
 
   TFPWebModule1 = class(TFPWebModule)
-    procedure DataModuleCreate(Sender: TObject);
     procedure TFPWebActions0Request(Sender: TObject; ARequest: TRequest;
       AResponse: TResponse; var Handled: Boolean);
     procedure TFPWebActions1Request(Sender: TObject; ARequest: TRequest;
@@ -44,10 +43,6 @@ Uses fpjson,jsonparser,fpjsonrpc,webjsonrpc, fpextdirect;
 
 { TFPWebModule1 }
 
-procedure TFPWebModule1.DataModuleCreate(Sender: TObject);
-begin
-end;
-
 procedure TFPWebModule1.TFPWebActions0Request(Sender: TObject;
   ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
 {
@@ -128,7 +123,7 @@ procedure TFPWebModule1.TFPWebActions1Request(Sender: TObject;
 {
   Demo 2. Use a dispatcher to dispatch the requests.
   The handler is located on the owner module
-  (it is created run-time, though)
+  (it is created run-time, though).
 }
 
 Var
@@ -181,9 +176,9 @@ end;
 procedure TFPWebModule1.TFPWebActions2Request(Sender: TObject;
   ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
 {
-  Demo 3. Use a dispatcher to dispatch the requests,
-  The handler is registered in the JSONFPCHandlerManager.
-  (it is created run-time, though)
+  Demo 3. Use a dispatcher to dispatch the requests.
+  The handler is registered in the JSONFPCHandlerManager
+  (it is created run-time, though).
 }
 
 Var
@@ -235,8 +230,8 @@ procedure TFPWebModule1.TFPWebActions3Request(Sender: TObject;
 
 {
   Demo 4. Ext.Direct dispatcher
-  The handler is registered in the JSONFPCHandlerManager.
-  (it is created run-time, though)
+  The handler is registered in the JSONFPCHandlerManager
+  (it is created run-time, though).
 }
 
 Var
@@ -289,8 +284,8 @@ procedure TFPWebModule1.TFPWebActions4Request(Sender: TObject;
 
 {
   Demo 5. Using a TJSONRPCContentProducer.
-  The handler is registered in the JSONFPCHandlerManager.
-  (it is created run-time, though)
+  The handler is registered in the JSONFPCHandlerManager
+  (it is created run-time, though).
 }
 
 Var
@@ -325,9 +320,9 @@ end;
 procedure TFPWebModule1.TFPWebActions5Request(Sender: TObject;
   ARequest: TRequest; AResponse: TResponse; var Handled: Boolean);
 {
-  Demo 6. creating an API response for Ext.Direct
-  The handler is registered in the JSONFPCHandlerManager.
-  (it is created run-time, though)
+  Demo 6. Creating an API response for Ext.Direct
+  The handler is registered in the JSONFPCHandlerManager
+  (it is created run-time, though).
 }
 
 Var
@@ -356,7 +351,7 @@ procedure TFPWebModule1.TFPWebActions6Request(Sender: TObject;
 {
   Demo 6. Using a TJSONRPCModule instance to handle the request.
   The handler is registered in the JSONFPCHandlerManager.
-  (it is created run-time, though)
+  (it is created run-time, though).
 }
 
 Var

packages/fcl-web/examples/session/wmsession.pp

@@ -49,7 +49,7 @@ end;
 {
   When a new session is detected
 
-  - either because there was no session,in which case NewSession is the default
+  - either because there was no session, in which case NewSession is the default
 
   - The URL contained the newsession action in the 'DemoSession' action variable,
     something like:
@@ -93,7 +93,7 @@ end;
   that is currently stored in the session object.
 
   If the user supplied a new value for 'var', we store it in the session.
-  to supply the value, append
+  To supply this value, append
   ?var=value
   to the URL.
 }

packages/fcl-web/examples/webdata/demos.txt

@@ -1,7 +1,7 @@
 
 The demo directories demonstrate the use of the TFPWebDataProvider
 components, using ExtJS. It demonstrates the use of JSON and XML
-communitation between a ExtJS Datastore and the webdataprovider.
+communication between an ExtJS Datastore and the webdataprovider.
 
 ExtJS must be installed, it can be downloaded for free from
 http://www.extjs.com/

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

@@ -155,7 +155,8 @@ Const
     { 33: 'REMOTE_PORT'            } '',
     { 34: 'REQUEST_URI'            } '',
     { 35: 'CONTENT'                } '',
-    { 36: 'XHTTPREQUESTEDWITH'     } ''
+    { 36: 'XHTTPREQUESTEDWITH'     } '',
+    { 37: 'XHTTPREQUESTEDWITH'     } FieldAuthorization
   );
 
 Procedure TCgiHandler.GetCGIVarList(List : TStrings);

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

@@ -50,7 +50,7 @@ Type
 
   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;
+  TFastCGIWriteEvent = Function (AHandle : THandle; Const ABuf; ACount : Integer; Out ExtendedErrorCode : Integer) : Integer of Object;
 
   TFCGIRequest = Class(TCGIRequest)
   Private
@@ -110,7 +110,6 @@ Type
     FAddress: string;
     FTimeOut,
     FPort: integer;
-
 {$ifdef windowspipe}
     FIsWinPipe: Boolean;
 {$endif}
@@ -127,7 +126,7 @@ Type
     function CreateRequest : TFCGIRequest; virtual;
     function CreateResponse(ARequest: TFCGIRequest) : TFCGIResponse; virtual;
     Function DoFastCGIRead(AHandle : THandle; Var ABuf; ACount : Integer) : Integer; virtual;
-    Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer) : Integer; virtual;
+    Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer; Out ExtendedErrorCode : 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;
@@ -175,7 +174,8 @@ ResourceString
   SErrReadingSocket = 'Failed to read data from socket. Error: %d';
   SErrReadingHeader = 'Failed to read FastCGI header. Read only %d bytes';
   SErrWritingSocket = 'Failed to write data to socket. Error: %d';
-
+  SErrNoRequest     = 'Internal error: No request available when writing data';
+  
 Implementation
 
 {$ifdef CGIDEBUG}
@@ -384,7 +384,8 @@ const HttpToCGI : THttpToCGI =
       7,  // 33 'QUERY_STRING'
      27,  // 34 'HTTP_HOST'
       0,  // 35 'CONTENT'
-     36   // 36 'XHTTPREQUESTEDWITH'
+     36,  // 36 'XHTTPREQUESTEDWITH'
+     37   // 37 'HTTP_AUTHORIZATION'
     );
 
 var ACgiVarNr : Integer;
@@ -395,8 +396,12 @@ begin
     begin
     ACgiVarNr:=HttpToCGI[Index];
     if ACgiVarNr>0 then
-      Result:=FCGIParams.Values[CgiVarNames[ACgiVarNr]]
-    else
+      begin
+        Result:=FCGIParams.Values[CgiVarNames[ACgiVarNr]];
+        if (ACgiVarNr = 5) and                                          //PATH_INFO
+           (length(Result)>=2)and(word(Pointer(@Result[1])^)=$2F2F)then //mod_proxy_fcgi gives double slashes at the beginning for some reason
+          Delete(Result, 1, 1);                                         //Remove the extra first one
+      end else
       Result := '';
     end
   else
@@ -406,18 +411,25 @@ end;
 { TCGIResponse }
 procedure TFCGIResponse.Write_FCGIRecord(ARecord : PFCGI_Header);
 
-var BytesToWrite : Integer;
+var ErrorCode,
+    BytesToWrite ,
     BytesWritten  : Integer;
     P : PByte;
+    r : TFCGIRequest;
+    
 begin
+  if Not (Request is TFCGIRequest) then
+    Raise Exception.Create(SErrNorequest);
+  R:=TFCGIRequest(Request);
   BytesToWrite := BEtoN(ARecord^.contentLength) + ARecord^.paddingLength+sizeof(FCGI_Header);
   P:=PByte(Arecord);
   Repeat
-    BytesWritten:=FOnWrite(TFCGIRequest(Request).Handle, P^, BytesToWrite);
+    BytesWritten:=FOnWrite(R.Handle, P^, BytesToWrite,ErrorCode);
     If (BytesWritten<0) then
       begin
-      // TODO : Better checking for closed connection, EINTR
-      Raise HTTPError.CreateFmt(SErrWritingSocket,[BytesWritten]);
+      // TODO : Better checking on ErrorCode
+      R.FKeepConnectionAfterRequest:=False;
+      Raise HTTPError.CreateFmt(SErrWritingSocket,[ErrorCode]);
       end;
     Inc(P,BytesWritten);
     Dec(BytesToWrite,BytesWritten);
@@ -629,23 +641,30 @@ function TFCgiHandler.Read_FCGIRecord : PFCGI_Header;
   Procedure DumpFCGIRecord (Var Header :FCGI_Header; ContentLength : word; PaddingLength : byte; ResRecord : Pointer);
 
   Var
-    s : string;
+    S, s1, s2 : string;
     I : Integer;
 
   begin
-      Writeln('Dumping record ', Sizeof(Header),',',Contentlength,',',PaddingLength);
+      Writeln(Format('Dumping record, Sizeof(Header)=%d, ContentLength=%d, PaddingLength=%d',[SizeOf(Header),ContentLength,PaddingLength]));
+      S:=''; s1 := '';
       For I:=0 to Sizeof(Header)+ContentLength+PaddingLength-1 do
+      begin
+        s2 := Format('%:2X ',[PByte(ResRecord)[i]]);
+        if s2[1] = ' ' then s2[1] := '0';
+        s1 := s1 + s2;
+        If PByte(ResRecord)[i]>32 then
+          S:=S+char(PByte(ResRecord)[i])
+        else
+          S:=S+' ';
+        if (I>0) and (((I+1) mod 16) = 0) then
         begin
-        Write(Format('%:3d ',[PByte(ResRecord)[i]]));
-        If PByte(ResRecord)[i]>30 then
-          S:=S+char(PByte(ResRecord)[i]);
-        if (I mod 16) = 0 then
-           begin
-           writeln('  ',S);
-           S:='';
-           end;
+           Writeln(s1 + '  ' + S);
+           S:=''; s1 := '';
         end;
-      Writeln('  ',S)
+      end;
+      if length(s1)<48 then
+        repeat s1 := s1 + ' ' until length(s1)>=48;
+      Writeln(s1 + '  '+S)
   end;
 {$ENDIF DUMPRECORD}
 
@@ -824,14 +843,26 @@ begin
 end;
 
 function TFCgiHandler.DoFastCGIWrite(AHandle: THandle; const ABuf;
-  ACount: Integer): Integer;
+  ACount: Integer; Out ExtendedErrorCode : Integer): Integer;
 begin
   {$ifdef windowspipe}
   if FIsWinPipe then
-    Result := FileWrite(AHandle, ABuf, ACount)
+    begin
+    ExtendedErrorCode:=0;
+    Result := FileWrite(AHandle, ABuf, ACount);
+    if (Result<0) then
+      ExtendedErrorCode:=GetLastOSError;
+    end
   else
   {$endif windows}
-    Result := sockets.fpsend(AHandle, @ABuf, ACount, NoSignalAttr);
+    begin
+    Repeat
+      ExtendedErrorCode:=0;
+      Result:=sockets.fpsend(AHandle, @ABuf, ACount, NoSignalAttr);
+      if (Result<0) then
+        ExtendedErrorCode:=sockets.socketerror;
+    until (Result>=0) {$ifdef unix} or (ExtendedErrorCode<>ESysEINTR);{$endif}
+    end;
 end;
 
 function TFCgiHandler.ProcessRecord(AFCGI_Record  : PFCGI_Header; out ARequest: TRequest; out AResponse: TResponse): boolean;
@@ -932,32 +963,37 @@ begin
       SetupSocket(FIAddress,FAddressLength)
     else
       Socket:=StdInputHandle;
-  if FHandle=THandle(-1) then
-    FHandle:=AcceptConnection;
-  if FHandle=THandle(-1) then
-    begin
-    if not terminated then
-      begin
-      Terminate;
-      raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
-      end
-    end;
-  repeat
-    If (poUseSelect in ProtocolOptions) then
+  Repeat
+    if FHandle=THandle(-1) then
+      FHandle:=AcceptConnection;
+    if FHandle=THandle(-1) then
       begin
-      While Not DataAvailable do
-        If (OnIdle<>Nil) then
-          OnIdle(Self);
+      if not terminated then
+        begin
+        Terminate;
+        raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
+        end
       end;
-    AFCGI_Record:=Read_FCGIRecord;
-    if assigned(AFCGI_Record) then
-    try
-      Result:=ProcessRecord(AFCGI_Record,ARequest,AResponse);
-    Finally
-      FreeMem(AFCGI_Record);
-      AFCGI_Record:=Nil;
-    end;
-  until Result;
+    repeat
+      If (poUseSelect in ProtocolOptions) then
+        begin
+        While Not DataAvailable do
+          If (OnIdle<>Nil) then
+            OnIdle(Self);
+        end;
+      AFCGI_Record:=Read_FCGIRecord;
+      // If connection closed gracefully, we have nil.
+      if Not Assigned(AFCGI_Record) then
+        CloseConnection
+      else
+        try
+        Result:=ProcessRecord(AFCGI_Record,ARequest,AResponse);
+        Finally
+          FreeMem(AFCGI_Record);
+          AFCGI_Record:=Nil;
+        end;
+    until Result or (FHandle=THandle(-1));
+  Until Result;
 end;
 
 { TCustomFCgiApplication }

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

@@ -48,6 +48,7 @@ Type
       var ARequest: TFPHTTPConnectionRequest;
       var AResponse: TFPHTTPConnectionResponse);
   Private
+    FOnRequestError: TRequestErrorHandler;
     FServer: TEmbeddedHTTPServer;
     function GetAllowConnect: TConnectQuery;
     function GetPort: Word;
@@ -57,7 +58,10 @@ Type
     procedure SetPort(const AValue: Word);
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
+    function GetLookupHostNames : Boolean;
+    Procedure SetLookupHostnames(Avalue : Boolean);
   protected
+    procedure HandleRequestError(Sender: TObject; E: Exception); virtual;
     Procedure InitRequest(ARequest : TRequest); override;
     Procedure InitResponse(AResponse : TResponse); override;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
@@ -75,12 +79,18 @@ Type
     Property OnAllowConnect : TConnectQuery Read GetAllowConnect Write SetOnAllowConnect;
     // Use a thread to handle a connection ?
     property Threaded : Boolean read GetThreaded Write SetThreaded;
+    // Handle On Request error. If not set, error is logged.
+    Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
+    // Should addresses be matched to hostnames ? (expensive)
+    Property LookupHostNames : Boolean Read GetLookupHostNames Write SetLookupHostNames;
   end;
 
   { TCustomHTTPApplication }
 
   TCustomHTTPApplication = Class(TCustomWebApplication)
   private
+    function GetLookupHostNames : Boolean;
+    Procedure SetLookupHostnames(Avalue : Boolean);
     function GetAllowConnect: TConnectQuery;
     function GetPort: Word;
     function GetQueueSize: Word;
@@ -100,16 +110,10 @@ Type
     Property OnAllowConnect : TConnectQuery Read GetAllowConnect Write SetOnAllowConnect;
     // Use a thread to handle a connection ?
     property Threaded : Boolean read GetThreaded Write SetThreaded;
+    // Should addresses be matched to hostnames ? (expensive)
+    Property LookupHostNames : Boolean Read GetLookupHostNames Write SetLookupHostNames;
   end;
 
-ResourceString
-  SNoInputHandle    = 'Failed to open input-handle passed from server. Socket Error: %d';
-  SNoSocket         = 'Failed to open socket. Socket Error: %d';
-  SBindFailed       = 'Failed to bind to port %d. Socket Error: %d';
-  SListenFailed     = 'Failed to listen to port %d. Socket Error: %d';
-  SErrReadingSocket = 'Failed to read data from socket. Error: %d';
-  SErrReadingHeader = 'Failed to read FastCGI header. Read only %d bytes';
-  SErrWritingSocket = 'Failed to write data to socket. Error: %d';
 
 Implementation
 
@@ -133,6 +137,18 @@ uses
 
 { TCustomHTTPApplication }
 
+function TCustomHTTPApplication.GetLookupHostNames : Boolean;
+
+begin
+  Result:=HTTPHandler.LookupHostNames;
+end;
+
+Procedure TCustomHTTPApplication.SetLookupHostnames(Avalue : Boolean);
+
+begin
+  HTTPHandler.LookupHostNames:=AValue;
+end;
+
 function TCustomHTTPApplication.GetAllowConnect: TConnectQuery;
 begin
   Result:=HTTPHandler.OnAllowConnect;
@@ -185,6 +201,19 @@ end;
 
 { TFPHTTPServerHandler }
 
+procedure TFPHTTPServerHandler.HandleRequestError(Sender: TObject; E: Exception
+  );
+begin
+  Try
+    If Assigned(FOnRequestError) then
+      FOnRequestError(Sender,E)
+    else
+      Log(etError,Format('Error (%s) handling request : %s',[E.ClassName,E.Message]));
+  except
+    // Do not let errors escape
+  end;
+end;
+
 procedure TFPHTTPServerHandler.HTTPHandleRequest(Sender: TObject;
   var ARequest: TFPHTTPConnectionRequest;
   var AResponse: TFPHTTPConnectionResponse);
@@ -199,6 +228,18 @@ begin
     OnIdle(Self);
 end;
 
+function TFPHTTPServerHandler.GetLookupHostNames : Boolean;
+
+begin
+  Result:=FServer.LookupHostNames;
+end;
+
+Procedure TFPHTTPServerHandler.SetLookupHostnames(Avalue : Boolean);
+
+begin
+  FServer.LookupHostNames:=AValue;
+end;
+
 function TFPHTTPServerHandler.GetAllowConnect: TConnectQuery;
 begin
   Result:=FServer.OnAllowConnect;
@@ -273,6 +314,7 @@ begin
   FServer:=CreateServer;
   FServer.FWebHandler:=Self;
   FServer.OnRequest:=@HTTPHandleRequest;
+  Fserver.OnRequestError:=@HandleRequestError;
 end;
 
 destructor TFPHTTPServerHandler.Destroy;

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

@@ -24,7 +24,7 @@ uses
   CustApp,Classes,SysUtils, httpdefs, fphttp, eventlog;
 
 Const
-  CGIVarCount = 36;
+  CGIVarCount = 37;
 
 Type
   TCGIVarArray = Array[1..CGIVarCount] of String;
@@ -55,6 +55,7 @@ Const
     { 22 } 'HTTP_REFERER',
     { 23 } 'HTTP_USER_AGENT',
     { 24 } 'HTTP_COOKIE',
+
      // Additional Apache vars
     { 25 } 'HTTP_CONNECTION',
     { 26 } 'HTTP_ACCEPT_LANGUAGE',
@@ -67,7 +68,8 @@ Const
     { 33 } 'REMOTE_PORT',
     { 34 } 'REQUEST_URI',
     { 35 } 'CONTENT',
-    { 36 } 'HTTP_X_REQUESTED_WITH'
+    { 36 } 'HTTP_X_REQUESTED_WITH',
+    { 37 } 'HTTP_AUTHORIZATION'
     );
 
 Type
@@ -216,6 +218,7 @@ uses
 resourcestring
   SErrNoModuleNameForRequest = 'Could not determine HTTP module name for request';
   SErrNoModuleForRequest = 'Could not determine HTTP module for request "%s"';
+  SErrSendingContent = 'An error (%s) happened while sending response content: %s';
   SModuleError = 'Module Error';
   SAppEncounteredError = 'The application encountered the following error:';
   SError = 'Error: ';
@@ -467,10 +470,18 @@ end;
 
 procedure TWebHandler.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
 begin
-  HandleRequest(ARequest,AResponse);
-  If Not AResponse.ContentSent then
-    AResponse.SendContent;
-  EndRequest(ARequest,AResponse);
+  Try
+    HandleRequest(ARequest,AResponse);
+    If Not AResponse.ContentSent then
+      try
+        AResponse.SendContent;
+      except
+        On E : Exception do
+          Log(etError,Format(SErrSendingContent,[E.ClassName,E.Message]));
+      end;
+  Finally
+    EndRequest(ARequest,AResponse);
+  end;
 end;
 
 constructor TWebHandler.Create(AOwner:TComponent);

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

@@ -94,9 +94,9 @@ Type
     constructor Create(AItemClass: TCollectionItemClass);
     Procedure Assign(Source : TPersistent); override;
     Function Add : TCustomWebAction;
-    Function ActionByName(AName : String) : TCustomWebAction;
-    Function FindAction(AName : String): TCustomWebAction;
-    Function IndexOfAction(AName : String) : Integer;
+    Function ActionByName(const AName : String) : TCustomWebAction;
+    Function FindAction(const AName : String): TCustomWebAction;
+    Function IndexOfAction(const AName : String) : Integer;
     Property OnGetAction : TGetActionEvent Read FOnGetAction Write FOnGetAction;
     Property Actions[Index : Integer] : TCustomWebAction Read GetActions Write SetActions; Default;
     Property DefActionWhenUnknown : Boolean read FDefActionWhenUnknown write FDefActionWhenUnknown;
@@ -201,9 +201,9 @@ Type
     function GetModule(Index : Integer): TModuleItem;
     procedure SetModule(Index : Integer; const AValue: TModuleItem);
   Public
-    Function FindModule(AModuleName : String) : TModuleItem;
-    Function ModuleByName(AModuleName : String) : TModuleItem;
-    Function IndexOfModule(AModuleName : String) : Integer;
+    Function FindModule(const AModuleName : String) : TModuleItem;
+    Function ModuleByName(const AModuleName : String) : TModuleItem;
+    Function IndexOfModule(const AModuleName : String) : Integer;
     Property Modules [Index : Integer]: TModuleItem Read GetModule Write SetModule;default;
   end;
 
@@ -299,7 +299,7 @@ begin
   Items[Index]:=AValue;
 end;
 
-function TModuleFactory.FindModule(AModuleName: String): TModuleItem;
+function TModuleFactory.FindModule(const AModuleName: String): TModuleItem;
 
 Var
   I : Integer;
@@ -312,14 +312,14 @@ begin
     Result:=GetModule(I);
 end;
 
-function TModuleFactory.ModuleByName(AModuleName: String): TModuleItem;
+function TModuleFactory.ModuleByName(const AModuleName: String): TModuleItem;
 begin
   Result:=FindModule(AModuleName);
   If (Result=Nil) then
     Raise EFPHTTPError.CreateFmt(SErrNosuchModule,[AModuleName]);
 end;
 
-function TModuleFactory.IndexOfModule(AModuleName: String): Integer;
+function TModuleFactory.IndexOfModule(const AModuleName: String): Integer;
 
 begin
   Result:=Count-1;
@@ -559,14 +559,14 @@ begin
   Result:=TCustomWebAction(Inherited Add);
 end;
 
-function TCustomWebActions.ActionByName(AName: String): TCustomWebAction;
+function TCustomWebActions.ActionByName(const AName: String): TCustomWebAction;
 begin
   Result:=FindAction(AName);
   If (Result=Nil) then
     Raise HTTPError.CreateFmt(SErrUnknownAction,[AName]);
 end;
 
-function TCustomWebActions.FindAction(AName: String): TCustomWebAction;
+function TCustomWebActions.FindAction(const AName: String): TCustomWebAction;
 
 Var
   I : Integer;
@@ -579,7 +579,7 @@ begin
     Result:=Actions[I];
 end;
 
-function TCustomWebActions.IndexOfAction(AName: String): Integer;
+function TCustomWebActions.IndexOfAction(const AName: String): Integer;
 
 begin
   Result:=Count-1;

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

@@ -17,7 +17,7 @@ unit fphttpclient;
 { ---------------------------------------------------------------------
   Todo:
   * Proxy support ?
-  * Easy calls for POST/DELETE/etc.
+  * Https support.
   ---------------------------------------------------------------------}
 
 {$mode objfpc}{$H+}
@@ -59,7 +59,7 @@ Type
     // 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;
+    procedure ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); 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)
@@ -106,6 +106,41 @@ Type
     Class procedure SimplePost(const URL: string; Response : TStrings);
     Class procedure SimplePost(const URL: string; const LocalFileName: String);
     Class function SimplePost(const URL: string) : String;
+    // Simple Put
+    // Put URL, and Requestbody. Return response in Stream, File, TstringList or String;
+    procedure Put(const URL: string; const Response: TStream);
+    procedure Put(const URL: string; Response : TStrings);
+    procedure Put(const URL: string; const LocalFileName: String);
+    function Put(const URL: string) : String;
+    // Simple class methods.
+    Class procedure SimplePut(const URL: string; const Response: TStream);
+    Class procedure SimplePut(const URL: string; Response : TStrings);
+    Class procedure SimplePut(const URL: string; const LocalFileName: String);
+    Class function SimplePut(const URL: string) : String;
+    // Simple Delete
+    // Delete URL, and Requestbody. Return response in Stream, File, TstringList or String;
+    procedure Delete(const URL: string; const Response: TStream);
+    procedure Delete(const URL: string; Response : TStrings);
+    procedure Delete(const URL: string; const LocalFileName: String);
+    function Delete(const URL: string) : String;
+    // Simple class methods.
+    Class procedure SimpleDelete(const URL: string; const Response: TStream);
+    Class procedure SimpleDelete(const URL: string; Response : TStrings);
+    Class procedure SimpleDelete(const URL: string; const LocalFileName: String);
+    Class function SimpleDelete(const URL: string) : String;
+    // Simple Options
+    // Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
+    procedure Options(const URL: string; const Response: TStream);
+    procedure Options(const URL: string; Response : TStrings);
+    procedure Options(const URL: string; const LocalFileName: String);
+    function Options(const URL: string) : String;
+    // Simple class methods.
+    Class procedure SimpleOptions(const URL: string; const Response: TStream);
+    Class procedure SimpleOptions(const URL: string; Response : TStrings);
+    Class procedure SimpleOptions(const URL: string; const LocalFileName: String);
+    Class function SimpleOptions(const URL: string) : String;
+    // Get HEAD
+    Class Procedure Head(AURL : String; Headers: TStrings);
     // Post Form data (www-urlencoded).
     // Formdata in string (urlencoded) or TStrings (plain text) format.
     // Form data will be inserted in the requestbody.
@@ -298,7 +333,7 @@ begin
   I:=Pos(':',Result);
   if (I=0) then
     I:=Length(Result);
-  Delete(Result,1,I);
+  System.Delete(Result,1,I);
 end;
 
 Function TFPCustomHTTPClient.GetServerURL(URI : TURI) : String;
@@ -353,8 +388,8 @@ begin
   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));
+  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];
@@ -414,7 +449,7 @@ begin
         Result:=Result+#13
       else
         begin
-        Delete(FBuffer,1,1);
+        System.Delete(FBuffer,1,1);
         Done:=True;
         end;
       end;
@@ -434,7 +469,7 @@ begin
       else
         begin
         Result:=Result+Copy(FBuffer,1,P-1);
-        Delete(FBuffer,1,P+1);
+        System.Delete(FBuffer,1,P+1);
         Done:=True;
         end;
       end;
@@ -469,7 +504,7 @@ begin
   S:=Uppercase(GetNextWord(AStatusLine));
   If (Copy(S,1,5)<>'HTTP/') then
     Raise EHTTPClient.CreateFmt(SErrInvalidProtocolVersion,[S]);
-  Delete(S,1,5);
+  System.Delete(S,1,5);
   FServerHTTPVersion:=S;
   S:=GetNextWord(AStatusLine);
   Result:=StrToIntDef(S,-1);
@@ -490,14 +525,14 @@ Function TFPCustomHTTPClient.ReadResponseHeaders : Integer;
     If Assigned(FCookies) then
       FCookies.Clear;
     P:=Pos(':',S);
-    Delete(S,1,P);
+    System.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);
+      System.Delete(S,1,P);
     Until (S='');
   end;
 
@@ -555,7 +590,7 @@ begin
     S:=Trim(LowerCase(FResponseHeaders[i]));
     If (Copy(S,1,Length(Cl))=Cl) then
       begin
-      Delete(S,1,Length(CL));
+      System.Delete(S,1,Length(CL));
       Result:=StrToIntDef(Trim(S),-1);
       end;
     Inc(I);
@@ -578,7 +613,7 @@ begin
     S:=Trim(LowerCase(FResponseHeaders[i]));
     If (Copy(S,1,Length(Cl))=Cl) then
       begin
-      Delete(S,1,Length(CL));
+      System.Delete(S,1,Length(CL));
       Result:=Trim(S);
       exit;
       end;
@@ -599,7 +634,7 @@ begin
   GetCookies.Assign(AValue);
 end;
 
-procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedResponseCodes : Array of Integer);
+procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedResponseCodes : Array of Integer; HeadersOnly: Boolean = False);
 
   Function Transfer(LB : Integer) : Integer;
 
@@ -719,6 +754,8 @@ begin
   FResponseStatusCode:=ReadResponseHeaders;
   if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
     Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
+  if HeadersOnly then
+    exit;
   if CompareText(CheckTransferEncoding,'chunked')=0 then
     ReadChunkedResponse
   else
@@ -765,7 +802,7 @@ begin
   ConnectToServer(URI.Host,URI.Port);
   try
     SendRequest(AMethod,URI);
-    ReadResponse(Stream,AllowedResponseCodes);
+    ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
   finally
     DisconnectFromServer;
   end;
@@ -781,6 +818,7 @@ end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
+  FreeAndNil(FCookies);
   FreeAndNil(FRequestHeaders);
   FreeAndNil(FResponseHeaders);
   inherited Destroy;
@@ -837,6 +875,7 @@ Class Procedure TFPCustomHTTPClient.SimpleGet(Const AURL : String; Stream : TStr
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Get(AURL,Stream);
     finally
       Free;
@@ -849,6 +888,7 @@ Class Procedure TFPCustomHTTPClient.SimpleGet(Const AURL : String; const LocalFi
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Get(AURL,LocalFileName);
     finally
       Free;
@@ -861,6 +901,7 @@ Class Procedure TFPCustomHTTPClient.SimpleGet(Const AURL : String; Response : TS
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Get(AURL,Response);
     finally
       Free;
@@ -927,6 +968,7 @@ Class procedure TFPCustomHTTPClient.SimplePost(const URL: string; const Response
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Post(URL,Response);
     finally
       Free;
@@ -939,6 +981,7 @@ Class procedure TFPCustomHTTPClient.SimplePost(const URL: string; Response : TSt
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Post(URL,Response);
     finally
       Free;
@@ -951,6 +994,7 @@ Class procedure TFPCustomHTTPClient.SimplePost(const URL: string; const LocalFil
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Post(URL,LocalFileName);
     finally
       Free;
@@ -963,13 +1007,291 @@ Class function TFPCustomHTTPClient.SimplePost(const URL: string) : String;
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Result:=Post(URL);
     finally
       Free;
     end;
 end;
 
+procedure TFPCustomHTTPClient.Put(const URL: string; const Response: TStream);
+begin
+  DoMethod('PUT',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Put(const URL: string; Response: TStrings);
+begin
+  Response.Text:=Put(URL);
+end;
+
+procedure TFPCustomHTTPClient.Put(const URL: string;
+  const LocalFileName: String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(LocalFileName,fmCreate);
+  try
+    Put(URL,F);
+  finally
+    F.Free;
+  end;
+end;
+
+function TFPCustomHTTPClient.Put(const URL: string): String;
+Var
+  SS : TStringStream;
+begin
+  SS:=TStringStream.Create('');
+  try
+    Put(URL,SS);
+    Result:=SS.Datastring;
+  finally
+    SS.Free;
+  end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+  const Response: TStream);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Put(URL,Response);
+    finally
+      Free;
+    end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+  Response: TStrings);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Put(URL,Response);
+    finally
+      Free;
+    end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+  const LocalFileName: String);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Put(URL,LocalFileName);
+    finally
+      Free;
+    end;
+end;
+
+Class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Result:=Put(URL);
+    finally
+      Free;
+    end;
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string; const Response: TStream);
+begin
+  DoMethod('DELETE',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string; Response: TStrings);
+begin
+  Response.Text:=Delete(URL);
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string;
+  const LocalFileName: String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(LocalFileName,fmCreate);
+  try
+    Delete(URL,F);
+  finally
+    F.Free;
+  end;
+end;
+
+function TFPCustomHTTPClient.Delete(const URL: string): String;
+Var
+  SS : TStringStream;
+begin
+  SS:=TStringStream.Create('');
+  try
+    Delete(URL,SS);
+    Result:=SS.Datastring;
+  finally
+    SS.Free;
+  end;
+end;
 
+Class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+  const Response: TStream);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Delete(URL,Response);
+    finally
+      Free;
+    end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+  Response: TStrings);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Delete(URL,Response);
+    finally
+      Free;
+    end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+  const LocalFileName: String);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Delete(URL,LocalFileName);
+    finally
+      Free;
+    end;
+end;
+
+Class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Result:=Delete(URL);
+    finally
+      Free;
+    end;
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream);
+begin
+  DoMethod('OPTIONS',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string; Response: TStrings);
+begin
+  Response.Text:=Options(URL);
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string;
+  const LocalFileName: String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(LocalFileName,fmCreate);
+  try
+    Options(URL,F);
+  finally
+    F.Free;
+  end;
+end;
+
+function TFPCustomHTTPClient.Options(const URL: string): String;
+Var
+  SS : TStringStream;
+begin
+  SS:=TStringStream.Create('');
+  try
+    Options(URL,SS);
+    Result:=SS.Datastring;
+  finally
+    SS.Free;
+  end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+  const Response: TStream);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Options(URL,Response);
+    finally
+      Free;
+    end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+  Response: TStrings);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Options(URL,Response);
+    finally
+      Free;
+    end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+  const LocalFileName: String);
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Options(URL,LocalFileName);
+    finally
+      Free;
+    end;
+end;
+
+Class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
+
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      Result:=Options(URL);
+    finally
+      Free;
+    end;
+end;
+
+class procedure TFPCustomHTTPClient.Head(AURL : String; Headers: TStrings);
+begin
+  With Self.Create(nil) do
+    try
+      RequestHeaders.Add('Connection: Close');
+      HTTPMethod('HEAD', AURL, Nil, [200]);
+      Headers.Assign(ResponseHeaders);
+    Finally
+      Free;
+    end;
+end;
 
 procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
   const Response: TStream);
@@ -1043,12 +1365,12 @@ begin
   end;
 end;
 
-
 Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string; const Response: TStream);
 
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1061,6 +1383,7 @@ Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL : string; FormData:
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1073,6 +1396,7 @@ Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1084,6 +1408,7 @@ Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL : string; FormData:
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1095,6 +1420,7 @@ Class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string):
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1106,6 +1432,7 @@ Class function TFPCustomHTTPClient.SimpleFormPost(const URL: string; FormData :
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1121,10 +1448,10 @@ Var
   F : TFileStream;
 begin
   Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]);
-  AddHeader('Content-type','multipart/form-data; boundary='+Sep);
+  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;
+  s:=s+Format('Content-Disposition: form-data; name="%s"; filename="%s"'+CRLF,[AFieldName,ExtractFileName(AFileName)]);
+  s:=s+'Content-Type: application/octet-string'+CRLF+CRLF;
   SS:=TStringStream.Create(s);
   try
     SS.Seek(0,soFromEnd);
@@ -1151,12 +1478,12 @@ Class Procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName, A
 begin
   With Self.Create(nil) do
     try
+      RequestHeaders.Add('Connection: Close');
       FileFormPost(AURL,AFieldName,AFileName,Response);
     Finally
       Free;
     end;
 end;
 
-
 end.
 

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

@@ -20,7 +20,7 @@ unit fphttpserver;
 interface
 
 uses
-  Classes, SysUtils, ssockets, httpdefs;
+  Classes, SysUtils, sockets, ssockets, resolve, httpdefs;
 
 Const
   ReadBufLen = 4096;
@@ -29,12 +29,15 @@ Type
   TFPHTTPConnection = Class;
   TFPHTTPConnectionThread = Class;
   TFPCustomHttpServer = Class;
+  TRequestErrorHandler = Procedure (Sender : TObject; E : Exception) of object;
 
   { TFPHTTPConnectionRequest }
 
   TFPHTTPConnectionRequest = Class(TRequest)
   private
     FConnection: TFPHTTPConnection;
+    FRemoteAddress: String;
+    FServerPort: String;
     FQueryString : String;
   protected
     function GetFieldValue(Index: Integer): String; override;
@@ -61,14 +64,18 @@ Type
 
   TFPHTTPConnection = Class(TObject)
   private
+    FOnError: TRequestErrorHandler;
     FServer: TFPCustomHTTPServer;
     FSocket: TSocketStream;
     FBuffer : Ansistring;
     procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String);
     function ReadString: String;
+    Function GetLookupHostNames : Boolean;
   Protected
     procedure ReadRequestContent(ARequest: TFPHTTPConnectionRequest); virtual;
     procedure UnknownHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String); virtual;
+    procedure HandleRequestError(E : Exception); virtual;
+    Procedure SetupSocket; virtual;
     Function ReadRequestHeaders : TFPHTTPConnectionRequest;
   Public
     Constructor Create(AServer : TFPCustomHTTPServer; ASocket : TSocketStream);
@@ -76,6 +83,8 @@ Type
     Procedure HandleRequest; virtual;
     Property Socket : TSocketStream Read FSocket;
     Property Server : TFPCustomHTTPServer Read FServer;
+    Property OnRequestError : TRequestErrorHandler Read FOnError Write FOnError;
+    Property LookupHostNames : Boolean Read GetLookupHostNames;
   end;
 
   { TFPHTTPConnectionThread }
@@ -102,11 +111,13 @@ Type
     FAdminName: string;
     FOnAllowConnect: TConnectQuery;
     FOnRequest: THTTPServerRequestHandler;
+    FOnRequestError: TRequestErrorHandler;
     FPort: Word;
     FQueueSize: Word;
     FServer : TInetServer;
     FLoadActivate : Boolean;
     FServerBanner: string;
+    FLookupHostNames,
     FThreaded: Boolean;
     function GetActive: Boolean;
     procedure SetActive(const AValue: Boolean);
@@ -114,6 +125,8 @@ Type
     procedure SetPort(const AValue: Word);
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
+    procedure SetupSocket;
+    procedure StartServerSocket;
   Protected
     // Override these to create descendents of the request/response instead.
     Function CreateRequest : TFPHTTPConnectionRequest; virtual;
@@ -135,6 +148,8 @@ Type
     // Handle request. This calls OnRequest. It can be overridden by descendants to provide standard handling.
     procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest;
                             Var AResponse : TFPHTTPConnectionResponse); virtual;
+    // Called when a connection encounters an unexpected error. Will call OnRequestError when set.
+    procedure HandleRequestError(Sender: TObject; E: Exception); virtual;
   public
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
@@ -151,12 +166,14 @@ Type
     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;
-
+    // Called when an unexpected error occurs during handling of the request. Sender is the TFPHTTPConnection.
+    Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
   published
     //aditional server information
     property AdminMail: string read FAdminMail write FAdminMail;
     property AdminName: string read FAdminName write FAdminName;
     property ServerBanner: string read FServerBanner write FServerBanner;
+    Property LookupHostNames : Boolean Read FLookupHostNames Write FLookupHostNames;
   end;
 
   TFPHttpServer = Class(TFPCustomHttpServer)
@@ -167,6 +184,7 @@ Type
     Property OnAllowConnect;
     property Threaded;
     Property OnRequest;
+    Property OnRequestError;
   end;
 
   EHTTPServer = Class(Exception);
@@ -175,6 +193,7 @@ Type
 
 implementation
 
+
 resourcestring
   SErrSocketActive    =  'Operation not allowed while server is active';
   SErrReadingSocket   = 'Error reading data from the socket';
@@ -230,6 +249,11 @@ begin
   end;
 end;
 
+procedure HandleRequestError(Sender: TObject; E: Exception);
+begin
+
+end;
+
 procedure TFPHTTPConnectionRequest.InitRequestVars;
 Var
   P : Integer;
@@ -240,6 +264,30 @@ begin
   inherited InitRequestVars;
 end;
 
+Function SocketAddrToString(ASocketAddr: TSockAddr): String;
+begin
+  if ASocketAddr.sa_family = AF_INET then
+    Result := NetAddrToStr(ASocketAddr.sin_addr)
+  else // no ipv6 support yet
+    Result := '';
+end;
+
+Function GetHostNameByAddress(const AnAddress: String): String;
+var
+  Resolver: THostResolver;
+begin
+  Result := '';
+  if AnAddress = '' then exit;
+
+  Resolver := THostResolver.Create(nil);
+  try
+    if Resolver.AddressLookup(AnAddress) then
+      Result := Resolver.ResolvedName
+  finally
+    FreeAndNil(Resolver);
+  end;
+end;
+
 procedure TFPHTTPConnectionRequest.SetContent(AValue : String);
 
 begin
@@ -247,22 +295,34 @@ begin
   FContentRead:=true;
 end;
 
+
 Procedure TFPHTTPConnectionRequest.SetFieldValue(Index : Integer; Value : String);
 
 begin
-  if Index=33 then
-    FQueryString:=Value
+  case Index of
+    27 : FRemoteAddress := Value;
+    30 : FServerPort := Value;
+    33 : FQueryString:=Value
   else
     Inherited SetFieldValue(Index,Value);
+  end;  
 end;
 
 Function TFPHTTPConnectionRequest.GetFieldValue(Index : Integer) : String;
 
 begin
-  if Index=33 then
-    Result:=FQueryString
+  case Index of
+    27 : Result := FRemoteAddress;
+    28 : // Remote server name
+         if Assigned(FConnection) and FConnection.LookupHostNames then
+           Result := GetHostNameByAddress(FRemoteAddress) 
+         else
+           Result:='';  
+    30 : Result := FServerPort;
+    33 : Result:=FQueryString
   else
     Result:=Inherited GetFieldValue(Index);
+  end; 
 end;
 
 procedure TFPHTTPConnectionResponse.DoSendHeaders(Headers: TStrings);
@@ -357,6 +417,24 @@ begin
   // Do nothing
 end;
 
+procedure TFPHTTPConnection.HandleRequestError(E: Exception);
+begin
+  If Assigned(FOnError) then
+    try
+      FOnError(Self,E);
+    except
+      // We really cannot handle this...
+    end;
+end;
+
+procedure TFPHTTPConnection.SetupSocket;
+begin
+{$if defined(FreeBSD) or defined(Linux)}
+  FSocket.ReadFlags:=MSG_NOSIGNAL;
+  FSocket.WriteFlags:=MSG_NOSIGNAL;
+{$endif}
+end;
+
 Procedure TFPHTTPConnection.InterPretHeader(ARequest : TFPHTTPConnectionRequest; Const AHeader : String);
 
 Var
@@ -438,6 +516,7 @@ begin
       end;  
     end;
   ARequest.SetContent(S);
+
 end;
 
 function TFPHTTPConnection.ReadRequestHeaders: TFPHTTPConnectionRequest;
@@ -446,15 +525,22 @@ Var
   StartLine,S : String;
 begin
   Result:=Server.CreateRequest;
-  Server.InitRequest(Result);
-  Result.FConnection:=Self;
-  StartLine:=ReadString;
-  ParseStartLine(Result,StartLine);
-  Repeat
-    S:=ReadString;
-    if (S<>'') then
-      InterPretHeader(Result,S);
-  Until (S='');
+  try
+    Server.InitRequest(Result);
+    Result.FConnection:=Self;
+    StartLine:=ReadString;
+    ParseStartLine(Result,StartLine);
+    Repeat
+      S:=ReadString;
+      if (S<>'') then
+        InterPretHeader(Result,S);
+    Until (S='');
+    Result.RemoteAddress := SocketAddrToString(FSocket.RemoteAddress);
+    Result.ServerPort := FServer.Port;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
 end;
 
 constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream);
@@ -469,6 +555,15 @@ begin
   Inherited;
 end;
 
+Function TFPHTTPConnection.GetLookupHostNames : Boolean;
+
+begin
+  if Assigned(FServer) then
+    Result:=FServer.LookupHostNames
+  else
+    Result:=False;  
+end;
+
 procedure TFPHTTPConnection.HandleRequest;
 
 Var
@@ -476,30 +571,36 @@ Var
   Resp : TFPHTTPConnectionResponse;
 
 begin
-  // Read headers.
-  Req:=ReadRequestHeaders;
-  //set port
-  Req.ServerPort := Server.Port;
-  try
-    // Read content, if any
-    If Req.ContentLength>0 then
-      ReadRequestContent(Req);
-    Req.InitRequestVars;
-    // Create Response
-    Resp:= Server.CreateResponse(Req);
+  Try
+    SetupSocket;
+    // Read headers.
+    Req:=ReadRequestHeaders;
     try
-      Server.InitResponse(Resp);
-      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);
+      //set port
+      Req.ServerPort := Server.Port;
+      // Read content, if any
+      If Req.ContentLength>0 then
+        ReadRequestContent(Req);
+      Req.InitRequestVars;
+      // Create Response
+      Resp:= Server.CreateResponse(Req);
+      try
+        Server.InitResponse(Resp);
+        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;
-  Finally
-    FreeAndNil(Req);
+  Except
+    On E : Exception do
+      HandleRequestError(E);
   end;
 end;
 
@@ -528,6 +629,18 @@ end;
 
 { TFPCustomHttpServer }
 
+procedure TFPCustomHttpServer.HandleRequestError(Sender: TObject; E: Exception);
+begin
+  If Assigned(FOnRequestError) then
+    try
+      FOnRequestError(Sender,E);
+    except
+      // Do not let errors in user code escape.
+    end
+  else
+    Writeln('Unhandled exception : ',E.ClassName,' : ',E.Message);
+end;
+
 function TFPCustomHttpServer.GetActive: Boolean;
 begin
   if (csDesigning in ComponentState) then
@@ -542,7 +655,11 @@ begin
   FLoadActivate:=AValue;
   if not (csDesigning in Componentstate) then
     if AValue then
-      CreateServerSocket
+      begin
+      CreateServerSocket;
+      SetupSocket;
+      StartServerSocket;
+      end
     else
       FreeServerSocket;
 end;
@@ -622,6 +739,7 @@ begin
   Con:=CreateConnection(Data);
   try
     Con.FServer:=Self;
+    Con.OnRequestError:=@HandleRequestError;
     if Threaded then
       CreateConnectionThread(Con)
     else
@@ -634,13 +752,23 @@ begin
   end;
 end;
 
+procedure TFPCustomHttpServer.SetupSocket;
+
+begin
+  FServer.QueueSize:=Self.QueueSize;
+  FServer.ReuseAddress:=true;
+end;
+
 procedure TFPCustomHttpServer.CreateServerSocket;
 begin
   FServer:=TInetServer.Create(FPort);
   FServer.MaxConnections:=-1;
   FServer.OnConnectQuery:=OnAllowConnect;
   FServer.OnConnect:=@DOConnect;
-  FServer.QueueSize:=Self.QueueSize;
+end;
+
+procedure TFPCustomHttpServer.StartServerSocket;
+begin
   FServer.Bind;
   FServer.Listen;
   FServer.StartAccepting;

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

@@ -136,11 +136,13 @@ type
     Function IndexOfCookie(AName : String) : Integer;
     property Items[Index: Integer]: TCookie read GetCookie write SetCookie; default;
   end;
+
   { TUploadedFile }
 
   TUploadedFile = Class(TCollectionItem)
   Private
     FContentType: String;
+    FDescription: String;
     FDisposition: String;
     FFieldName: String;
     FFileName: String;
@@ -148,6 +150,7 @@ type
     FSize: Int64;
     FStream : TStream;
   Protected
+    Procedure DeleteTempUploadedFile; virtual;
     function GetStream: TStream; virtual;
   Public
     Destructor Destroy; override;
@@ -158,20 +161,66 @@ type
     Property ContentType : String Read FContentType Write FContentType;
     Property Disposition : String Read FDisposition Write FDisposition;
     Property LocalFileName : String Read FLocalFileName Write FLocalFileName;
+    Property Description : String Read FDescription Write FDescription;
   end;
-  
+  TUploadedFileClass = Class of TUploadedFile;
+
   { TUploadedFiles }
 
   TUploadedFiles = Class(TCollection)
   private
+    FRequest : TRequest; // May be nil
     function GetFile(Index : Integer): TUploadedFile;
     procedure SetFile(Index : Integer; const AValue: TUploadedFile);
+  Protected
+    Function GetTempUploadFileName(Const AName, AFileName : String; ASize : Int64): String;
+    Procedure DeleteTempUploadedFiles; virtual;
   public
     Function IndexOfFile(AName : String) : Integer;
     Function FileByName(AName : String) : TUploadedFile;
     Function FindFile(AName : String) : TUploadedFile;
     Property Files[Index : Integer] : TUploadedFile read GetFile Write SetFile; default;
   end;
+  TUploadedFilesClass = Class of TUploadedFiles;
+
+  { TMimeItem }
+  // Used to decode multipart encoded content
+
+  TMimeItem = Class(TCollectionItem)
+  private
+  protected
+    Function CreateUploadedFile(Files : TUploadedFiles) : TUploadedFile; virtual;
+    Function ProcessHeader(Const AHeader,AValue : String) : Boolean; virtual;
+    procedure SaveToFile(const AFileName: String); virtual;
+    function GetIsFile: Boolean; virtual;
+    // These must be implemented in descendents;
+    function GetDataSize: Int64; virtual; abstract;
+    function GetHeader(AIndex: Integer): String; virtual; abstract;
+    Procedure SetHeader(AIndex: Integer; Const AValue: String); virtual; abstract;
+  Public
+    Procedure Process(Stream : TStream); virtual; abstract;
+    Property Data : String index 0 Read GetHeader Write SetHeader;
+    Property Name : String index 1 Read GetHeader Write SetHeader;
+    Property Disposition : String index 2 Read GetHeader Write SetHeader;
+    Property FileName : String index 3 Read GetHeader Write SetHeader;
+    Property ContentType : String index 4 Read GetHeader Write SetHeader;
+    Property Description : String index 5 Read GetHeader Write SetHeader;
+    Property IsFile : Boolean  Read GetIsFile;
+    Property DataSize : Int64 Read GetDataSize;
+  end;
+  TMimeItemClass = Class of TMimeItem;
+  { TMimeItems }
+
+  TMimeItems = Class(TCollection)
+  private
+    function GetP(AIndex : Integer): TMimeItem;
+  Protected
+    Procedure CreateUploadFiles(Files : TUploadedFiles; Vars : TStrings); virtual;
+    procedure FormSplit(var Cnt: String; boundary: String); virtual;
+  Public
+    Property Parts[AIndex : Integer] : TMimeItem Read GetP; default;
+  end;
+  TMimeItemsClass = Class of TMimeItems;
 
   { THTTPHeader }
 
@@ -286,6 +335,8 @@ type
   Protected
     FContentRead : Boolean;
     FContent : String;
+    Function CreateUploadedFiles : TUploadedFiles; virtual;
+    Function CreateMimeItems : TMimeItems; virtual;
     procedure HandleUnknownEncoding(Const AContentType : String;Stream : TStream); virtual;
     procedure ParseFirstHeaderLine(const line: String);override;
     procedure ReadContent; virtual;
@@ -295,7 +346,7 @@ type
     Procedure ProcessQueryString(Const FQueryString : String; SL:TStrings); virtual;
     procedure ProcessURLEncoded(Stream : TStream;SL:TStrings); virtual;
     Function RequestUploadDir : String; virtual;
-    Function  GetTempUploadFileName(Const AName, AFileName : String; ASize : Int64) : String; virtual;
+    Function GetTempUploadFileName(Const AName, AFileName : String; ASize : Int64) : String; virtual;
     Procedure DeleteTempUploadedFiles; virtual;
     Procedure InitRequestVars; virtual;
     Procedure InitPostVars; virtual;
@@ -417,6 +468,13 @@ Function HTTPDecode(const AStr: String): String;
 Function HTTPEncode(const AStr: String): String;
 Function IncludeHTTPPathDelimiter(const AStr: String): String;
 
+Var
+  // Default classes used when instantiating the collections.
+  UploadedFilesClass : TUploadedFilesClass = TUploadedFiles;
+  UploadedFileClass : TUploadedFileClass = TUploadedFile;
+  MimeItemsClass : TMimeItemsClass = TMimeItems;
+  MimeItemClass : TMimeItemClass = nil;
+
 implementation
 
 uses
@@ -556,6 +614,127 @@ begin
     Result:=Result+'/';
 end;
 
+{ -------------------------------------------------------------------
+  THTTPMimeItem, default used by TRequest to process Multipart-encoded data.
+  -------------------------------------------------------------------}
+
+Type
+  { THTTPMimeItem }
+
+  THTTPMimeItem = Class(TMimeItem)
+  private
+    FData : Array[0..5] of string;
+  protected
+    Procedure SetHeader(AIndex: Integer; Const AValue: String); override;
+    function GetDataSize: Int64; override;
+    function GetHeader(AIndex: Integer): String; override;
+    function GetIsFile: Boolean; override;
+  public
+    Procedure Process(Stream : TStream); override;
+  end;
+
+
+procedure THTTPMimeItem.SetHeader(AIndex: Integer; const AValue: String);
+begin
+  FData[AIndex]:=Avalue;
+end;
+
+function THTTPMimeItem.GetDataSize: int64;
+begin
+  Result:=Length(Data);
+end;
+
+function THTTPMimeItem.GetHeader(AIndex: Integer): String;
+begin
+  Result:=FData[AIndex];
+end;
+
+function THTTPMimeItem.GetIsFile: Boolean;
+begin
+  Result:=inherited GetIsFile;
+end;
+
+procedure THTTPMimeItem.Process(Stream: TStream);
+
+  Function GetLine(Var S : String) : String;
+
+  Var
+    P : Integer;
+
+  begin
+    P:=Pos(#13#10,S);
+    If (P<>0) then
+      begin
+      Result:=Copy(S,1,P-1);
+      Delete(S,1,P+1);
+      end;
+  end;
+
+  Function GetWord(Var S : String) : String;
+
+  Var
+    I,len : Integer;
+    Quoted : Boolean;
+    C : Char;
+
+  begin
+    len:=length(S);
+    quoted:=false;
+    Result:='';
+    for i:=1 to len do
+      Begin
+      c:=S[i];
+      if (c='"') then
+        Quoted:=Not Quoted
+      else
+        begin
+        if not (c in [' ','=',';',':']) or Quoted then
+          Result:=Result+C;
+        if (c in [';',':','=']) and (not quoted) then
+          begin
+          Delete(S,1,I);
+          Exit;
+          end;
+        end;
+      end;
+     S:='';
+  end;
+
+Var
+  Line : String;
+  len : integer;
+  S : string;
+  D : String;
+
+begin
+  {$ifdef CGIDEBUG}SendMethodEnter('THTTPMimeItem.Process');{$ENDIF}
+  If Stream is TStringStream then
+    D:=TStringStream(Stream).Datastring
+  else
+    begin
+    SetLength(D,Stream.Size);
+    Stream.ReadBuffer(D[1],Stream.Size);
+    end;
+  Line:=GetLine(D);
+  While (Line<>'') do
+    begin
+    {$ifdef CGIDEBUG}SendDebug('Process data line: '+line);{$ENDIF}
+    S:=GetWord(Line);
+    While (S<>'') do
+      begin
+      ProcessHeader(lowercase(S),GetWord(Line));
+      S:=GetWord(Line);
+      end;
+    Line:=GetLine(D);
+    end;
+  // Now Data contains the rest of the data, plus a CR/LF. Strip the CR/LF
+  Len:=Length(D);
+  If (len>2) then
+    Data:=Copy(D,1,Len-2)
+  else
+    Data:='';
+  {$ifdef CGIDEBUG}SendMethodExit('THTTPMimeItem.Process');{$ENDIF}
+end;
 
 { ---------------------------------------------------------------------
   THTTPHeader
@@ -660,7 +839,7 @@ end;
 Function THttpHeader.GetFieldValue(Index : Integer) : String;
 
 begin
-  if (Index>1) and (Index<NoHTTPFields) then
+  if (Index>=1) and (Index<=NoHTTPFields) then
     Result:=FFields[Index]
   else
     case Index of
@@ -812,101 +991,127 @@ begin
     SetFieldValue(i,AValue);
 end;
 
-{ -------------------------------------------------------------------
-  TFormItem, used by TRequest to process Multipart-encoded data.
-  -------------------------------------------------------------------}
-
-Type
-  TFormItem = Class(TObject)
-    Disposition : String;
-    Name : String;
-    IsFile : Boolean;
-    FileName : String;
-    ContentType : String;
-    DLen : Integer;
-    Data : String;
-    Procedure Process;
-  end;
+{ ---------------------------------------------------------------------
+  TMimeItems
+  ---------------------------------------------------------------------}
 
-Procedure TFormItem.Process;
+function TMimeItems.GetP(AIndex : Integer): TMimeItem;
+begin
+  Result:=TMimeItem(Items[Aindex]);
+end;
 
-  Function GetLine(Var S : String) : String;
+procedure TMimeItems.CreateUploadFiles(Files: TUploadedFiles; Vars : TStrings);
 
-  Var
-    P : Integer;
+Var
+  I,j : Integer;
+  P : TMimeItem;
+  LFN,Name,Value : String;
+  U : TUploadedFile;
 
-  begin
-    P:=Pos(#13#10,S);
-    If (P<>0) then
+begin
+  For I:=Count-1 downto 0 do
+    begin
+    P:=GetP(i);
+    If (P.Name='') then
+      P.Name:='DummyFileItem'+IntToStr(i);
+      //Raise Exception.CreateFmt('Invalid multipart encoding: %s',[FI.Data]);
+{$ifdef CGIDEBUG}
+    With P Do
       begin
-      Result:=Copy(S,1,P-1);
-      Delete(S,1,P+1);
+      SendSeparator;
+      SendDebug  ('PMP item Name        : '+Name);
+      SendDebug  ('PMP item Disposition : '+Disposition);
+      SendDebug  ('PMP item FileName    : '+FileName);
+      SendBoolean('PMP item IsFile      : ',IsFile);
+      SendDebug  ('PMP item ContentType : '+ContentType);
+      SendDebug  ('PMP item Description : '+Description);
+      SendInteger('PMP item DLen        : ',Datasize);
+      SendDebug  ('PMP item Data        : '+Data);
+      end;
+{$endif CGIDEBUG}
+    Name:=P.Name;
+    If Not P.IsFile Then
+      Value:=P.Data
+    else
+      begin
+      Value:=P.FileName;
+      P.CreateUploadedFile(Files);
       end;
+    Vars.Add(Name+'='+Value)
+    end;
+end;
+
+function TMimeItem.GetIsFile: Boolean;
+begin
+  Result:=(FileName<>'');
+end;
+
+function TMimeItem.ProcessHeader(const AHeader, AValue: String): Boolean;
+
+begin
+  Result:=True;
+  Case AHeader of
+   'content-disposition' : Disposition:=Avalue;
+   'name': Name:=Avalue;
+   'filename' : FileName:=AValue;
+   'content-description' :  description:=AValue;
+   'content-type' : ContentType:=AValue;
+  else
+    Result:=False;
   end;
+end;
 
-  Function GetWord(Var S : String) : String;
+Procedure TMimeItem.SaveToFile(Const AFileName: String);
 
-  Var
-    I,len : Integer;
-    Quoted : Boolean;
-    C : Char;
+Var
+  D : String;
+  F : TFileStream;
 
-  begin
-    len:=length(S);
-    quoted:=false;
-    Result:='';
-    for i:=1 to len do
-      Begin
-      c:=S[i];
-      if (c='"') then
-        Quoted:=Not Quoted
-      else
-        begin
-        if not (c in [' ','=',';',':']) or Quoted then
-          Result:=Result+C;
-        if (c in [';',':','=']) and (not quoted) then
-          begin
-          Delete(S,1,I);
-          Exit;
-          end;
-        end;
-      end;
-     S:='';
+begin
+  F:=TFileStream.Create(AFileName,fmCreate);
+  Try
+    D:=Data;
+    F.Write(D[1],DataSize);
+  finally
+    F.Free;
   end;
+end;
+
+function TMimeItem.CreateUploadedFile(Files: TUploadedFiles): TUploadedFile;
 
 Var
-  Line : String;
-  len : integer;
-  S : string;
+  J : Int64;
+  D,LFN : String;
 
 begin
-  Line:=GetLine(Data);
-  While (Line<>'') do
+  Result:=Nil;
+  D:=Data;
+  J:=DataSize;
+  if (J=0){zero lenght file} or
+     ((J=2)and (D=#13#10)){empty files come as a simple empty line} then
+    LFN:='' //No tmp file will be created for empty files
+  else
     begin
-    S:=GetWord(Line);
-    While (S<>'') do
-      begin
-      If CompareText(S,'Content-Disposition')=0 then
-        Disposition:=GetWord(Line)
-      else if CompareText(S,'name')=0 Then
-        Name:=GetWord(Line)
-      else if CompareText(S,'filename')=0 then
-        begin
-        FileName:=GetWord(Line);
-        isFile:=True;
-        end
-      else if CompareText(S,'Content-Type')=0 then
-        ContentType:=GetWord(Line);
-      S:=GetWord(Line);
-      end;
-    Line:=GetLine(Data);
+    LFN:=Files.GetTempUploadFileName(Name,FileName,J);
+    SaveToFile(LFN);
     end;
-  // Now Data contains the rest of the data, plus a CR/LF. Strip the CR/LF
-  Len:=Length(Data);
-  If (len>2) then
-    Data:=Copy(Data,1,Len-2);
+  if (LFN<>'') then
+   begin
+   Result:=Files.Add as TUploadedFile;
+   with Result do
+     begin
+     FieldName:=Self.Name;
+     FileName:=Self.FileName;
+     ContentType:=Self.ContentType;
+     Disposition:=Self.Disposition;
+     Size:=Self.Datasize;
+     LocalFileName:=LFN;
+     Description:=Self.Description;
+     end;
+   end;
 end;
 
+
 {
   This needs MASSIVE improvements for large files.
   Best would be to do this directly from the input stream
@@ -914,34 +1119,41 @@ end;
   certain size is reached.)
 }
 
-procedure FormSplit(var Cnt : String; boundary: String; List : TList);
+procedure TMimeItems.FormSplit(var Cnt : String; boundary: String);
 
 // Splits the form into items
 var
   Sep : string;
   Clen,slen, p:longint;
-  FI : TFormItem;
+  FI : TMimeItem;
+  S : TStringStream;
 
 begin
+  {$ifdef CGIDEBUG}SendMethodEnter('TMimeItems.FormSplit');{$ENDIF}
   Sep:='--'+boundary+#13+#10;
   Slen:=length(Sep);
   CLen:=Pos('--'+Boundary+'--',Cnt);
   // Cut last marker
   Cnt:=Copy(Cnt,1,Clen-1);
   // Cut first marker
-  Delete(Cnt,1,Slen);
+  system.Delete(Cnt,1,Slen);
   Clen:=Length(Cnt);
   While Clen>0 do
     begin
-    Fi:=TFormItem.Create;
-    List.Add(Fi);
     P:=pos(Sep,Cnt);
     If (P=0) then
       P:=CLen+1;
-    FI.Data:=Copy(Cnt,1,P-1);
-    delete(Cnt,1,P+SLen-1);
+    S:=TStringStream.Create(Copy(Cnt,1,P-1));
+    try
+      FI:=Add as TMimeItem;
+      FI.Process(S)
+    finally
+      S.Free;
+    end;
+    system.delete(Cnt,1,P+SLen-1);
     CLen:=Length(Cnt);
     end;
+  {$ifdef CGIDEBUG}SendMethodExit('TMimeItems.FormSplit');{$ENDIF}
 end;
 
 { -------------------------------------------------------------------
@@ -952,13 +1164,45 @@ constructor TRequest.create;
 begin
   inherited create;
   FHandleGetOnPost:=True;
-  FFiles:=TUploadedFiles.Create(TUPloadedFile);
+  FFiles:=CreateUploadedFiles;
+  FFiles.FRequest:=Self;
   FLocalPathPrefix:='-';
 end;
 
+Function  TRequest.CreateUploadedFiles : TUploadedFiles;
+
+Var
+  CC : TUploadedFilesClass;
+  CI : TUploadedFileClass;
+
+begin
+  CC:=UploadedFilesClass;
+  CI:=UploadedFileClass;
+  if (CC=Nil) then
+    CC:=TUploadedFiles;
+  if (CI=Nil) then
+    CI:=TUploadedFile;
+  Result:=CC.Create(CI);
+end;
+
+function TRequest.CreateMimeItems: TMimeItems;
+
+Var
+  CC : TMimeItemsClass;
+  CI : TMimeItemClass;
+
+begin
+  CC:=MimeItemsClass;
+  CI:=MimeItemClass;
+  if (CC=Nil) then
+    CC:=TMimeItems;
+  if (CI=Nil) then
+    CI:=TMimeItem;
+  Result:=CC.Create(CI);
+end;
+
 destructor TRequest.destroy;
 begin
-  DeleteTempUploadedFiles;
   FreeAndNil(FFiles);
   inherited destroy;
 end;
@@ -1206,17 +1450,8 @@ begin
 end;
 
 Procedure TRequest.DeleteTempUploadedFiles;
-var
-  i: Integer;
-  s: String;
 begin
-  //delete all temporary uploaded files created for this request if there is any
-  i := FFiles.Count;
-  if i > 0 then for i := i - 1 downto 0 do
-    begin
-    s := FFiles[i].LocalFileName;
-    if FileExists(s) then DeleteFile(s);
-    end;
+  FFiles.DeleteTempUploadedFiles;
 end;
 
 procedure TRequest.InitRequestVars;
@@ -1231,16 +1466,12 @@ begin
   R:=Method;
   if (R='') then
     Raise Exception.Create(SErrNoRequestMethod);
-  if CompareText(R,'POST')=0 then
-    begin
+  // Always process QUERYSTRING.
+  InitGetVars;
+  // POST and PUT, force post var treatment.
+  // To catch other methods we do not treat specially, we'll do the same if contentlength>0
+  if (CompareText(R,'POST')=0) or (CompareText(R,'PUT')=0) or (ContentLength>0) then
     InitPostVars;
-    if FHandleGetOnPost then
-      InitGetVars;
-    end
-  else if (CompareText(R,'GET')=0) or (CompareText(R,'HEAD')=0) or (CompareText(R,'OPTIONS')=0) then
-    InitGetVars
-  else
-    Raise Exception.CreateFmt(SErrInvalidRequestMethod,[R]);
 {$ifdef CGIDEBUG}
   SendMethodExit('TRequest.InitRequestVars');
 {$endif}
@@ -1310,11 +1541,11 @@ end;
 Procedure TRequest.ProcessMultiPart(Stream : TStream; Const Boundary : String; SL:TStrings);
 
 Var
-  L : TList;
+  L : TMimeItems;
   B : String;
   I,J : Integer;
   S,FF,key, Value : String;
-  FI : TFormItem;
+  FI : TMimeItem;
   F : TStream;
 
 begin
@@ -1324,78 +1555,26 @@ begin
   I:=Length(B);
   If (I>0) and (B[1]='"') then
     B:=Copy(B,2,I-2);
-  L:=TList.Create;
+  L:=CreateMimeItems;
   Try
-    SetLength(S,Stream.Size);
-    If Length(S)>0 then
-      if Stream is TCustomMemoryStream then
-        // Faster.
-        Move(TCustomMemoryStream(Stream).Memory^,S[1],Length(S))
-      else
-        begin
-        Stream.Read(S[1],Length(S));
-        Stream.Position:=0;
-        end;
-    FormSplit(S,B,L);
-    For I:=L.Count-1 downto 0 do
+    if Stream is TStringStream then
+      S:=TStringStream(Stream).DataString
+    else
       begin
-      FI:=TFormItem(L[i]);
-      FI.Process;
-      If (FI.Name='') then
-        Fi.Name:='DummyFileItem'+IntToStr(i);
-        //Raise Exception.CreateFmt('Invalid multipart encoding: %s',[FI.Data]);
-{$ifdef CGIDEBUG}
-      With FI Do
-        begin
-        SendSeparator;
-        SendDebug  ('PMP item Name        : '+Name);
-        SendDebug  ('PMP item Disposition : '+Disposition);
-        SendDebug  ('PMP item FileName    : '+FileName);
-        SendBoolean('PMP item IsFile      : ',IsFile);
-        SendDebug  ('PMP item ContentType : '+ContentType);
-        SendInteger('PMP item DLen        : ',DLen);
-        SendDebug  ('PMP item Data        : '+Data);
-        end;
-{$endif CGIDEBUG}
-      Key:=FI.Name;
-      If Not FI.IsFile Then
-        Value:=FI.Data
-      else
-        begin
-        Value:=FI.FileName;
-        J := Length(FI.Data);
-        if (J=0){zero lenght file} or
-           ((J=2)and(FI.Data=#13#10)){empty files come as a simple empty line} then
-          FF:='' //No tmp file will be created for empty files
+      SetLength(S,Stream.Size);
+      If Length(S)>0 then
+        if Stream is TCustomMemoryStream then
+          // Faster.
+          Move(TCustomMemoryStream(Stream).Memory^,S[1],Length(S))
         else
           begin
-          FI.DLen:=J;
-          FF:=GetTempUploadFileName(FI.name,FI.FileName,J);
-          F:=TFileStream.Create(FF,fmCreate);
-          Try
-            F.Write(FI.Data[1],J);
-          finally
-            F.Free;
-          end;
+          Stream.Read(S[1],Length(S));
+          Stream.Position:=0;
           end;
-        if (Value <> '') or (FI.DLen > 0)then{only non zero length files or files with non empty names will be considered}
-         With Files.Add as TUploadedFile do
-          begin
-          FieldName:=FI.Name;
-          FileName:=FI.FileName;
-          ContentType:=FI.ContentType;
-          Disposition:=FI.Disposition;
-          Size:=FI.DLen;
-          LocalFileName:=FF;
-          end;
-        end;
-      FI.Free;
-      L[i]:=Nil;
-      SL.Add(Key+'='+Value)
       end;
+    L.FormSplit(S,B);
+    L.CreateUploadFiles(Files,SL);
   Finally
-    For I:=0 to L.Count-1 do
-      TObject(L[i]).Free;
     L.Free;
   end;
 {$ifdef CGIDEBUG}  SendMethodExit('ProcessMultiPart');{$endif CGIDEBUG}
@@ -1429,6 +1608,15 @@ begin
   Items[Index]:=AValue;
 end;
 
+function TUploadedFiles.GetTempUploadFileName(const AName, AFileName: String;
+  ASize: Int64): String;
+begin
+  If Assigned(FRequest) then
+    Result:=FRequest.GetTempUploadFileName(AName,AFileName,ASize)
+  else
+    Result:=GetTempFileName;
+end;
+
 function TUploadedFiles.IndexOfFile(AName: String): Integer;
 
 begin
@@ -1459,10 +1647,32 @@ begin
     Result:=Files[I];
 end;
 
+Procedure TUPloadedFiles.DeleteTempUploadedFiles;
+
+var
+  i: Integer;
+
+begin
+  //delete all temporary uploaded files created for this request if there are any
+  for i := Count-1 downto 0 do
+    Files[i].DeleteTempUploadedFile;
+end;
+
+
 { ---------------------------------------------------------------------
   TUploadedFile
   ---------------------------------------------------------------------}
 
+procedure TUploadedFile.DeleteTempUploadedFile;
+
+Var
+  s: String;
+
+begin
+  if (LocalFileName<>'') and FileExists(LocalFileName) then
+    DeleteFile(LocalFileName);
+end;
+
 function TUploadedFile.GetStream: TStream;
 begin
   If (FStream=Nil) then
@@ -1664,8 +1874,9 @@ begin
 end;
 
 
-{ TCookie }
-
+{ ---------------------------------------------------------------------
+  TCookie
+  ---------------------------------------------------------------------}
 
 function TCookie.GetAsString: string;
 
@@ -1733,7 +1944,9 @@ begin
   FExpires := EncodeDate(1970, 1, 1);
 end;
 
-{ TCookieCollection }
+{ ---------------------------------------------------------------------
+  TCookies
+  ---------------------------------------------------------------------}
 
 function TCookies.GetCookie(Index: Integer): TCookie;
 begin
@@ -1779,8 +1992,9 @@ begin
     Dec(Result);
 end;
 
-{ TCustomSession }
-
+{ ---------------------------------------------------------------------
+  TCustomSession
+  ---------------------------------------------------------------------}
 
 procedure TCustomSession.SetSessionCookie(const AValue: String);
 begin
@@ -1820,5 +2034,6 @@ begin
   // Do nothing
 end;
 
-
+initialization
+  MimeItemClass:=THTTPMimeItem;
 end.

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

@@ -121,13 +121,13 @@ begin
       Add('<H1>Uploaded files: ('+IntToStr(Files.Count)+') </H1>');
       Add('<TABLE BORDER="1">');
       Add('<TR><TD>Name</TD><TD>FileName</TD><TD>Size</TD>');
-      Add('<TD>Temp FileName</TD><TD>Disposition</TD><TD>Content-Type</TD></TR>');
+      Add('<TD>Temp FileName</TD><TD>Disposition</TD><TD>Content-Type</TD><TD>Description</TD></TR>');
       For I:=0 to Files.Count-1 do
         With Files[i] do
           begin
           Add('<TR><TD>'+FieldName+'</TD><TD>'+FileName+'</TD>');
           Add('<TD>'+IntToStr(Size)+'</TD><TD>'+LocalFileName+'</TD>');
-          Add('<TD>'+Disposition+'</TD><TD>'+ContentType+'</TD></TR>');
+          Add('<TD>'+Disposition+'</TD><TD>'+ContentType+'</TD><TD>'+Description+'</TD></TR>');
           end;
       Add('</TABLE><P>');
       end;