--- Merging r14994 into '.':

U    packages/fcl-web/src/webpage.pp
U    packages/fcl-web/src/fphtml.pp
--- Merging r15099 into '.':
U    packages/fcl-web/src/custfcgi.pp
--- Merging r15107 into '.':
U    packages/fcl-web/src/custweb.pp
--- Merging r15116 into '.':
U    rtl/objpas/classes/stringl.inc
--- Merging r15194 into '.':
U    packages/sqlite/src/sqlitedb.pas
U    packages/sqlite/src/sqlite3db.pas
--- Merging r15229 into '.':
U    packages/fcl-db/tests/testfieldtypes.pas
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
U    packages/fcl-db/src/sqldb/sqldb.pp
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r15322 into '.':
A    packages/fcl-web/tests
A    packages/fcl-web/tests/testcgiapp.pp
A    packages/fcl-web/tests/testcgiapp.lpi
U    packages/fcl-web/src/custcgi.pp
U    packages/fcl-web/src/fphttp.pp
U    packages/fcl-web/src/fpapache.pp
U    packages/fcl-web/src/webutil.pp
G    packages/fcl-web/src/custweb.pp
U    packages/fcl-web/src/httpdefs.pp
--- Merging r15329 into '.':
G    packages/fcl-web/src/custcgi.pp
A    packages/fcl-web/src/fcgigate.pp
--- Merging r15330 into '.':
A    packages/fcl-web/tests/cgigateway.pp
U    packages/fcl-web/tests/testcgiapp.lpi
A    packages/fcl-web/tests/cgigateway.lpi

# revisions: 14994,15099,15107,15116,15194,15229,15322,15329,15330
------------------------------------------------------------------------
r14994 | joost | 2010-03-09 09:45:45 +0100 (Tue, 09 Mar 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/fphtml.pp
   M /trunk/packages/fcl-web/src/webpage.pp

 * Implemented a stack of javascriptstacks. InitializeJavaScriptStack creates and adds a new JSStack to this stack, FreeJavascriptStack destroys and removes it again
------------------------------------------------------------------------
------------------------------------------------------------------------
r15099 | jonas | 2010-03-31 19:21:15 +0200 (Wed, 31 Mar 2010) | 2 lines
Changed paths:
   M /trunk/packages/fcl-web/src/custfcgi.pp

  * fixed compile-time range error under Windows (mantis #16171)

------------------------------------------------------------------------
------------------------------------------------------------------------
r15107 | joost | 2010-04-02 16:44:15 +0200 (Fri, 02 Apr 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/custweb.pp

 * Do not show exception twice
------------------------------------------------------------------------
------------------------------------------------------------------------
r15116 | michael | 2010-04-08 08:51:26 +0200 (Thu, 08 Apr 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/stringl.inc

* Call specialchars in TStringList constructor
------------------------------------------------------------------------
------------------------------------------------------------------------
r15194 | michael | 2010-04-27 17:22:03 +0200 (Tue, 27 Apr 2010) | 1 line
Changed paths:
   M /trunk/packages/sqlite/src/sqlite3db.pas
   M /trunk/packages/sqlite/src/sqlitedb.pas

* Removed some statements
------------------------------------------------------------------------
------------------------------------------------------------------------
r15229 | joost | 2010-05-05 19:30:26 +0200 (Wed, 05 May 2010) | 5 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
   M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
   M /trunk/packages/fcl-db/tests/testfieldtypes.pas

 * New property TSQLConnection.FieldNameQuoteChars, these chars (start- and
   end -quote) are used around field-names. Parameter-names are always quoted
   using double-quotes, since they are replaced by sqldb for all systems which
   don't use double-quotes as fieldnamequotechars. Bug #12275.

------------------------------------------------------------------------
------------------------------------------------------------------------
r15322 | michael | 2010-05-25 13:20:38 +0200 (Tue, 25 May 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/custcgi.pp
   M /trunk/packages/fcl-web/src/custweb.pp
   M /trunk/packages/fcl-web/src/fpapache.pp
   M /trunk/packages/fcl-web/src/fphttp.pp
   M /trunk/packages/fcl-web/src/httpdefs.pp
   M /trunk/packages/fcl-web/src/webutil.pp
   A /trunk/packages/fcl-web/tests
   A /trunk/packages/fcl-web/tests/testcgiapp.lpi
   A /trunk/packages/fcl-web/tests/testcgiapp.pp

* Added BaseURL, and support for additional encodings. Implemented CGI testbed application
------------------------------------------------------------------------
------------------------------------------------------------------------
r15329 | michael | 2010-05-27 11:21:47 +0200 (Thu, 27 May 2010) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/custcgi.pp
   A /trunk/packages/fcl-web/src/fcgigate.pp

* Implemented CGI -> FastCGI gateway application class
------------------------------------------------------------------------
------------------------------------------------------------------------
r15330 | michael | 2010-05-27 11:22:26 +0200 (Thu, 27 May 2010) | 1 line
Changed paths:
   A /trunk/packages/fcl-web/tests/cgigateway.lpi
   A /trunk/packages/fcl-web/tests/cgigateway.pp
   M /trunk/packages/fcl-web/tests/testcgiapp.lpi

* Test application for CGI gateway
------------------------------------------------------------------------

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

.gitattributes

@@ -1656,6 +1656,7 @@ packages/fcl-web/src/custcgi.pp svneol=native#text/plain
 packages/fcl-web/src/custfcgi.pp svneol=native#text/plain
 packages/fcl-web/src/custweb.pp svneol=native#text/plain
 packages/fcl-web/src/ezcgi.pp svneol=native#text/plain
+packages/fcl-web/src/fcgigate.pp svneol=native#text/plain
 packages/fcl-web/src/fpapache.pp svneol=native#text/plain
 packages/fcl-web/src/fpcgi.pp svneol=native#text/plain
 packages/fcl-web/src/fpdatasetform.pp svneol=native#text/plain
@@ -1667,6 +1668,10 @@ packages/fcl-web/src/httpdefs.pp svneol=native#text/plain
 packages/fcl-web/src/webpage.pp svneol=native#text/plain
 packages/fcl-web/src/websession.pp svneol=native#text/plain
 packages/fcl-web/src/webutil.pp svneol=native#text/plain
+packages/fcl-web/tests/cgigateway.lpi svneol=native#text/plain
+packages/fcl-web/tests/cgigateway.pp svneol=native#text/plain
+packages/fcl-web/tests/testcgiapp.lpi svneol=native#text/plain
+packages/fcl-web/tests/testcgiapp.pp svneol=native#text/plain
 packages/fcl-xml/Makefile svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/fpmake.pp svneol=native#text/plain

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -162,7 +162,8 @@ constructor TIBConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat] + [sqQuoteFieldnames];
+  FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat];
+  FieldNameQuoteChars:=DoubleQuotes;
   FBLobSegmentSize := 80;
   FDialect := -1;
   FDBDialect := -1;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -927,9 +927,11 @@ begin
 end;
 
 constructor TConnectionName.Create(AOwner: TComponent);
+const SingleBackQoutes: TQuoteChars = ('`','`');
 begin
   inherited Create(AOwner);
   FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
+  FieldNameQuoteChars:=SingleBackQoutes;
   FMySQL := Nil;
 end;
 

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -125,7 +125,8 @@ constructor TPQConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat] + [sqEscapeSlash] + [sqQuoteFieldnames];
+  FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat] + [sqEscapeSlash];
+  FieldNameQuoteChars:=DoubleQuotes;
 end;
 
 procedure TPQConnection.CreateDB;

packages/fcl-db/src/sqldb/sqldb.pp

@@ -23,7 +23,7 @@ interface
 uses SysUtils, Classes, DB, bufdataset, sqlscript;
 
 type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages);
-     TConnOption = (sqSupportParams,sqEscapeSlash,sqEscapeRepeat,sqQuoteFieldnames);
+     TConnOption = (sqSupportParams,sqEscapeSlash,sqEscapeRepeat);
      TConnOptions= set of TConnOption;
 
      TRowsCount = LargeInt;
@@ -53,9 +53,13 @@ type
     FSchemaType    : TSchemaType;
   end;
 
+type TQuoteChars = array[0..1] of char;
 
 const
- StatementTokens : Array[TStatementType] of string = ('(none)', 'select',
+  SingleQuotes : TQuoteChars = ('''','''');
+  DoubleQuotes : TQuoteChars = ('"','"');
+
+  StatementTokens : Array[TStatementType] of string = ('(none)', 'select',
                   'insert', 'update', 'delete',
                   'create', 'get', 'put', 'execute',
                   'start','commit','rollback', '?'
@@ -72,14 +76,13 @@ type
     procedure Update; override;
   end;
 
-
-{ TSQLConnection }
 type
 
   { TSQLConnection }
 
   TSQLConnection = class (TDatabase)
   private
+    FFieldNameQuoteChars : TQuoteChars;
     FPassword            : string;
     FTransaction         : TSQLTransaction;
     FUserName            : string;
@@ -126,6 +129,7 @@ type
     property port: cardinal read GetPort write Setport;
   public
     property Handle: Pointer read GetHandle;
+    property FieldNameQuoteChars: TQuoteChars read FFieldNameQuoteChars write FFieldNameQuoteChars;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure StartTransaction; override;
@@ -619,6 +623,7 @@ constructor TSQLConnection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FSQLServerFormatSettings.DecimalSeparator:='.';
+  FFieldNameQuoteChars:=DoubleQuotes;
 end;
 
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
@@ -1399,7 +1404,7 @@ end;
 
 Procedure TCustomSQLQuery.ApplyRecUpdate(UpdateKind : TUpdateKind);
 
-var FieldNamesQuoteChar : string;
+var FieldNamesQuoteChars : TQuoteChars;
 
   procedure InitialiseModifyQuery(var qry : TCustomSQLQuery; aSQL: String);
 
@@ -1420,7 +1425,7 @@ var FieldNamesQuoteChar : string;
     if (pfInKey in Fields[x].ProviderFlags) or
        ((FUpdateMode = upWhereAll) and (pfInWhere in Fields[x].ProviderFlags)) or
        ((FUpdateMode = UpWhereChanged) and (pfInWhere in Fields[x].ProviderFlags) and (fields[x].value <> fields[x].oldvalue)) then
-      sql_where := sql_where + '(' + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar + '= :' + FieldNamesQuoteChar + 'OLD_' + fields[x].FieldName + FieldNamesQuoteChar +') and ';
+      sql_where := sql_where + '(' + FieldNamesQuoteChars[0] + fields[x].FieldName + FieldNamesQuoteChars[1] + '= :"' + 'OLD_' + fields[x].FieldName + '") and ';
   end;
 
   function ModifyRecQuery : string;
@@ -1437,7 +1442,7 @@ var FieldNamesQuoteChar : string;
       UpdateWherePart(sql_where,x);
 
       if (pfInUpdate in Fields[x].ProviderFlags) then
-        sql_set := sql_set +FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar +'=:' + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar + ',';
+        sql_set := sql_set +FieldNamesQuoteChars[0] + fields[x].FieldName + FieldNamesQuoteChars[1] +'=:"' + fields[x].FieldName + '",';
       end;
 
     if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
@@ -1461,8 +1466,8 @@ var FieldNamesQuoteChar : string;
       begin
       if (not fields[x].IsNull) and (pfInUpdate in Fields[x].ProviderFlags) then
         begin
-        sql_fields := sql_fields + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar + ',';
-        sql_values := sql_values + ':' + FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar +',';
+        sql_fields := sql_fields + FieldNamesQuoteChars[0] + fields[x].FieldName + FieldNamesQuoteChars[1] + ',';
+        sql_values := sql_values + ':"' + fields[x].FieldName + '",';
         end;
       end;
     if length(sql_fields) = 0 then DatabaseErrorFmt(sNoUpdateFields,['insert'],self);
@@ -1493,10 +1498,7 @@ var qry : TCustomSQLQuery;
     Fld : TField;
 
 begin
-  if sqQuoteFieldnames in TSQLConnection(DataBase).ConnOptions then
-    FieldNamesQuoteChar := '"'
-  else
-    FieldNamesQuoteChar := '';
+  FieldNamesQuoteChars := TSQLConnection(DataBase).FieldNameQuoteChars;
 
   case UpdateKind of
     ukModify : begin

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -716,7 +716,8 @@ end;
 constructor TSQLite3Connection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash] + [sqQuoteFieldnames];
+  FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
+  FieldNameQuoteChars:=DoubleQuotes;
 end;
 
 procedure TSQLite3Connection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);

packages/fcl-db/tests/testfieldtypes.pas

@@ -28,8 +28,6 @@ type
     procedure RunTest; override;
   published
     procedure TestEmptyUpdateQuery; // bug 13654
-    procedure TestClearUpdateableStatus;
-    procedure TestReadOnlyParseSQL; // bug 9254
     procedure TestParseJoins; // bug 10148
     procedure TestDoubleFieldNames; // bug 8457
     procedure TestParseUnion; // bug 8442
@@ -46,7 +44,6 @@ type
     procedure TestBug9744;
     procedure TestCrossStringDateParam;
     procedure TestGetFieldNames;
-    procedure TestGetTables;
     procedure TestUpdateIndexDefs;
     procedure TestSetBlobAsMemoParam;
     procedure TestSetBlobAsBlobParam;
@@ -94,6 +91,9 @@ type
     // SchemaType tests
     procedure TestTableNames;
     procedure TestFieldNames;
+    procedure TestClearUpdateableStatus;
+    procedure TestReadOnlyParseSQL; // bug 9254
+    procedure TestGetTables;
   end;
 
 implementation
@@ -1157,7 +1157,7 @@ begin
       ParseSQL := True;
       AssertTrue(ParseSQL);
       AssertFalse(ReadOnly);
-      SQL.Text := 'select * from FPDEV;';
+      SQL.Text := 'select * from FPDEV';
       open;
       AssertTrue(ParseSQL);
       AssertFalse(ReadOnly);
@@ -1347,12 +1347,12 @@ begin
     AssertEquals(-1,query.RowsAffected);
     Connection.ExecuteDirect('create table FPDEV2 (         ' +
                               '  ID INT NOT NULL            , ' +
-                              '  "NAME-TEST" VARCHAR(250),  ' +
+                              '  '+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+' VARCHAR(250),  ' +
                               '  PRIMARY KEY (ID)           ' +
                               ')                            ');
 // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
     TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
-    Connection.ExecuteDirect('insert into FPDEV2(ID,"NAME-TEST") values (1,''test1'')');
+    Connection.ExecuteDirect('insert into FPDEV2(ID,'+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+') values (1,''test1'')');
     Query.SQL.Text := 'select * from FPDEV2';
     Query.Open;
     AssertEquals(1,Query.FieldByName('ID').AsInteger);

packages/fcl-web/src/custcgi.pp

@@ -71,6 +71,8 @@ Type
   protected
     Function GetEmail : String; override;
     Function GetAdministrator : String; override;
+    Function CreateResponse(AOutput : TStream) : TCGIResponse; virtual;
+    Function CreateRequest : TCGIRequest; virtual;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
   Public
@@ -184,13 +186,23 @@ begin
     Result:=SWebMaster;
 end;
 
+function TCustomCGIApplication.CreateResponse(AOutput : TStream): TCGIResponse;
+begin
+  TCGIResponse.CreateCGI(Self,AOutput);
+end;
+
+function TCustomCGIApplication.CreateRequest: TCGIRequest;
+begin
+  Result:=TCGIRequest.CreateCGI(Self);
+end;
+
 function TCustomCGIApplication.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 begin
-  FRequest:=TCGIRequest.CreateCGI(Self);
+  FRequest:=CreateRequest;
   FRequest.InitFromEnvironment;
   FRequest.InitRequestVars;
   FOutput:=TIOStream.Create(iosOutput);
-  FResponse:=TCGIResponse.CreateCGI(Self,Self.FOutput);
+  FResponse:=CreateResponse(FOutput);
   ARequest:=FRequest;
   AResponse:=FResponse;
   Result := True;
@@ -374,13 +386,20 @@ Function TCGIRequest.GetFieldValue(Index : Integer) : String;
 
 begin
   Case Index of
-    25 : Result:=Decodevar(5); // Property PathInfo
+    21,
+    34 : Result:=DecodeVar(14); // Property ServerName and Host
+    25 : begin
+         Result:=Decodevar(5); // Property PathInfo
+         If (Result='') then
+           Result:=Decodevar(34); // Property Request URI
+         end;
     26 : Result:=DecodeVar(6); // Property PathTranslated
     27 : Result:=DecodeVar(8); // Property RemoteAddress
     28 : Result:=DecodeVar(9); // Property RemoteHost
     29 : Result:=DecodeVar(13); // Property ScriptName
     30 : Result:=DecodeVar(15); // Property ServerPort
     31 : Result:=DecodeVar(12); // Property RequestMethod
+    32 : Result:=DecodeVar(34); // Property URI
     33 : Result:=DecodeVar(7); // Property QueryString
     36 : Result:=DecodeVar(36); // Property XRequestedWith
   else

packages/fcl-web/src/custfcgi.pp

@@ -336,7 +336,7 @@ begin
   Inherited Create(AOwner);
   FRequestsAvail:=5;
   SetLength(FRequestsArray,FRequestsAvail);
-  FHandle := -1;
+  FHandle := THandle(-1);
 end;
 
 destructor TCustomFCgiApplication.Destroy;
@@ -357,7 +357,7 @@ begin
       begin
       fpshutdown(FHandle,SHUT_RDWR);
       CloseSocket(FHandle);
-      FHandle := -1;
+      FHandle := THandle(-1);
       end;
     Request := Nil;
     Response := Nil;

packages/fcl-web/src/custweb.pp

@@ -80,6 +80,7 @@ Type
   Private
     FAdministrator: String;
     FAllowDefaultModule: Boolean;
+    FApplicationURL: String;
     FEmail: String;
     FModuleVar: String;
     FOnGetModule: TGetModuleEvent;
@@ -95,6 +96,8 @@ Type
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; virtual; abstract;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); virtual;
     function FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;
+    Procedure SetBaseURL(AModule : TCustomHTTPModule; Const AModuleName : String; ARequest : TRequest); virtual;
+    function GetApplicationURL(ARequest : TRequest): String; virtual;
     Procedure DoRun; override;
     procedure ShowRequestException(R: TResponse; E: Exception); virtual;
     Function GetEmail : String; virtual;
@@ -111,6 +114,7 @@ Type
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
     Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
+    Property ApplicationURL : String Read FApplicationURL Write FApplicationURL;
     Property Request : TRequest read FRequest;
     Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
     Property ModuleVariable : String Read FModuleVar Write FModuleVar;
@@ -253,20 +257,15 @@ begin
     If (MC=Nil) then
       begin
       MN:=GetModuleName(ARequest);
-      If (MN='') and Not AllowDefaultModule then
-        Raise EFPWebError.Create(SErrNoModuleNameForRequest);
       MI:=ModuleFactory.FindModule(MN);
-      If (MI=Nil) and (ModuleFactory.Count=1) then
-        MI:=ModuleFactory[0];
       if (MI=Nil) then
-        begin
         Raise EFPWebError.CreateFmt(SErrNoModuleForRequest,[MN]);
-        end;
       MC:=MI.ModuleClass;
       end;
     M:=FindModule(MC); // Check if a module exists already
     If (M=Nil) then
       M:=MC.Create(Self);
+    SetBaseURL(M,MN,ARequest);
     if M.Kind=wkOneShot then
       begin
       try
@@ -279,10 +278,7 @@ begin
       M.HandleRequest(ARequest,AResponse);
   except
     On E : Exception do
-      begin
-      ShowException(E);
       ShowRequestException(AResponse,E);
-      end;
   end;
 end;
 
@@ -305,19 +301,43 @@ begin
   Result := FEventLog;
 end;
 
+function TCustomWebApplication.GetApplicationURL(ARequest: TRequest): String;
+begin
+  Result:=FApplicationURL;
+  If (Result='') then
+    Result:=ARequest.ScriptName;
+end;
+
 function TCustomWebApplication.GetModuleName(Arequest: TRequest): string;
+
+   Function GetDefaultModuleName : String;
+
+   begin
+      If (ModuleFactory.Count=1) then
+        Result:=ModuleFactory[0].ModuleName;
+   end;
+
 var
   S : String;
+  I : Integer;
+
 begin
   If (FModuleVar<>'') then
     Result:=ARequest.QueryFields.Values[FModuleVar];//Module name from query parameter using the FModuleVar as parameter name (default is 'Module')
   If (Result='') then
     begin
     S:=ARequest.PathInfo;
-    Delete(S,1,1);
-    if (Pos('/',S) <= 0) and AllowDefaultModule then
-      Exit;//There is only 1 '/' in ARequest.PathInfo -> only ActionName is there -> use default module
-    Result:=ARequest.GetNextPathInfo;
+    If (Length(S)>0) and (S[1]='/') then
+      Delete(S,1,1);
+    I:=Pos('/',S);
+    if (I>0) then
+      Result:=ARequest.GetNextPathInfo;
+    end;
+  If (Result='') then
+    begin
+    if Not AllowDefaultModule then
+      Raise EFPWebError.Create(SErrNoModuleNameForRequest);
+    Result:=GetDefaultModuleName
     end;
 end;
 
@@ -340,6 +360,25 @@ begin
     Result:=Nil;
 end;
 
+procedure TCustomWebApplication.SetBaseURL(AModule: TCustomHTTPModule;
+  Const AModuleName : String; ARequest: TRequest);
+
+Var
+  S,P : String;
+
+begin
+  S:=IncludeHTTPPathDelimiter(GetApplicationURL(ARequest));
+  P:=IncludeHTTPPathDelimiter(ARequest.ProcessedPathinfo);
+  If (P='') or (P='/') then
+    P:=IncludeHTTPPathDelimiter(AModuleName);
+  if (Length(P)>0) and (P[1]='/') then
+    Delete(P,1,1);
+{$ifdef CGIDEBUG}
+  senddebug(Format('SetBaseURL : "%s" "%s"',[S,P]));
+{$endif CGIDEBUG}
+  AModule.BaseURL:=S+P;
+end;
+
 procedure TCustomWebApplication.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
 begin
   HandleRequest(ARequest,AResponse);

packages/fcl-web/src/fcgigate.pp

@@ -0,0 +1,609 @@
+{
+    $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.
+
+ **********************************************************************}
+{
+  fcgigate: implements TFastCGIGatewayApplication, an application that
+  acts as a CGI application and transforms CGI requests to FastCGI requests.
+
+  Usage is as simple as
+
+uses
+  fcgigate;
+
+begin
+  With Application do
+    begin
+      HostName:='127.0.0.1'; // Where is FastCGI app running ?
+      Port:=2015;  // What Port does it listen on ?
+      Initialize;
+      Run;
+    end;
+
+    Alternatively, an .ini file can be used:
+
+uses
+  fcgigate;
+
+begin
+  With Application do
+    begin
+      ConfigFileName:='/etc/mygate.ini';
+      Initialize;
+      Run;
+    end;
+
+}
+unit fcgigate;
+
+{ $define CGIGDEBUG}
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+{$IFDEF CGIGDEBUG}
+  dbugintf,
+{$endif}
+  Classes, SysUtils,httpDefs,custcgi,fastcgi,ssockets,inifiles;
+
+Type
+
+  { TCGIGateWayResponse }
+
+  TCGIGateWayResponse = Class(TCGIResponse)
+  Protected
+    Procedure DoSendHeaders(Headers : TStrings); override;
+  end;
+
+  { TFastCGIGatewayApplication }
+
+  TFastCGIGatewayApplication = Class(TCustomCGIApplication)
+  private
+    FConfigFile: String;
+    FFastCGIBinary: String;
+    FHostName: String;
+    FPort: Integer;
+    FSocket: TInetSocket;
+    FInitDone : Boolean;
+    FEnvironment : TStrings;
+    procedure DisconnectfromFCGI;
+    procedure SetConfigFile(const AValue: String);
+    procedure SetEnvironment(const AValue: TStrings);
+    procedure SetHostname(const AValue: String);
+  protected
+    // Auxiliary routines
+    Function CreateResponse(AOutput : TStream) : TCGIResponse; override;
+    Procedure CheckInitDone;
+    procedure RaiseError(const Msg: String);
+    // Configuration. Override to read additional values from .ini file.
+    procedure ReadConfigFile(Ini: TIniFile); virtual;
+    //  FASTCGI protocol
+    // Allocate record for content length AContentLength.
+    // Allocated size is AContentLength + SizeOf(FCGI_Header)
+    function CreateFastCGIRecord(const AContentLength: Word): PFCGI_Header;
+    // Read FastCGI record from socket. Result must be freed by called.
+    Function ReadFastCGIRecord: PFCGI_Header;
+    // Initialize memory containing fastcgi record header
+    procedure InitFastCGIRecord(P: PFCGI_Header; Const AContentLength, APadLength : Word);
+    // Send record over socket.
+    procedure SendFastCGIRecord(P: PFCGI_Header);
+    // Override this to handle FastCGI records that this class does not handle. Set EOR to 'True' if the request should be aborted.
+    procedure ProcessUnknownRecord(const Rec: PFCGI_Header; const AResponse: TResponse; var EOR: Boolean); virtual;
+    // Override this to send additional records when communication starts.
+    procedure SendBeginRequest; virtual;
+    // Transform CGI environment variables.
+    Function TransformRequestVars: String;virtual;
+    // Encode name=value pair for PARAMS fastcgi record.
+    Function EncodeFastCGIParam(N, V: AnsiString): String;
+    // High-level Communication
+    // Send data from request
+    procedure SendRequestData(const ARequest : TRequest); virtual;
+    // Read FastCGI response.
+    procedure ReadResponse(AResponse : TResponse); virtual;
+    // Start CGIBinary if initial connect failed.
+    procedure StartFCGIBinary;
+    // Connect to FastCGI server. Will call StartFCGIBinary.
+    procedure ConnectToFCGI;
+    // Properties
+    // Communication socket
+    Property Socket : TInetSocket Read FSocket Write FSocket;
+    // Initialize done ?
+    Property InitDone : Boolean Read FInitDone;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
+    Procedure Initialize; override;
+    Property ConfigFileName : String Read FConfigFile Write SetConfigFile;
+    Property FastCGIBinary : String Read FFastCGIBinary Write FFastCGIBinary;
+    Property HostName : String Read FHostName Write SetHostname;
+    Property Port : Integer Read FPort Write FPort;
+    // Values in here override CGI environment variables.
+    Property Environment : TStrings Read FEnvironment Write SetEnvironment;
+  end;
+
+Resourcestring
+  SErrCouldNotConnectToFCGI = 'Could not connect to FastCGI server.';
+  SErrNoConnectionData      = 'No FastCGI connection data available.';
+  SErrInitDone              = 'Operation must be performed prior to calling Initialize';
+
+Const
+  SConfig = 'FCGI';
+  KeyHost = 'Host';
+  KeyPort = 'Port';
+  KeyName = 'Name';
+  SEnvironment = 'Environment';
+  KeyPathInfo = 'Home';
+
+Var
+  Application : TFastCGIGatewayApplication;
+
+Procedure InitCGIGateWay; // Initializes Application.
+Procedure DoneCGIGateWay; // Frees Application.
+
+implementation
+
+
+
+{ TCGIGateWayResponse }
+
+procedure TCGIGateWayResponse.DoSendHeaders(Headers: TStrings);
+
+begin
+  // Do nothing. Headers are in response from FastCGI and are sent as content;
+end;
+
+procedure TFastCGIGatewayApplication.SetConfigFile(const AValue: String);
+begin
+  if FConfigFile=AValue then exit;
+  CheckInitDone;
+  FConfigFile:=AValue;
+end;
+
+procedure TFastCGIGatewayApplication.SetEnvironment(const AValue: TStrings);
+begin
+  FEnvironment.Assign(AValue);
+end;
+
+procedure TFastCGIGatewayApplication.SetHostname(const AValue: String);
+begin
+  if FHostName=AValue then exit;
+  CheckInitDone;
+  FHostName:=AValue;
+end;
+
+procedure TFastCGIGatewayApplication.CheckInitDone;
+begin
+  If FInitDone then
+    RaiseError(SErrInitDone);
+end;
+
+function TFastCGIGatewayApplication.CreateResponse(AOutput: TStream): TCGIResponse;
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('CreateResponse');{$ENDIF}
+  Result:=TCGIGatewayResponse.CreateCGI(Self,AOutput);
+{$IFDEF CGIGDEBUG}SendMethodExit('CreateResponse');{$ENDIF}
+end;
+
+Procedure TFastCGIGatewayApplication.StartFCGIBinary;
+
+begin
+  ExecuteProcess(FastCGIBinary,'',[]);
+end;
+
+Procedure TFastCGIGatewayApplication.ConnectToFCGI;
+
+begin
+  try
+    FSocket:=TInetSocket.Create(FHostName,FPort);
+  except
+    FSocket:=Nil;
+  end;
+  If (FSocket=Nil)
+     and ((LowerCase(Hostname)='localhost') or (Hostname='127.0.0.1'))
+     and (FastCGIBinary<>'') then
+    begin
+    StartFCGIBinary;
+    try
+      FSocket:=TInetSocket.Create(FHostName,FPort);
+    except
+      FSocket:=Nil;
+    end;
+    end;
+  If (FSocket=Nil) Then
+    RaiseError(SErrCouldNotConnectToFCGI);
+end;
+
+Function DebugString(Var S : String) : String;
+
+Var
+  I : Integer;
+
+begin
+  For I:=1 to length(S) do
+    If (ord(S[i]) in [32..127]) then
+      Result:=Result+S[i]
+    else
+      Result:=Result+Format('#%.3d',[Ord(S[i])]);
+end;
+
+Function TFastCGIGatewayApplication.EncodeFastCGIParam(N,V : AnsiString) : String;
+
+  Function CalcJump(ALen : Integer) : Integer;
+  begin
+    If ALen<128 then
+      Result:=1
+    else
+      Result:=4;
+  end;
+
+  Procedure AddLengthEncoding(Var S : String; ALen : Integer; Var Offset : Integer);
+
+  Var
+    J,L : integer;
+
+  begin
+    J:=CalcJump(ALen);
+    If (J=1) then
+      S[Offset] := AnsiChar(ALen)
+    else
+      begin
+      ALen:=NtoBE(ALen);
+      S[Offset]:=AnsiChar(((ALen shr 24) and $FF) + $80);
+      S[Offset+1]:=AnsiChar((ALen shr 16) and $FF);
+      S[Offset+2]:=AnsiChar((ALen shr  8) and $FF);
+      S[Offset+3]:=AnsiChar(ALen and $FF);
+      end;
+    if (Byte(S[Offset]) and 128) = 0 then
+      L:=Byte(S[Offset])
+    else
+      L:=BEtoN(PWord(@(S[Offset]))^);
+    inc(Offset,J);
+  end;
+
+
+var
+  J   : integer;
+  NLen,VLen : integer;
+  BlockSize : word;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('EncodeFastCGIParam');{$ENDIF}
+  NLen:=Length(N);
+  VLen:=Length(V);
+  BlockSize := NLen+CalcJump(NLen)+VLen+CalcJump(VLen);
+  SetLength(Result,BlockSize);
+  J:=1;
+  AddlengthEncoding(Result,NLen,J);
+  AddlengthEncoding(Result,VLen,J);
+  move(N[1],Result[J],NLen);
+  move(V[1],Result[J+NLen],VLen);
+{$IFDEF CGIGDEBUG}SendMethodExit('EncodeFastCGIParam');{$ENDIF}
+end;
+
+constructor TFastCGIGatewayApplication.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FEnvironment:=TStringList.Create;
+end;
+
+destructor TFastCGIGatewayApplication.Destroy;
+begin
+  FreeAndNil(FEnvironment);
+  inherited Destroy;
+end;
+
+Function TFastCGIGatewayApplication.TransformRequestVars : String;
+
+Var
+  L : TStringList;
+  I,J : Integer;
+  N,N2,V : String;
+
+begin
+  L:=TStringList.Create;
+  try
+    GetCGIVarList(L);
+    I:=0;
+    For I:=0 to L.Count-1 do
+      begin
+      L.GetNameValue(I,N,V);
+      J:=FEnvironment.IndexOfName(N);
+      If (J<>-1) then
+        L.GetNameValue(J,N2,V); // Keep original name
+      Result:=Result+EncodeFastCGIParam(N,V);
+      end;
+  finally
+    L.Free;
+  end;
+end;
+
+Procedure TFastCGIGatewayApplication.SendFastCGIRecord(P : PFCGI_Header);
+
+Var
+  Len : Integer;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('SendFastCGIRecord');{$ENDIF}
+  Len := BEtoN(P^.ContentLength) + P^.PaddingLength+sizeof(FCGI_Header);
+  FSocket.WriteBuffer(P^, Len);
+{$IFDEF CGIGDEBUG}SendMethodExit('SendFastCGIRecord');{$ENDIF}
+end;
+
+
+Procedure TFastCGIGatewayApplication.InitFastCGIRecord(P : PFCGI_Header; Const AContentLength, APadLength : Word);
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('InitFastCGIRecord');{$ENDIF}
+  FillChar(P^,SizeOf(FCGI_Header),#0);
+  P^.Version:=FCGI_VERSION_1;
+  P^.RequestID:=0;
+  P^.ContentLength:=NToBE(AContentLength);
+  P^.PaddingLength:=APadLength;
+{$IFDEF CGIGDEBUG}SendMethodExit('InitFastCGIRecord');{$ENDIF}
+end;
+
+function TFastCGIGatewayApplication.CreateFastCGIRecord(const AContentLength: Word) : PFCGI_Header;
+
+Var
+  L,PL : INteger;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('CreateFastCGIRecord');{$ENDIF}
+  PL:=AContentLength Mod 8;
+  If PL<>0 then
+    PL:=8-PL;
+  L:=SizeOf(FCGI_HEADER)+AContentLength+PL;
+  Result:=GetMem(L);
+  FillWord(Result^,L div 2,0);
+  InitFastCGIRecord(Result,AContentLength,PL);
+{$IFDEF CGIGDEBUG}SendMethodExit('CreateFastCGIRecord');{$ENDIF}
+end;
+
+Procedure TFastCGIGatewayApplication.SendBeginRequest;
+
+Var
+  Req : FCGI_BeginRequestRecord;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('SendBeginRequest');{$ENDIF}
+  FillChar(Req,SizeOf(FCGI_BeginRequestRecord),0);
+  InitFastCGIRecord(@Req,SizeOf(FCGI_BeginRequestBody),0);
+  Req.Header.ReqType:=FCGI_BEGIN_REQUEST;
+  Req.Body.Role:=NtoBE(FCGI_RESPONDER);
+  SendFastCGIRecord(@Req);
+{$IFDEF CGIGDEBUG}SendMethodExit('SendBeginRequest');{$ENDIF}
+end;
+
+
+Procedure TFastCGIGatewayApplication.SendRequestData(Const ARequest : Trequest);
+
+  Procedure SendString(S : String; RecType : Byte);
+
+  Var
+    L : Integer;
+    Cont : PFCGI_ContentRecord;
+
+  begin
+    {$IFDEF CGIGDEBUG}SendMethodEnter('SendString');{$ENDIF}
+    L:=Length(S);
+    Cont:=PFCGI_ContentRecord(CreateFastCGIrecord(L));
+    try
+      Cont^.Header.ReqType:=RecType;
+      If (L>0) then
+        Move(S[1],Cont^.ContentData[0],L);
+      SendFastCGIRecord(PFCGI_Header(Cont));
+    finally
+      FreeMem(Cont);
+    end;
+    {$IFDEF CGIGDEBUG}SendMethodExit('SendString');{$ENDIF}
+  end;
+
+Var
+  Vars : String;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('SendRequestData');{$ENDIF}
+  // Start request
+  SendBeginRequest;
+  // CGI environment.
+  Vars:=TransformRequestVars;
+  If (Vars<>'') then
+    begin
+    SendString(Vars,FCGI_PARAMS);
+    SendString('',FCGI_PARAMS);
+    end;
+  If (UpperCase(ARequest.Method)='POST') and (ARequest.ContentLength>0) then
+    SendString(ARequest.Content,FCGI_STDIN);
+  SendString('',FCGI_STDIN);
+{$IFDEF CGIGDEBUG}SendMethodExit('SendRequestData');{$ENDIF}
+end;
+
+Function TFastCGIGatewayApplication.ReadFastCGIRecord : PFCGI_Header;
+
+var
+  Header : FCGI_Header;
+  BytesRead : integer;
+  ContentLength : word;
+  PaddingLength : byte;
+  ReadBuf : Pchar;
+
+  function ReadBytes(ByteAmount : Word) : boolean;
+
+  begin
+   {$IFDEF CGIGDEBUG}SendMethodEnter('ReadBytes '+IntToStr(ByteAmount));{$ENDIF}
+    result := False;
+    if ByteAmount>0 then
+      begin
+      BytesRead := FSocket.Read(ReadBuf^, ByteAmount);
+      Result:=BytesRead=ByteAmount;
+      end;
+   {$IFDEF CGIGDEBUG}SendMethodExit('ReadBytes '+IntToStr(BytesRead));{$ENDIF}
+  end;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('ReadFastCGIRecord');{$ENDIF}
+  Result := Nil;
+  ReadBuf:=@Header;
+  if not ReadBytes(Sizeof(Header)) then
+    exit;
+  ContentLength:=BetoN(Header.contentLength);
+  PaddingLength:=Header.paddingLength;
+  Result:=Getmem(BytesRead+ContentLength+PaddingLength);
+  Result^:=Header;
+  ReadBuf:=Pchar(Result)+SizeOf(Header);
+  ReadBytes(ContentLength);
+  ReadBuf:=ReadBuf+BytesRead;
+  ReadBytes(PaddingLength);
+{$IFDEF CGIGDEBUG}SendMethodExit('ReadFastCGIRecord');{$ENDIF}
+end;
+
+Procedure TFastCGIGatewayApplication.ProcessUnknownRecord(Const Rec : PFCGI_Header; Const AResponse : TResponse; Var EOR : Boolean);
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
+{$IFDEF CGIGDEBUG}SendDebugFMT('Unknown record encountered : %d',[Rec^.ReqType]);{$ENDIF}
+  // Do nothing.
+{$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
+end;
+
+Procedure TFastCGIGatewayApplication.ReadResponse(AResponse : TResponse);
+
+Var
+  Rec : PFCGI_Header;
+  CL : Integer;
+  WBuf : PChar;
+  EOR : Boolean;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('ReadResponse');{$ENDIF}
+  EOR:=False;
+  Rec:=ReadFastCGIRecord;
+  While Assigned(Rec) do
+    begin
+    CL:=BeToN(Rec^.contentLength);
+    If (Rec^.reqtype=FCGI_STDOUT) and (CL>0) then
+      begin
+      if (AResponse.ContentStream=Nil) then
+         begin
+         AResponse.ContentStream:=TMemoryStream.Create;
+         end;
+      WBuf:=Pchar(Rec)+SizeOf(FCGI_Header);
+      AResponse.ContentStream.WriteBuffer(WBuf^,CL);
+      end
+    else If (Rec^.ReqType=FCGI_END_REQUEST) and (CL>0) then
+      EOR:=True
+    else
+      ProcessUnknownRecord(Rec,AResponse,EOR);
+   If Assigned(Rec) then
+     begin
+     FreeMem(Rec);
+     Rec:=Nil;
+     end;
+   If Not EOR then
+     Rec:=ReadFastCGIRecord
+   else
+     Rec:=Nil;
+   end;
+{$IFDEF CGIGDEBUG}SendMethodExit('ReadResponse');{$ENDIF}
+end;
+
+Procedure TFastCGIGatewayApplication.DisconnectfromFCGI;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('DisconnectfromFCGI');{$ENDIF}
+  FreeAndNil(FSocket);
+{$IFDEF CGIGDEBUG}SendMethodExit('DisconnectfromFCGI');{$ENDIF}
+end;
+
+Procedure TFastCGIGatewayApplication.HandleRequest(ARequest : Trequest; AResponse : TResponse);
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('Handle request');{$ENDIF}
+  ConnectToFCGI;
+  try
+    SendRequestData(ARequest);
+    ReadResponse(AResponse);
+    AResponse.SendResponse;
+  finally
+    DisconnectfromFCGI;
+  end;
+{$IFDEF CGIGDEBUG}SendMethodExit('Handle request');{$ENDIF}
+end;
+
+procedure TFastCGIGatewayApplication.RaiseError(Const Msg : String);
+
+begin
+  Raise HTTPError.Create(Msg);
+end;
+
+
+procedure TFastCGIGatewayApplication.ReadConfigFile(Ini : TIniFile);
+
+begin
+  With Ini do
+    begin
+    HostName:=ReadString(SConfig,KeyHost,'');
+    Port:=ReadInteger(SConfig,KeyPort,0);
+    FastCGIBinary:=ReadString(SConfig,KeyName,'');
+    If SectionExists(SEnvironment) then
+      ReadSectionValues(SEnvironment,FENvironment);
+    If ValueExists(SConfig,KeyPathInfo) then
+      FEnvironment.Values['PATH_INFO']:=ReadString(SConfig,KeyPathInfo,'');
+    end;
+end;
+
+procedure TFastCGIGatewayApplication.Initialize;
+
+Var
+  Ini : TIniFile;
+
+begin
+{$IFDEF CGIGDEBUG}SendMethodEnter('Initialize');{$ENDIF}
+  inherited Initialize;
+  If (FConfigFile<>'') and FileExists(FConfigFile) then
+    begin
+    Ini:=TIniFile.Create(FConfigFile);
+    try
+      ReadConfigFile(Ini);
+    finally
+      Ini.Free;
+    end;
+    end;
+  if (Hostname='') or (Port=0) then
+    RaiseError(SErrNoConnectionData);
+  FInitDone:=True;
+{$IFDEF CGIGDEBUG}SendMethodExit('Initialize');{$ENDIF}
+end;
+
+Procedure InitCGIGateWay; // Initializes Application.
+
+begin
+  Application:=TFastCGIGatewayApplication.Create(Nil);
+end;
+
+Procedure DoneCGIGateWay; // Frees Application.
+
+begin
+  FreeAndNil(Application);
+end;
+
+
+initialization
+  InitCGIGateWay;
+
+finalization
+  DoneCGIGateWay;
+
+end.
+

packages/fcl-web/src/fpapache.pp

@@ -83,6 +83,7 @@ Type
     Procedure DoRun; override;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
+    function GetApplicationURL(ARequest : TRequest): String; override;
   Public
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
@@ -247,6 +248,14 @@ begin
     FBeforeRequest(Self,HN,Result);
 end;
 
+function TCustomApacheApplication.GetApplicationURL(ARequest: TRequest
+  ): String;
+begin
+  Result:=inherited GetApplicationURL(ARequest);
+  If (Result='') then
+    Result:=BaseLocation;
+end;
+
 constructor TCustomApacheApplication.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
@@ -493,7 +502,7 @@ Constructor TApacheRequest.CreateReq(App : TCustomApacheApplication; ARequest :
 begin
   FApache:=App;
   FRequest:=Arequest;
-  ReturnedPathInfo:=App.BaseLocation;
+  ProcessedPathInfo:=App.BaseLocation;
   Inherited Create;
   InitFromRequest;
 end;

packages/fcl-web/src/fphtml.pp

@@ -69,24 +69,28 @@ type
     FBaseURL: string;
     FMessageBoxHandler: TMessageBoxHandler;
     FScriptName: string;
+    FScriptStack: TFPObjectList;
     procedure SetBaseURL(const AValue: string);
     procedure SetScriptName(const AValue: string);
   protected
     function GetScriptFileReferences: TStringList; virtual; abstract;
-    function GetCurrentJavaScriptStack: TJavaScriptStack; virtual; abstract;
+    function GetCurrentJavaScriptStack: TJavaScriptStack; virtual;
     function GetScripts: TFPObjectList; virtual; abstract;
     function GetRequest: TRequest;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure AddScriptFileReference(AScriptFile: String); virtual; abstract;
-    function InitializeJavaScriptStack: TJavaScriptStack; virtual; abstract;
+    function CreateNewJavascriptStack: TJavaScriptStack; virtual; abstract;
+    function InitializeJavaScriptStack: TJavaScriptStack;
+    procedure FreeJavascriptStack; virtual;
     function HasJavascriptStack: boolean; virtual; abstract;
     function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; virtual; abstract;
     procedure InitializeAjaxRequest; virtual;
     procedure InitializeShowRequest; virtual;
+    procedure CleanupShowRequest; virtual;
     procedure CleanupAfterRequest; virtual;
-    procedure FreeJavascriptStack; virtual; abstract;
+    procedure BeforeGenerateHead; virtual;
     procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); virtual; abstract;
     function MessageBox(AText: String; Buttons: TWebButtons): string; virtual;
     function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons): string; virtual; abstract;
@@ -110,6 +114,7 @@ type
     FSendXMLAnswer: boolean;
     FXMLAnswer: TXMLDocument;
     FRootNode: TDOMNode;
+    FWebController: TWebController;
     function GetXMLAnswer: TXMLDocument;
   public
     constructor Create(AWebController: TWebController; AResponse: TResponse); virtual;
@@ -1134,13 +1139,16 @@ constructor TAjaxResponse.Create(AWebController: TWebController;
 begin
   FSendXMLAnswer:=true;
   FResponse:=AResponse;
-  FJavascriptCallStack:=AWebController.InitializeJavaScriptStack;
+  FWebController := AWebController;
+  FJavascriptCallStack:=FWebController.InitializeJavaScriptStack;
 end;
 
 destructor TAjaxResponse.Destroy;
 begin
   FXMLAnswer.Free;
-  FJavascriptCallStack.Free;
+  assert(FWebController.CurrentJavaScriptStack=FJavascriptCallStack);
+  FWebController.FreeJavascriptStack;
+  FJavascriptCallStack:=nil;
   inherited Destroy;
 end;
 
@@ -1193,6 +1201,11 @@ begin
   FScriptName:=AValue;
 end;
 
+function TWebController.GetCurrentJavaScriptStack: TJavaScriptStack;
+begin
+  result := TJavaScriptStack(FScriptStack.Items[FScriptStack.Count-1]);
+end;
+
 procedure TWebController.InitializeAjaxRequest;
 begin
   // do nothing
@@ -1203,11 +1216,21 @@ begin
   // do nothing
 end;
 
+procedure TWebController.CleanupShowRequest;
+begin
+  // Do Nothing
+end;
+
 procedure TWebController.CleanupAfterRequest;
 begin
   // Do Nothing
 end;
 
+procedure TWebController.BeforeGenerateHead;
+begin
+  // do nothing
+end;
+
 function TWebController.MessageBox(AText: String; Buttons: TWebButtons): string;
 begin
   if assigned(MessageBoxHandler) then
@@ -1229,15 +1252,28 @@ begin
   inherited Create(AOwner);
   { TODO : Do this prperly using a notification. And make the WebController property readonly }
   if owner is TWebPage then TWebPage(Owner).WebController := self;
+  FScriptStack := TFPObjectList.Create(true);
 end;
 
 destructor TWebController.Destroy;
 begin
   if (Owner is TWebPage) and (TWebPage(Owner).WebController=self) then
     TWebPage(Owner).WebController := nil;
+  FScriptStack.Free;
   inherited Destroy;
 end;
 
+function TWebController.InitializeJavaScriptStack: TJavaScriptStack;
+begin
+  result := CreateNewJavascriptStack;
+  FScriptStack.Add(result);
+end;
+
+procedure TWebController.FreeJavascriptStack;
+begin
+  FScriptStack.Delete(FScriptStack.Count-1);
+end;
+
 
 end.
 

packages/fcl-web/src/fphttp.pp

@@ -34,6 +34,7 @@ Type
     FAfterResponse: TResponseEvent;
     FBeforeRequest: TRequestEvent;
     FRequest      : TRequest;
+    FResponse: TResponse;
   Protected
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean); virtual;
     Procedure DoGetContent(ARequest : TRequest; Content : TStream; Var Handled : Boolean); virtual;
@@ -48,6 +49,7 @@ Type
     Function  HaveContent : Boolean; virtual;
     function ContentToStream(Stream : TStream) : boolean; virtual;
     Property Request : TRequest Read FRequest;
+    Property Response : TResponse Read FResponse;
   end;
   
   { TCustomWebAction }
@@ -102,10 +104,12 @@ Type
 
   TCustomHTTPModule = Class(TDataModule)
   private
+    FBaseURL: String;
     FWebModuleKind: TWebModuleKind;
   public
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract;
     property Kind: TWebModuleKind read FWebModuleKind write FWebModuleKind default wkPooled;
+    Property BaseURL : String Read FBaseURL Write FBaseURL;
   end;
   
   TCustomHTTPModuleClass = Class of TCustomHTTPModule;
@@ -250,6 +254,7 @@ Var
   M : TMemoryStream;
   
 begin
+  FResponse:=AResponse;
   M:=TMemoryStream.Create;
   DoGetContent(ARequest,M,Handled);
   AResponse.ContentStream:=M;

packages/fcl-web/src/httpdefs.pp

@@ -267,7 +267,7 @@ type
     FHandleGetOnPost: Boolean;
     FURI: String;
     FFiles : TUploadedFiles;
-    FReturnedPathInfo : String;
+    FProcessedPathInfo : String;
     procedure ParseFirstHeaderLine(const line: String);override;
     function GetFirstHeaderLine: String;
   Protected
@@ -282,11 +282,11 @@ type
     Procedure InitRequestVars; virtual;
     Procedure InitPostVars; virtual;
     Procedure InitGetVars; virtual;
-    Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo;
   public
     constructor Create; override;
     destructor destroy; override;
     Function  GetNextPathInfo : String;
+    Property  ProcessedPathInfo : String Read FProcessedPathInfo Write FProcessedPathInfo;
     Property  CommandLine : String Read FCommandLine;
     Property  Command : String read FCommand;
     Property  URI : String read FURI;                // Uniform Resource Identifier
@@ -377,6 +377,7 @@ type
 
 Function HTTPDecode(const AStr: String): String;
 Function HTTPEncode(const AStr: String): String;
+Function IncludeHTTPPathDelimiter(const AStr: String): String;
 
 implementation
 
@@ -503,6 +504,18 @@ begin
   SetLength(Result,R-PChar(Result));
 end;
 
+function IncludeHTTPPathDelimiter(const AStr: String): String;
+
+Var
+  l : Integer;
+
+begin
+  Result:=AStr;
+  L:=Length(Result);
+  If (L>0) and (Result[L]<>'/') then
+    Result:=Result+'/';
+end;
+
 
 { ---------------------------------------------------------------------
   THTTPHeader
@@ -921,20 +934,19 @@ Var
   
 begin
   P:=PathInfo;
+{$ifdef CGIDEBUG}SendDebug(Format('Pathinfo: "%s" "%s"',[P,FProcessedPathInfo]));{$ENDIF}
   if (P <> '') and (P[length(P)] = '/') then
     Delete(P, length(P), 1);//last char is '/'
   If (P<>'') and (P[1]='/') then
     Delete(P,1,1);
+  Delete(P,1,Length(IncludeHTTPPathDelimiter(FProcessedPathInfo)));
+ {$ifdef CGIDEBUG}SendDebug(Format('Pathinfo: "%s" "%s"',[P,FProcessedPathInfo]));{$ENDIF}
   I:=Pos('/',P);
-  If (I>0) then
-  begin//only if there was a module name, otherwise only the action name is there
-    Delete(P,1,Length(FReturnedPathInfo));
-    I:=Pos('/',P);
-  end;
   If (I=0) then
     I:=Length(P)+1;
   Result:=Copy(P,1,I-1);
-  FReturnedPathInfo:=FReturnedPathInfo+'/'+Result;
+  FProcessedPathInfo:=IncludeHTTPPathDelimiter(FProcessedPathInfo)+Result;
+ {$ifdef CGIDEBUG}SendDebug(Format('Pathinfo: "%s" "%s" : %s',[P,FProcessedPathInfo,Result]));{$ENDIF}
 end;
 
 procedure TRequest.ParseFirstHeaderLine(const line: String);
@@ -1157,29 +1169,25 @@ begin
   SendMethodEnter('InitPostVars');
 {$endif}
   CL:=ContentLength;
-  M:=TCapacityStream.Create;
-  Try
-    if CL<>0 then
-      begin
-      M.Capacity:=Cl;
-      M.WriteBuffer(Content[1], Cl);
-      end;
-    M.Position:=0;
-    CT:=ContentType;
-    if Pos('MULTIPART/FORM-DATA',Uppercase(CT))<>0 then
-      ProcessMultiPart(M,CT, ContentFields)
-    else if Pos('APPLICATION/X-WWW-FORM-URLENCODED',Uppercase(CT))<>0 then
-      ProcessUrlEncoded(M, ContentFields)
-    else if CL<>0 then
-      begin
-{$ifdef CGIDEBUG}
-      SendDebug('InitPostVars: unsupported content type:'+CT);
-{$endif}
-      Raise Exception.CreateFmt(SErrUnsupportedContentType,[CT]);
-      end;
-  finally
-    M.Free;
-  end;
+  if CL<>0 then
+    begin
+    M:=TCapacityStream.Create;
+    Try
+      if CL<>0 then
+        begin
+        M.Capacity:=Cl;
+        M.WriteBuffer(Content[1], Cl);
+        end;
+      M.Position:=0;
+      CT:=ContentType;
+      if Pos('MULTIPART/FORM-DATA',Uppercase(CT))<>0 then
+        ProcessMultiPart(M,CT, ContentFields)
+      else if Pos('APPLICATION/X-WWW-FORM-URLENCODED',Uppercase(CT))<>0 then
+        ProcessUrlEncoded(M, ContentFields)
+    finally
+     M.Free;
+    end;
+    end;
 {$ifdef CGIDEBUG}
   SendMethodExit('InitPostVars');
 {$endif}

packages/fcl-web/src/webpage.pp

@@ -23,19 +23,15 @@ type
   TStandardWebController = class(TWebController)
   private
     FScriptFileReferences: TStringList;
-    FCurrentJavascriptStack: TJavaScriptStack;
     FScripts: TFPObjectList;
   protected
     function GetScriptFileReferences: TStringList; override;
     function GetScripts: TFPObjectList; override;
-    function GetCurrentJavaScriptStack: TJavaScriptStack; override;
-    procedure SetCurrentJavascriptStack(const AJavascriptStack: TJavaScriptStack);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    function InitializeJavaScriptStack: TJavaScriptStack; override;
+    function CreateNewJavascriptStack: TJavaScriptStack; override;
     function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; override;
-    procedure FreeJavascriptStack; override;
     procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); override;
     procedure AddScriptFileReference(AScriptFile: String); override;
     function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons): string; override;
@@ -207,6 +203,8 @@ begin
           WebController.InitializeShowRequest;
         DoBeforeShowPage(ARequest);
         AResponse.Content := ProduceContent;
+        if HasWebController then
+          WebController.CleanupShowRequest;
         end;
     finally
       CleanupAfterRequest;
@@ -333,16 +331,6 @@ begin
   Result:=FScripts;
 end;
 
-function TStandardWebController.GetCurrentJavaScriptStack: TJavaScriptStack;
-begin
-  Result:=FCurrentJavascriptStack;
-end;
-
-procedure TStandardWebController.SetCurrentJavascriptStack(const AJavascriptStack: TJavaScriptStack);
-begin
-  FCurrentJavascriptStack := AJavascriptStack;
-end;
-
 function TStandardWebController.CreateNewScript: TStringList;
 begin
   Result:=TStringList.Create;
@@ -400,12 +388,9 @@ begin
   inherited Destroy;
 end;
 
-function TStandardWebController.InitializeJavaScriptStack: TJavaScriptStack;
+function TStandardWebController.CreateNewJavascriptStack: TJavaScriptStack;
 begin
-  if assigned(FCurrentJavascriptStack) then
-    raise exception.Create('There is still an old JavascriptStack available');
-  FCurrentJavascriptStack := TJavaScriptStack.Create(self);
-  Result:=FCurrentJavascriptStack;
+  Result:=TJavaScriptStack.Create(self);
 end;
 
 function TStandardWebController.GetUrl(ParamNames, ParamValues,
@@ -491,11 +476,6 @@ begin
     result := result + ConnectChar + p
 end;
 
-procedure TStandardWebController.FreeJavascriptStack;
-begin
-  FreeAndNil(FCurrentJavascriptStack);
-end;
-
 procedure TStandardWebController.BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string);
 begin
   if AnEvent='onclick' then

packages/fcl-web/src/webutil.pp

@@ -20,13 +20,13 @@ interface
 uses
   Classes, SysUtils, httpdefs;
 
-procedure DumpRequest (ARequest : TRequest; Dump : TStrings);
+procedure DumpRequest (ARequest : TRequest; Dump : TStrings; Environment : Boolean = False);
 
 implementation
 
 
 
-procedure DumpRequest (ARequest : TRequest; Dump : TStrings);
+procedure DumpRequest (ARequest : TRequest; Dump : TStrings; Environment : Boolean = False);
 
   Procedure AddNV(Const N,V : String);
   
@@ -35,7 +35,7 @@ procedure DumpRequest (ARequest : TRequest; Dump : TStrings);
   end;
 
 Var
-  I   : integer;
+  I,J   : integer;
   N,V : String;
 begin
   With ARequest, Dump do
@@ -88,6 +88,23 @@ begin
         end;
       Add('</TABLE><P>');
       end;
+    If Environment then
+      begin
+      Add('<H1>Environment variables: ('+IntToStr(GetEnvironmentVariableCount)+') </H1>');
+      Add('<TABLE BORDER="1"><TR><TD>Name</TD><TD>Value</TD></TR>');
+      For I:=1 to GetEnvironmentVariableCount do
+        begin
+        V:=GetEnvironmentString(i);
+        j:=Pos('=',V);
+        If (J>0) then
+          begin
+          N:=Copy(V,1,J-1);
+          system.Delete(V,1,J);
+          AddNV(N,V);
+          end;
+        end;
+      Add('</TABLE><P>');
+      end;
     If (Files.Count>0) then
       begin
       Add('<H1>Uploaded files: ('+IntToStr(Files.Count)+') </H1>');

packages/fcl-web/tests/cgigateway.lpi

@@ -0,0 +1,303 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <Runnable Value="False"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <Title Value="cgigateway"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+      <ActiveWindowIndexAtStart Value="0"/>
+    </General>
+    <VersionInfo>
+      <Language Value=""/>
+      <CharSet Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="WebLaz"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="20">
+      <Unit0>
+        <Filename Value="cgigateway.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="cgigateway"/>
+        <IsVisibleTab Value="True"/>
+        <EditorIndex Value="0"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="1"/>
+        <CursorPos X="1" Y="17"/>
+        <UsageCount Value="105"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="../src/custweb.pp"/>
+        <UnitName Value="custweb"/>
+        <EditorIndex Value="9"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="85"/>
+        <CursorPos X="14" Y="96"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="53"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../../../../Documents/source/extpascal-svn/CGIGateway.dpr"/>
+        <UnitName Value="CGIGateway"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="84"/>
+        <CursorPos X="12" Y="86"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="51"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="../../../../Documents/source/extpascal-svn/BlockSocket.pas"/>
+        <UnitName Value="BlockSocket"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="57"/>
+        <CursorPos X="36" Y="57"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="51"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../../../rtl/inc/socketsh.inc"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="205"/>
+        <CursorPos X="10" Y="216"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="25"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="../../../rtl/inc/sockets.inc"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="318"/>
+        <CursorPos X="10" Y="333"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="25"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="../../fcl-net/src/ssockets.pp"/>
+        <UnitName Value="ssockets"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="546"/>
+        <CursorPos X="1" Y="567"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="51"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="../src/custcgi.pp"/>
+        <UnitName Value="custcgi"/>
+        <EditorIndex Value="8"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="189"/>
+        <CursorPos X="3" Y="191"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="53"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="../../../rtl/objpas/sysutils/osutilsh.inc"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="19"/>
+        <CursorPos X="10" Y="30"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="51"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="../src/fpfcgi.pp"/>
+        <UnitName Value="fpfcgi"/>
+        <EditorIndex Value="5"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="28"/>
+        <CursorPos X="5" Y="34"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="53"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="../src/custfcgi.pp"/>
+        <UnitName Value="custfcgi"/>
+        <EditorIndex Value="6"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="362"/>
+        <CursorPos X="1" Y="387"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="53"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="../../fastcgi/src/fastcgi.pp"/>
+        <UnitName Value="fastcgi"/>
+        <EditorIndex Value="7"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="11"/>
+        <CursorPos X="14" Y="27"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="53"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="../../../rtl/inc/systemh.inc"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="613"/>
+        <CursorPos X="10" Y="624"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="51"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="../../../rtl/inc/generic.inc"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="1979"/>
+        <CursorPos X="5" Y="1981"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="51"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="../src/httpdefs.pp"/>
+        <UnitName Value="HTTPDefs"/>
+        <EditorIndex Value="4"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="1"/>
+        <CursorPos X="1" Y="14"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="36"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="../../../rtl/objpas/classes/classesh.inc"/>
+        <EditorIndex Value="2"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="770"/>
+        <CursorPos X="15" Y="781"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="30"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="../../../rtl/objpas/classes/streams.inc"/>
+        <EditorIndex Value="3"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="133"/>
+        <CursorPos X="8" Y="136"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="30"/>
+        <Loaded Value="True"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="../../../../source/extpascal-svn/FCGIApp.pas"/>
+        <UnitName Value="FCGIApp"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="166"/>
+        <CursorPos X="50" Y="179"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="10"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="../../../../source/extpascal-svn/BlockSocket.pas"/>
+        <UnitName Value="BlockSocket"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="174"/>
+        <CursorPos X="3" Y="180"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <UsageCount Value="10"/>
+        <DefaultSyntaxHighlighter Value="Text"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="../src/fcgigate.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fcgigate"/>
+        <EditorIndex Value="1"/>
+        <WindowIndex Value="0"/>
+        <TopLine Value="21"/>
+        <CursorPos X="5" Y="44"/>
+        <UsageCount Value="23"/>
+        <Loaded Value="True"/>
+      </Unit19>
+    </Units>
+    <JumpHistory Count="4" HistoryIndex="3">
+      <Position1>
+        <Filename Value="../src/fpfcgi.pp"/>
+        <Caret Line="26" Column="15" TopLine="3"/>
+      </Position1>
+      <Position2>
+        <Filename Value="../src/fcgigate.pp"/>
+        <Caret Line="255" Column="38" TopLine="247"/>
+      </Position2>
+      <Position3>
+        <Filename Value="../src/httpdefs.pp"/>
+        <Caret Line="314" Column="11" TopLine="314"/>
+      </Position3>
+      <Position4>
+        <Filename Value="../src/fcgigate.pp"/>
+        <Caret Line="10" Column="1" TopLine="1"/>
+      </Position4>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)/"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <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/tests/cgigateway.pp

@@ -0,0 +1,17 @@
+program cgigateway;
+
+{$mode objfpc}{$H+}
+
+uses
+  fcgigate;
+
+begin
+  With Application do
+    begin
+      ConfigFileName:='';
+      HostName:='127.0.0.1';
+      Port:=2015;
+      Initialize;
+      Run;
+    end;
+end.

packages/fcl-web/tests/testcgiapp.lpi

@@ -0,0 +1,75 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <Title Value="CGI Test environment"/>
+      <ResourceType Value="res"/>
+      <Icon Value="0"/>
+    </General>
+    <VersionInfo>
+      <Language Value=""/>
+      <CharSet Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="testcgiapp.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testcgiapp"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <Target>
+      <Filename Value="testcgiapp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)/"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <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/tests/testcgiapp.pp

@@ -0,0 +1,277 @@
+program testcgiapp;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CustApp, inifiles, process, httpdefs,custcgi
+  { you can add units after this };
+
+type
+
+  { TTestCGIApplication }
+
+  TTestCGIApplication = class(TCustomApplication)
+  private
+    FCGB: String;
+    FCGIE: TStrings;
+    FCGV: TStrings;
+    FMethod: String;
+    Foutput: String;
+    FPostData: String;
+    FPathInfo : String;
+    FScriptName: String;
+    FURL: String;
+    procedure CheckEnvironment;
+    procedure CheckMethod;
+    procedure ProcessConfig;
+    procedure RunCGI;
+  protected
+    Property CGIEnvironment : TStrings Read FCGIE Write FCGIE;
+    Property URL : String Read FURL Write FURL;
+    Property PostData : String Read FPostData Write FPostData;
+    Property Method : String Read FMethod Write FMethod;
+    Property CGIOutput : String Read Foutput Write FOutput;
+    Property CGIBinary : String Read FCGB Write FCGB;
+    Property CGIVariables : TStrings Read FCGV Write FCGV;
+    Property PathInfo : String Read FPathInfo Write FPathInfo;
+    Property ScriptName : String Read FScriptName Write FScriptName;
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    Destructor Destroy; override;
+    procedure WriteHelp; virtual;
+  end;
+
+{ TTestCGIApplication }
+
+Resourcestring
+   SErrUnsupportedMethod = 'Unsupported method: "%s"';
+   SErrNoCGIBinary       = 'No CGI binary specified';
+
+Const
+  SConfig        = 'Config';
+  KeyURL         = 'URL';
+  KeyEnvironment = 'Environment';
+  KeyMethod      = 'Method';
+  KeyPost        = 'PostData';
+
+  SEnvironment   = KeyEnvironment;
+  SVariables     = 'Variables';
+
+
+procedure TTestCGIApplication.ProcessConfig;
+
+Var
+  Ini : TInifile;
+  S : String;
+
+begin
+  Ini:=TIniFile.Create(GetOptionValue('c','config'));
+  try
+    With Ini do
+      begin
+      URL:=ReadString(SConfig,KeyURL,'');
+      S:=ReadString(SConfig,KeyEnvironment,'');
+      If (S<>'') and FileExists(S) then
+        CGIEnvironment.LoadFromFile(S);
+      If SectionExists(SEnvironment) then
+        ReadSectionValues(SEnvironment,CGIEnvironment);
+      If SectionExists(SVariables) then
+        ReadSectionValues(SVariables,CGIVariables);
+      If (Method='') then
+        Method:=ReadString(SConfig,KeyMethod,'GET');
+      PostData:=ReadString(SConfig,KeyPost,'');
+
+      end;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TTestCGIApplication.RunCGI;
+
+Var
+  Proc : TProcess;
+
+begin
+  If (CGIBinary='') then
+      Raise Exception.Create(SerrNoCGIBinary);
+  Proc:=TProcess.Create(Self);
+  try
+    Proc.CommandLine:=CGIBinary;
+    Proc.Environment:=CGIEnvironment;
+    Proc.Execute;
+
+  finally
+    Proc.Free;
+  end;
+end;
+
+procedure TTestCGIApplication.CheckMethod;
+
+begin
+  If (Method='') then
+    Method:='GET'
+  else
+    begin
+    Method:=Uppercase(Method);
+    If (Method<>'POST') and (Method<>'GET') then
+      Raise Exception.CreateFmt(SerrUnsupportedMethod,['METHOD']);
+    end;
+end;
+(*
+   ({ 1: 'AUTH_TYPE'               } fieldWWWAuthenticate, // ?
+    { 2: 'CONTENT_LENGTH'          } FieldContentLength,
+    { 3: 'CONTENT_TYPE'            } FieldContentType,
+    { 4: 'GATEWAY_INTERFACE'       } '',
+    { 5: 'PATH_INFO'               } '',
+    { 6: 'PATH_TRANSLATED'         } '',
+    { 7: 'QUERY_STRING'            } '',
+    { 8: 'REMOTE_ADDR'             } '',
+    { 9: 'REMOTE_HOST'             } '',
+    { 10: 'REMOTE_IDENT'           } '',
+    { 11: 'REMOTE_USER'            } '',
+    { 12: 'REQUEST_METHOD'         } '',
+    { 13: 'SCRIPT_NAME'            } '',
+    { 14: 'SERVER_NAME'            } '',
+    { 15: 'SERVER_PORT'            } '',
+    { 16: 'SERVER_PROTOCOL'        } '',
+    { 17: 'SERVER_SOFTWARE'        } '',
+    { 18: 'HTTP_ACCEPT'            } FieldAccept,
+    { 19: 'HTTP_ACCEPT_CHARSET'    } FieldAcceptCharset,
+    { 20: 'HTTP_ACCEPT_ENCODING'   } FieldAcceptEncoding,
+    { 21: 'HTTP_IF_MODIFIED_SINCE' } FieldIfModifiedSince,
+    { 22: 'HTTP_REFERER'           } FieldReferer,
+    { 23: 'HTTP_USER_AGENT'        } FieldUserAgent,
+    { 24: 'HTTP_COOKIE'            } FieldCookie,
+     // Additional Apache vars
+    { 25: 'HTTP_CONNECTION'        } FieldConnection,
+    { 26: 'HTTP_ACCEPT_LANGUAGE'   } FieldAcceptLanguage,
+    { 27: 'HTTP_HOST'              } '',
+    { 28: 'SERVER_SIGNATURE'       } '',
+    { 29: 'SERVER_ADDR'            } '',
+    { 30: 'DOCUMENT_ROOT'          } '',
+    { 31: 'SERVER_ADMIN'           } '',
+    { 32: 'SCRIPT_FILENAME'        } '',
+    { 33: 'REMOTE_PORT'            } '',
+    { 34: 'REQUEST_URI'            } '',
+    { 35: 'CONTENT'                } '',
+    { 36: 'XHTTPREQUESTEDWITH'     } ''
+
+*)
+
+procedure TTestCGIApplication.CheckEnvironment;
+
+Var
+  L : TStrings;
+  S,N,V : String;
+  I : Integer;
+
+begin
+  L:=CGIEnvironment;
+  If L.IndexOfName('REQUEST_METHOD')=-1 then
+    L.Values['REQUEST_METHOD']:=Method;
+  S:=ScriptName;
+  If (S='') then
+    S:=CGIBinary;
+  If L.IndexOfName('SCRIPT_NAME')=-1 then
+    L.Values['SCRIPT_NAME']:=S;
+  If L.IndexOfName('SCRIPT_FILENAME')=-1 then
+    L.Values['SCRIPT_FILENAME']:=S;
+  If (PathInfo<>'') then
+    L.Values['PATH_INFO']:=PathInfo;
+  If (Method='GET') then
+    begin
+    If L.IndexOfName('QUERY_STRING')=-1 then
+      begin
+      S:='';
+      If (CGIVariables.Count>0) then
+        For I:=0 to CGIVariables.Count-1 do
+          begin
+          CGIVariables.GetNameValue(I,N,V);
+          If (S<>'') then
+            S:=S+'&';
+          S:=S+N+'='+HTTPEncode(V);
+          end;
+       L.Add('QUERY_STRING='+S)
+       end;
+    end
+end;
+
+
+procedure TTestCGIApplication.DoRun;
+var
+  ErrorMsg: String;
+begin
+  // parse parameters
+  if HasOption('h','help') then begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+  if HasOption('c','config') then
+    ProcessConfig;
+  If HasOption('u','url') then
+    URL:=GetOptionValue('u','url');
+  If HasOption('e','environment') then
+    CGIEnvironment.LoadFromFile(GetOptionValue('e','environment'));
+  If HasOption('o','output') then
+    CGIOutput:=GetOptionValue('o','output');
+  If HasOption('m','method') then
+    Method:=GetOptionValue('m','method');
+  If HasOption('p','pathinfo') then
+    PathInfo:=GetOptionValue('p','pathinfo');
+  If HasOption('s','scriptname') then
+    ScriptName:=GetOptionValue('s','scriptname');
+  If HasOption('r','variables') then
+    CGIOutput:=GetOptionValue('v','variables');
+  If HasOption('i','input') then
+    CGIBinary:=GetOptionValue('i','input');
+  CheckMethod;
+  CheckEnvironment;
+  RunCGI;
+  { add your program here }
+  // stop program loop
+  Terminate;
+end;
+
+constructor TTestCGIApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+  FCGIE:=TStringList.Create;
+  FCGV:=TStringList.Create;
+end;
+
+destructor TTestCGIApplication.Destroy;
+begin
+  FreeAndNil(FCGIE);
+  FreeAndNil(FCGV);
+  inherited Destroy;
+end;
+
+procedure TTestCGIApplication.WriteHelp;
+begin
+  Writeln('Usage: ',ExeName,' [options]');
+  Writeln('Where options is one of : ');
+  Writeln(' -h         this help');
+  Writeln(' -c|--config=file         use file for configuration');
+  Writeln(' -e|--environment=file    use file for CGI environment (overrides config).');
+  Writeln(' -i|--input=file          use file as CGI binary.');
+  Writeln(' -m|--method=method       use method to invoke CGI (overrides config, default is GET).');
+  Writeln(' -o|--output=file         use file for CGI output (overrides config).');
+  Writeln(' -p|--pathinfo=path       use path for PATH_INFO environment variable (overrides config).');
+  Writeln(' -r|--variables=file      read query variables from file (overrides config).');
+  Writeln(' -u|--url=URL             use URL as the URL (overrides config).');
+end;
+
+var
+  Application: TTestCGIApplication;
+
+begin
+  Application:=TTestCGIApplication.Create(nil);
+  Application.Title:='Test CGI application';
+  Application.Run;
+  Application.Free;
+end.
+

packages/sqlite/src/sqlite3db.pas

@@ -338,11 +338,8 @@ begin
    name:=StrAlloc (length(DBFileName)+1);
    strpcopy(name,DBFileName);
    OnData:=@SQLOnData;
-   writeln('Try to open');
    sqlite3_open(name,@fSQLite);
-   writeln('Open success');
    sqlite3_free(fPMsg);
-   writeln('Free memory');
    if fSQLite <> nil then
    begin
       //fVersion := String(SQLite_Version);

packages/sqlite/src/sqlitedb.pas

@@ -393,7 +393,6 @@ var Psql : pchar;
 begin
   Psql:=StrAlloc (length(Sql)+1);
   strpcopy(Psql,Sql);
-  Writeln('Testing: ',psql);
   Result := SQLite_Complete(Psql)<>0;
   strdispose(Psql);
 end;

rtl/objpas/classes/stringl.inc

@@ -1319,6 +1319,7 @@ begin
   FMap := TFPStrObjMap.Create;
   FMap.OnPtrCompare := @MapPtrCompare;
   FOnCompareText := @DefaultCompareText;
+  CheckSpecialChars;
 end;
 
 destructor TStringList.Destroy;