Browse Source

Merged revisions 7434,7478 via svnmerge from
svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r7434 | joost | 2007-05-23 23:41:44 +0200 (Wed, 23 May 2007) | 1 line

* TCustomHTTPModule was not always created when needed.
........
r7478 | joost | 2007-05-25 23:02:05 +0200 (Fri, 25 May 2007) | 3 lines

* Added possibility to disable debugging
* Disable debugging if the server could not be found
* Catch exception if debugserver executable is not found
........

git-svn-id: branches/fixes_2_2@7993 -

joost 18 years ago
parent
commit
206c702767
2 changed files with 33 additions and 5 deletions
  1. 32 5
      packages/fcl-base/src/inc/dbugintf.pp
  2. 1 0
      packages/fcl-web/src/fpcgi.pp

+ 32 - 5
packages/fcl-base/src/inc/dbugintf.pp

@@ -34,10 +34,13 @@ procedure SendSeparator;
 procedure SendDebugFmt(const Msg: string; const Args: array of const);
 procedure SendDebugFmt(const Msg: string; const Args: array of const);
 procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel);
 procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel);
 
 
+procedure SetDebuggingEnabled(const AValue : boolean);
+function GetDebuggingEnabled : Boolean;
+
 { low-level routines }
 { low-level routines }
 
 
 Function  StartDebugServer : integer;
 Function  StartDebugServer : integer;
-Procedure InitDebugClient;
+Function InitDebugClient : Boolean;
 
 
 Const
 Const
   SendError       : String = '';
   SendError       : String = '';
@@ -65,6 +68,7 @@ var
   DebugClient : TSimpleIPCClient = nil;
   DebugClient : TSimpleIPCClient = nil;
   MsgBuffer : TMemoryStream = Nil;
   MsgBuffer : TMemoryStream = Nil;
   ServerID : Integer;
   ServerID : Integer;
+  DebugDisabled : Boolean;
   Indent : Integer = 0;
   Indent : Integer = 0;
   
   
 Procedure WriteMessage(Const Msg : TDebugMessage);
 Procedure WriteMessage(Const Msg : TDebugMessage);
@@ -79,6 +83,7 @@ end;
 procedure SendDebugMessage(Var Msg : TDebugMessage);
 procedure SendDebugMessage(Var Msg : TDebugMessage);
 
 
 begin
 begin
+  if DebugDisabled then exit;
   try
   try
     If (DebugClient=Nil) then
     If (DebugClient=Nil) then
       InitDebugClient;
       InitDebugClient;
@@ -190,16 +195,29 @@ begin
   SendDebugMessage(Mesg);
   SendDebugMessage(Mesg);
 end;
 end;
 
 
+procedure SetDebuggingEnabled(const AValue: boolean);
+begin
+  DebugDisabled := not AValue;
+end;
+
+function GetDebuggingEnabled: Boolean;
+begin
+  Result := not DebugDisabled;
+end;
+
 function StartDebugServer : Integer;
 function StartDebugServer : Integer;
 
 
 begin
 begin
   With TProcess.Create(Nil) do
   With TProcess.Create(Nil) do
+    begin
     Try
     Try
       CommandLine:='debugserver';
       CommandLine:='debugserver';
       Execute;
       Execute;
       Result:=ProcessID;
       Result:=ProcessID;
-    Finally
-      Free;
+    Except
+      Result := 0;
+    end;
+    Free;
     end;
     end;
 end;
 end;
 
 
@@ -224,18 +242,26 @@ begin
   end;
   end;
 end;
 end;
 
 
-Procedure InitDebugClient;
+Function InitDebugClient : Boolean;
 
 
 Var
 Var
   msg : TDebugMessage;
   msg : TDebugMessage;
   I : Integer;
   I : Integer;
   
   
 begin
 begin
+  Result := False;
   DebugClient:=TSimpleIPCClient.Create(Nil);
   DebugClient:=TSimpleIPCClient.Create(Nil);
   DebugClient.ServerID:=DebugServerID;
   DebugClient.ServerID:=DebugServerID;
   If not DebugClient.ServerRunning then
   If not DebugClient.ServerRunning then
     begin
     begin
     ServerID:=StartDebugServer;
     ServerID:=StartDebugServer;
+    if ServerID = 0 then
+      begin
+      DebugDisabled := True;
+      Exit;
+      end
+    else
+      DebugDisabled := False;
     I:=0;
     I:=0;
     While (I<10) and not DebugClient.ServerRunning do
     While (I<10) and not DebugClient.ServerRunning do
       begin
       begin
@@ -249,10 +275,11 @@ begin
   Msg.MsgTimeStamp:=Now;
   Msg.MsgTimeStamp:=Now;
   Msg.Msg:=Format(SProcessID,[ApplicationName]);
   Msg.Msg:=Format(SProcessID,[ApplicationName]);
   WriteMessage(Msg);
   WriteMessage(Msg);
+  Result := True;
 end;
 end;
 
 
 Initialization
 Initialization
-
+  DebugDisabled := False;
 Finalization
 Finalization
   FreeDebugClient;
   FreeDebugClient;
 end.
 end.

+ 1 - 0
packages/fcl-web/src/fpcgi.pp

@@ -121,6 +121,7 @@ Var
   
   
 begin
 begin
   MC:=Nil;
   MC:=Nil;
+  M:=Nil;
   If (OnGetModule<>Nil) then
   If (OnGetModule<>Nil) then
     OnGetModule(Self,ARequest,MC);
     OnGetModule(Self,ARequest,MC);
   If (MC=Nil) then
   If (MC=Nil) then