* Fixed the problem that an IPC-Server holds a lock on its pipe so that no

client could connect to it. Now a maximum of one client can connect to it.
 * Debugtest now shows an error immediately when it cant connect to a server
 * Use dbugsrv as default server name to start when no server is found
 * Set SendError when the startup of the debug-server failed
 * When connecting to the debug-server fails, clean up resources and set
   DebugDisabled to false, to avoid an AV on a second try

git-svn-id: trunk@12861 -

packages/fcl-base/examples/debugtest.pp

@@ -21,6 +21,11 @@ Var
 
 begin
   SendMethodEnter('Program');
+  If (SendError<>'') then
+    begin
+    Writeln('Error : ',SendError);
+    Exit;
+    end;
   Repeat
     Writeln('Enter message to send to debug server (STOP exits): ');
     Write('> ');

packages/fcl-process/src/dbugintf.pp

@@ -50,6 +50,7 @@ ResourceString
   SEntering = '> Entering ';
   SExiting  = '< Exiting ';
   SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<';
+  SServerStartFailed = 'Failed to start debugserver. (%s)';
 
 implementation
 
@@ -211,11 +212,14 @@ begin
   With TProcess.Create(Nil) do
     begin
     Try
-      CommandLine:='debugserver';
+      CommandLine:='dbugsrv';
       Execute;
       Result:=ProcessID;
-    Except
+    Except On E: Exception do
+      begin
+      SendError := Format(SServerStartFailed,[E.Message]);
       Result := 0;
+      end;
     end;
     Free;
     end;
@@ -258,6 +262,7 @@ begin
     if ServerID = 0 then
       begin
       DebugDisabled := True;
+      FreeAndNil(DebugClient);
       Exit;
       end
     else
@@ -269,7 +274,13 @@ begin
       Sleep(100);
       end;
     end;
-  DebugClient.Connect;
+  try
+    DebugClient.Connect;
+  except
+    FreeAndNil(DebugClient);
+    DebugDisabled:=True;
+    Raise;
+  end;
   MsgBuffer:=TMemoryStream.Create;
   Msg.MsgType:=lctIdentify;
   Msg.MsgTimeStamp:=Now;

packages/fcl-process/src/unix/simpleipc.inc

@@ -59,7 +59,10 @@ procedure TPipeClientComm.Connect;
 begin
   If Not ServerRunning then
     Owner.DoError(SErrServerNotActive,[Owner.ServerID]);
-  FStream:=TFileStream.Create(FFileName,fmOpenReadWrite);
+  // Use this line to allow more then one client communicating with one server
+  // at the same time
+  // FStream:=TFileStream.Create(FFileName,fmOpenWrite+fmShareDenyNone);
+  FStream:=TFileStream.Create(FFileName,fmOpenWrite);
 end;
 
 procedure TPipeClientComm.Disconnect;
@@ -127,7 +130,7 @@ begin
   If not FileExists(FFileName) then
     If (fpmkFifo(FFileName,438)<>0) then
       Owner.DoError(SErrFailedToCreatePipe,[FFileName]);
-  FStream:=TFileStream.Create(FFileName,fmOpenReadWrite);
+  FStream:=TFileStream.Create(FFileName,fmOpenReadWrite+fmShareDenyNone);
 end;
 
 procedure TPipeServerComm.StopServer;