* Fixed FastCGI listening on a port on Windows after r15099

git-svn-id: trunk@15616 -

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

@@ -156,7 +156,22 @@ end;
 
 
 Procedure TCustomCGIApplication.ShowException(E: Exception);
+var
+  LogStr: string;
+  FrameNumber: Integer;
+  Frames: PPointer;
+  FrameCount: integer;
+
 begin
+  logstr := 'Exception occured: ' + e.Message;
+
+  LogStr := LogStr + LineEnding + BackTraceStrFunc(ExceptAddr);
+  FrameCount:=ExceptFrameCount;
+  Frames:=ExceptFrames;
+  for FrameNumber := 0 to FrameCount-1 do
+    LogStr := LogStr + LineEnding + BackTraceStrFunc(Frames[FrameNumber]);
+  Log(etError,LogStr);
+
   if assigned(FResponse) then
     ShowRequestException(FResponse,E)
   else

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

@@ -495,10 +495,10 @@ begin
       Socket:=StdInputHandle;
     end;
 
-  if FHandle=-1 then
+  if FHandle=THandle(-1) then
     begin
     FHandle:=fpaccept(Socket,psockaddr(@IAddress),@AddressLength);
-    if FHandle=-1 then
+    if FHandle=THandle(-1) then
       raise Exception.CreateFmt(SNoInputHandle,[socketerror]);
     end;
 

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

@@ -1205,7 +1205,10 @@ end;
 
 function TWebController.GetCurrentJavaScriptStack: TJavaScriptStack;
 begin
-  result := TJavaScriptStack(FScriptStack.Items[FScriptStack.Count-1]);
+  if FScriptStack.Count=0 then
+    result := nil
+  else
+    result := TJavaScriptStack(FScriptStack.Items[FScriptStack.Count-1]);
 end;
 
 procedure TWebController.InitializeAjaxRequest;

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

@@ -397,15 +397,14 @@ end;
 function TCustomWebActions.GetActionName(ARequest: TRequest): String;
 
 begin
+  If (FActionVar<>'') then
+    Result:=ARequest.QueryFields.Values[FActionVar]
+  else
+    Result := '';
   If Assigned(FOnGetAction) then
     FOnGetAction(Self,ARequest,Result);
   If (Result='') then
-    begin
-    If (FActionVar<>'') then
-      Result:=ARequest.QueryFields.Values[FActionVar];
-    If (Result='') then
-      Result:=ARequest.GetNextPathInfo;
-    end;
+    Result:=ARequest.GetNextPathInfo;
 end;
 
 constructor TCustomWebActions.Create(AItemClass: TCollectionItemClass);

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

@@ -116,7 +116,7 @@ Type
   Protected
     Procedure DoBeforeRequest(ARequest : TRequest); virtual;
     Procedure DoAfterResponse(AResponse : TResponse); virtual;
-    Procedure GetParam(Const ParamName : String; Out Value : String); virtual; // Called by template
+    Procedure GetParam(Const ParamName : String; Out Value : String); // Called by template
     Procedure GetTemplateContent(ARequest : TRequest; AResponse : TResponse); virtual;
     function GetContent: String;virtual;
   Public
@@ -296,7 +296,7 @@ Type
     FRequest : TRequest;
   Public
     Constructor Create(AOwner :TCustomFPWebModule);
-    Procedure GetParam(Sender : TObject; Const ParamName : String; Out AValue : String);override;
+    Function GetParam(const Key: String; out AValue: String) : boolean; override;
     Property Owner : TCustomFPWebModule Read FOwner;
     Property Request : TRequest Read FRequest Write FRequest;
   end;
@@ -307,10 +307,11 @@ begin
   FOwner:=AOwner;
 end;
 
-procedure TFPWebTemplate.GetParam(Sender: TObject; const ParamName: String;
-  out AValue: String);
+function TFPWebTemplate.GetParam(const Key: String; out AValue: String) : boolean;
 begin
-  FOwner.GetParam(ParamName, AValue);
+  result := Inherited GetParam(Key, AValue);
+  if not result then
+    FOwner.GetParam(Key, AValue);
 end;
 
 { TFPWebModule }

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

@@ -1141,7 +1141,7 @@ begin
     if FHandleGetOnPost then
       InitGetVars;
     end
-  else if CompareText(R,'GET')=0 then
+  else if (CompareText(R,'GET')=0) or (CompareText(R,'HEAD')=0) then
     InitGetVars
   else
     Raise Exception.CreateFmt(SErrInvalidRequestMethod,[R]);

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

@@ -63,7 +63,6 @@ type
     procedure DoHandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse; var Handled: boolean); virtual;
     procedure DoBeforeRequest(ARequest: TRequest); virtual;
     procedure DoBeforeShowPage(ARequest: TRequest); virtual;
-    function IsAjaxCall: boolean; virtual;
     property WebModule: TFPWebModule read FWebModule;
     procedure DoCleanupAfterRequest(const AContentProducer: THTMLContentProducer);
     procedure SetRequest(ARequest: TRequest); virtual;
@@ -78,6 +77,7 @@ type
     function ExchangeContentProducers(Child1, Child2: THTMLContentProducer) : boolean;
     function MoveContentProducer(MoveElement, MoveBeforeElement: THTMLContentProducer) : boolean;
     procedure ForeachContentProducer(AForeachChildsProc: TForeachContentProducerProc; Recursive: boolean);
+    function IsAjaxCall: boolean; virtual;
 
     procedure HandlePage(ARequest: TRequest; AResponse: TResponse; AWriter: THTMLwriter; AWebModule: TFPWebModule = nil); virtual;
     procedure DoBeforeGenerateXML; virtual;

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

@@ -136,6 +136,7 @@ begin
     {$ifdef cgidebug}Senddebug('Creating iniwebsession');{$endif}
     W:=TFPWebSession.Create(Nil);
     W.SessionDir:=GlobalSessionDir;
+    W.Cached:=true;
     Result:=W;
     end;
 {$ifdef cgidebug}SendMethodExit('GetDefaultSession');{$endif}