* Allow local temp dir, change permissions. Fixes issue #39690

packages/fcl-process/src/simpleipc.pp

@@ -119,10 +119,13 @@ type
   Private
     procedure SetActive(const AValue: Boolean);
     procedure SetServerID(const AValue: String);
+    procedure SetSystemGlobal(const AValue: Boolean);
   Protected
     FBusy: Boolean;
     FActive : Boolean;
+    FSystemGlobal : Boolean;
     FServerID : String;
+    procedure CheckServerID(aValue : string);
     procedure PrepareServerID;
     Procedure DoError(const Msg: String; const Args: array of const);
     Procedure CheckInactive;
@@ -133,6 +136,7 @@ type
     Property Busy : Boolean Read FBusy;
   Published
     Property Active : Boolean Read FActive Write SetActive;
+    Property SystemGlobal : Boolean Read FSystemGlobal Write SetSystemGlobal;
     Property ServerID : String Read FServerID Write SetServerID;
   end;
 
@@ -147,6 +151,7 @@ type
     DefaultMaxAction = ipcmoaNone;
     DefaultMaxQueue = 0;
   private
+    FGlobal: Boolean;
     FOnMessageError: TMessageQueueEvent;
     FOnMessageQueued: TNotifyEvent;
     FOnMessage: TNotifyEvent;
@@ -154,7 +159,6 @@ type
     FQueue: TIPCServerMsgQueue;
     FQueueLock: TCriticalSection;
     FQueueAddEvent: TSimpleEvent;
-    FGlobal: Boolean;
     // Access to the message is not locked by design!
     // In the threaded mode, it must be accessed only during event callbacks.
     FMessage: TIPCServerMsg;
@@ -178,10 +182,10 @@ type
     function GetMaxAction: TIPCMessageOverflowAction;
     function GetMaxQueue: Integer;
     function GetStringMessage: String;
-    procedure SetGlobal(const AValue: Boolean);
     procedure SetMaxAction(AValue: TIPCMessageOverflowAction);
     procedure SetMaxQueue(AValue: Integer);
     procedure SetThreaded(AValue: Boolean);
+    procedure SetGlobal(AValue: Boolean);
     procedure SetThreadTimeout(AValue: Integer);
     procedure SetSynchronizeEvents(AValue: Boolean);
     function WaitForReady(Timeout: Integer = -1): Boolean;
@@ -218,7 +222,7 @@ type
     property  ThreadExecuting: Boolean read FThreadExecuting;
     property  ThreadError: String read FThreadError;
   Published
-    Property Global : Boolean Read FGlobal Write SetGlobal;
+    Property Global : Boolean Read FGlobal write SetGlobal default false;
     // Called during ReadMessage
     Property OnMessage : TNotifyEvent Read FOnMessage Write FOnMessage;
     // Called when a message is pushed on the queue.
@@ -276,6 +280,7 @@ type
     Procedure SendStringMessage(MsgType : TMessageType; const Msg : String);
     Procedure SendStringMessageFmt(const Msg : String; Args : Array of const);
     Procedure SendStringMessageFmt(MsgType : TMessageType; const Msg : String; Args : Array of const);
+  published
     Property  ServerInstance : String Read FServerInstance Write SetServerInstance;
   end;
 
@@ -539,7 +544,7 @@ end;
 
 {$REGION 'TSimpleIPC'}
 
-Procedure TSimpleIPC.DoError(const Msg: String; const Args: array of const);
+procedure TSimpleIPC.DoError(const Msg: String; const Args: array of const);
 var
   FullMsg: String;
 begin
@@ -583,6 +588,7 @@ begin
   if (FServerID<>AValue) then
   begin
     CheckInactive;
+    CheckServerID(aValue);
     FServerID:=AValue;
   end;
 end;
@@ -608,6 +614,21 @@ begin
   end;
 end;
 
+procedure TSimpleIPC.SetSystemGlobal(const AValue: Boolean);
+begin
+  CheckInactive;
+  FSystemGlobal:=AValue;
+end;
+
+procedure TSimpleIPC.CheckServerID(aValue: string);
+var
+  OK : Boolean;
+begin
+  OK:=(Pos('\',aValue)=0) and (Pos('/',aValue)=0) and (Pos(':',aValue)=0);
+  if not OK then
+    Raise EIPCError.Create('Characters / \ and : not allowed in server ID');
+end;
+
 {$ENDREGION}
 
 {$REGION 'TIPCServerThread'}
@@ -681,16 +702,17 @@ begin
   inherited Destroy;
 end;
 
-procedure TSimpleIPCServer.SetGlobal(const AValue: Boolean);
+
+procedure TSimpleIPCServer.SetThreaded(AValue: Boolean);
 begin
   CheckInactive;
-  FGlobal:=AValue;
+  FThreaded:=AValue;
 end;
 
-procedure TSimpleIPCServer.SetThreaded(AValue: Boolean);
+procedure TSimpleIPCServer.SetGlobal(AValue: Boolean);
 begin
   CheckInactive;
-  FThreaded:=AValue;
+  FGlobal:=AValue;
 end;
 
 procedure TSimpleIPCServer.SetThreadTimeout(AValue: Integer);

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

@@ -49,7 +49,7 @@ Type
     FFileName: String;
     FStream: TFileStream;
   Public
-    Constructor Create(AOWner : TSimpleIPCClient); override;
+    Constructor Create(aOwner : TSimpleIPCClient); override;
     Procedure Connect; override;
     Procedure Disconnect; override;
     Procedure SendMessage(MsgType : TMessageType; AStream : TStream); override;
@@ -62,14 +62,14 @@ Type
 implementation
 {$endif}
 
-constructor TPipeClientComm.Create(AOWner: TSimpleIPCClient);
+constructor TPipeClientComm.Create(aOwner: TSimpleIPCClient);
 begin
-  inherited Create(AOWner);
+  inherited Create(aOwner);
   FFileName:=Owner.ServerID;
   If (Owner.ServerInstance<>'') then
     FFileName:=FFileName+'-'+Owner.ServerInstance;
   if FFileName[1]<>'/' then
-    FFileName:=GetTempDir(true)+FFileName;
+    FFileName:=GetTempDir(aOwner.SystemGlobal)+FFileName;
 end;
 
 
@@ -109,7 +109,7 @@ begin
   Result:=FileExists(FFileName);
   // it's possible to have a stale file that is not open for reading which will
   // cause fpOpen to hang/block later when .Active is set to true while it
-  // wait's for the pipe to be opened on the other end
+  // waits for the pipe to be opened on the other end
   if Result then
   begin
     // O_WRONLY | O_NONBLOCK causes fpOpen to return -1 if the file is not open for reading
@@ -155,10 +155,10 @@ constructor TPipeServerComm.Create(AOWner: TSimpleIPCServer);
 begin
   inherited Create(AOWner);
   FFileName:=Owner.ServerID;
-  If Not Owner.Global then
+  If Owner.Global then
     FFileName:=FFileName+'-'+IntToStr(fpGetPID);
   if FFileName[1]<>'/' then
-    FFileName:=GetTempDir(Owner.Global)+FFileName;
+    FFileName:=GetTempDir(Owner.SystemGlobal)+FFileName;
 end;
 
 
@@ -173,6 +173,8 @@ begin
   If not FileExists(FFileName) then
     If (fpmkFifo(FFileName,438)<>0) then
       DoError(SErrFailedToCreatePipe,[FFileName]);
+  if not Owner.Global then
+    fpChmod(FFileName,&600);
   FStream:=TFileStream.Create(FFileName,fmOpenReadWrite+fmShareDenyNone,Rights[Owner.Global]);
 end;
 

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

@@ -151,6 +151,8 @@ end;
 procedure TWinMsgServerComm.StartServer;
 begin
   StopServer;
+  // There should be a way to limit permissions to the same user if SystemGlobal is false.
+  // Apparently the only way is to check the origin of a message when receiving a message...
   FHWND := AllocateHWND(WideString(FWindowName));
 end;