[fpc-devel] simpleipc issues
Ondrej Pokorny
lazarus at kluug.net
Sat Oct 3 19:54:13 CEST 2015
On 03.10.2015 19:21, Tomas Hajny wrote:
> Thanks, I tested it under OS/2 now. Both the "simple" and "advanced"
> test programs work, well done! I noticed two issues when running the
> "advanced" tests, though. First, the server increases the CPU
> considerably. There seems to be a loop permanently searching for a
> file FindFirst without any sleep in between. Maybe related to
> PeekRequest calls? Second, I noticed that unlike the "simple" test,
> the "advanced" leaves a temporary file 'hello-NNNN-t' in the
> temporary directory after finishing.
>
> Apart from that, I replaced the hard-coded '*' with a reference to
> AllFilesMask constant defined in unit System, because some of FPC
> targets need a different mask when searching for all files (that is
> not the case of OS/2, but e.g. GO32v2 would need that if not running
> on a LFN enabled system) - committed in svn trunk.
>
Attached patched for FPC and Lazarus to sync advancedipc.pp. The current
version in FPC trunk is out-dated (the Lazarus trunk version just misses
the AllFilesMask constant).
I could not reproduce the "temporary file 'hello-NNNN-t' was not
deleted" problem. Actually all files should be deleted in
StopServer(True) or Free -> DeletePendingRequests.
What demo did you observe the problem in? TestIPC_Server/TestIPC_Client?
Ondrej
-------------- next part --------------
Index: packages/fcl-base/src/advancedipc.pp
===================================================================
--- packages/fcl-base/src/advancedipc.pp (revision 31926)
+++ packages/fcl-base/src/advancedipc.pp (working copy)
@@ -30,7 +30,11 @@
{$IFDEF UNIX}
baseunix,
{$endif}
- sysutils, Classes;
+ sysutils, Classes
+ {$IF FPC_FULLVERSION<20701}
+ ,LazUTF8SysUtils
+ {$ENDIF}
+ ;
const
HEADER_VERSION = 2;
@@ -60,13 +64,14 @@
FMessageVersion: Integer;
protected
class function ServerIDToFileName(const aServerID: string; const aGlobal: Boolean): string;
- function GetResponseFileName(const aMsgID: Integer): string;
+ function GetResponseFileName(const aRequestID: Integer): string;
function GetResponseFileName(const aRequestFileName: string): string;
- function GetPeekedRequestFileName(const aMsgID: Integer): string;
+ function GetPeekedRequestFileName(const aRequestID: Integer): string;
function GetPeekedRequestFileName(const aRequestFileName: string): string;
function GetRequestPrefix: string;
- function GetRequestFileName(const aMsgID: Integer): string;
- function RequestFileNameToMsgID(const aFileName: string): Integer;
+ function GetRequestFileName(const aRequestID: Integer): string;
+ function RequestFileNameToID(const aFileName: string): Integer;
+ function RequestExists(const aRequestFileName: string): Boolean;
function GetUniqueRequest(out outFileName: string): Integer;
procedure SetServerID(const aServerID: string); virtual;
@@ -122,19 +127,19 @@
public
//peek request and read the message into a stream
function PeekRequest(const aStream: TStream; out outMsgType: TMessageType): Boolean; overload;
- function PeekRequest(const aStream: TStream; out outMsgID: Integer; out outMsgType: TMessageType): Boolean; overload;
- function PeekRequest(const aStream: TStream; out outMsgID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
+ function PeekRequest(const aStream: TStream; out outRequestID: Integer; out outMsgType: TMessageType): Boolean; overload;
+ function PeekRequest(const aStream: TStream; out outRequestID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
//only peek request, you have to read/delete the request manually with ReadRequest/DeleteRequest
function PeekRequest(out outMsgType: TMessageType): Boolean; overload;
- function PeekRequest(out outMsgID: Integer; out outMsgType: TMessageType): Boolean; overload;
- function PeekRequest(out outMsgID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
+ function PeekRequest(out outRequestID: Integer; out outMsgType: TMessageType): Boolean; overload;
+ function PeekRequest(out outRequestID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
//read a peeked request (that hasn't been read yet)
- function ReadRequest(const aMsgID: Integer; const aStream: TStream): Boolean;
+ function ReadRequest(const aRequestID: Integer; const aStream: TStream): Boolean;
//delete a peeked request (that hasn't been read yet)
- procedure DeleteRequest(const aMsgID: Integer);
+ procedure DeleteRequest(const aRequestID: Integer);
//post response to a request
- procedure PostResponse(const aMsgID: Integer; const aMsgType: TMessageType; const aStream: TStream);
+ procedure PostResponse(const aRequestID: Integer; const aMsgType: TMessageType; const aStream: TStream);
//find the highest request ID from all pending requests
function FindHighestPendingRequestId: Integer;
@@ -217,11 +222,21 @@
begin
Randomize;
repeat
- Result := Random(High(Integer));
+ //if Randomize/Random is started from 2 processes at exactly same moment, it returns the same number! -> prevent duplicates by xor GetCurrentThreadId
+ //the result must be of range 0..$7FFFFFFF (High(Integer))
+ Result := Integer((PtrInt(Random($7FFFFFFF)) xor PtrInt(GetCurrentThreadId)) and $7FFFFFFF);
outFileName := GetRequestFileName(Result);
- until not FileExists(outFileName);
+ until not RequestExists(outFileName);
end;
+function TIPCBase.RequestExists(const aRequestFileName: string): Boolean;
+begin
+ Result :=
+ (FileExists(aRequestFileName) or
+ FileExists(GetResponseFileName(aRequestFileName)) or
+ FileExists(GetPeekedRequestFileName(aRequestFileName)));
+end;
+
class function TIPCBase.ServerRunning(const aServerID: string;
const aGlobal: Boolean): Boolean;
var
@@ -271,8 +286,8 @@
xStream := TFileStream.Create(aFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
try
xStream.WriteBuffer(xHeader, SizeOf(xHeader));
- if Assigned(aStream) then
- xStream.CopyFrom(aStream, 0);
+ if Assigned(aStream) and (aStream.Size-aStream.Position > 0) then
+ xStream.CopyFrom(aStream, aStream.Size-aStream.Position);
xStream.Position := 0;//unlocking
xHeader.FileLock := 0;
@@ -282,7 +297,7 @@
end;
end;
-function TIPCBase.RequestFileNameToMsgID(const aFileName: string): Integer;
+function TIPCBase.RequestFileNameToID(const aFileName: string): Integer;
begin
//the function prevents all responses/temp files to be handled
//only valid response files are returned
@@ -295,7 +310,7 @@
class procedure TIPCBase.FindRunningServers(const aServerIDPrefix: string;
const outServerIDs: TStrings; const aGlobal: Boolean);
var
- xRec: TRawByteSearchRec;
+ xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
begin
if FindFirst(ServerIDToFileName(aServerIDPrefix+AllFilesMask, aGlobal), faAnyFile, xRec) = 0 then
begin
@@ -309,9 +324,9 @@
FindClose(xRec);
end;
-function TIPCBase.GetPeekedRequestFileName(const aMsgID: Integer): string;
+function TIPCBase.GetPeekedRequestFileName(const aRequestID: Integer): string;
begin
- Result := GetPeekedRequestFileName(GetRequestFileName(aMsgID));
+ Result := GetPeekedRequestFileName(GetRequestFileName(aRequestID));
end;
function TIPCBase.GetPeekedRequestFileName(const aRequestFileName: string
@@ -320,9 +335,9 @@
Result := aRequestFileName+'-t';
end;
-function TIPCBase.GetRequestFileName(const aMsgID: Integer): string;
+function TIPCBase.GetRequestFileName(const aRequestID: Integer): string;
begin
- Result := GetRequestPrefix+IntToHex(aMsgID, 8);
+ Result := GetRequestPrefix+IntToHex(aRequestID, 8);
end;
function TIPCBase.GetRequestPrefix: string;
@@ -330,9 +345,9 @@
Result := FFileName+'-';
end;
-function TIPCBase.GetResponseFileName(const aMsgID: Integer): string;
+function TIPCBase.GetResponseFileName(const aRequestID: Integer): string;
begin
- Result := GetResponseFileName(GetRequestFileName(aMsgID));
+ Result := GetResponseFileName(GetRequestFileName(aRequestID));
end;
function TIPCBase.GetResponseFileName(const aRequestFileName: string): string;
@@ -378,7 +393,8 @@
xFileResponse := GetResponseFileName(FLastMsgFileName);
if CanReadMessage(xFileResponse, xStream, outMsgType, xMsgLen) then
begin
- aStream.CopyFrom(xStream, xMsgLen);
+ if xMsgLen > 0 then
+ aStream.CopyFrom(xStream, xMsgLen);
xStream.Free;
aStream.Position := 0;
DeleteFile(xFileResponse);
@@ -443,7 +459,7 @@
procedure TIPCServer.DeletePendingRequests;
var
- xRec: TRawByteSearchRec;
+ xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
xDir: string;
begin
xDir := ExtractFilePath(FFileName);
@@ -456,9 +472,9 @@
FindClose(xRec);
end;
-procedure TIPCServer.DeleteRequest(const aMsgID: Integer);
+procedure TIPCServer.DeleteRequest(const aRequestID: Integer);
begin
- DeleteFile(GetPeekedRequestFileName(aMsgID));
+ DeleteFile(GetPeekedRequestFileName(aRequestID));
end;
constructor TIPCServer.Create(aOwner: TComponent);
@@ -470,7 +486,7 @@
destructor TIPCServer.Destroy;
begin
- if FActive then
+ if Active then
StopServer;
inherited Destroy;
@@ -480,7 +496,7 @@
outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer
): Integer;
var
- xRec: TRawByteSearchRec;
+ xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
begin
outFileName := '';
outStream := nil;
@@ -490,7 +506,7 @@
if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
begin
repeat
- Result := RequestFileNameToMsgID(xRec.Name);
+ Result := RequestFileNameToID(xRec.Name);
if Result >= 0 then
begin
outFileName := GetRequestFileName(Result);
@@ -504,20 +520,16 @@
function TIPCServer.FindHighestPendingRequestId: Integer;
var
- xRec: TRawByteSearchRec;
- xMsgID, xHighestId: LongInt;
+ xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
+ xRequestID: LongInt;
begin
- xHighestId := -1;
Result := -1;
if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
begin
repeat
- xMsgID := RequestFileNameToMsgID(xRec.Name);
- if xMsgID > xHighestId then
- begin
- xHighestId := xMsgID;
- Result := xMsgID;
- end;
+ xRequestID := RequestFileNameToID(xRec.Name);
+ if xRequestID > Result then
+ Result := xRequestID;
until FindNext(xRec) <> 0;
end;
FindClose(xRec);
@@ -525,13 +537,13 @@
function TIPCServer.GetPendingRequestCount: Integer;
var
- xRec: TRawByteSearchRec;
+ xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
begin
Result := 0;
if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
begin
repeat
- if RequestFileNameToMsgID(xRec.Name) >= 0 then
+ if RequestFileNameToID(xRec.Name) >= 0 then
Inc(Result);
until FindNext(xRec) <> 0;
end;
@@ -538,7 +550,7 @@
FindClose(xRec);
end;
-function TIPCServer.PeekRequest(out outMsgID: Integer; out
+function TIPCServer.PeekRequest(out outRequestID: Integer; out
outMsgType: TMessageType): Boolean;
var
xStream: TStream;
@@ -547,8 +559,8 @@
begin
outMsgType := -1;
xMsgFileName := '';
- outMsgID := FindFirstRequest(xMsgFileName, xStream, outMsgType, xMsgLen);
- Result := outMsgID >= 0;
+ outRequestID := FindFirstRequest(xMsgFileName, xStream, outMsgType, xMsgLen);
+ Result := outRequestID >= 0;
if Result then
begin
xStream.Free;
@@ -556,7 +568,7 @@
end;
end;
-function TIPCServer.PeekRequest(out outMsgID: Integer; out
+function TIPCServer.PeekRequest(out outRequestID: Integer; out
outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
var
xStart: QWord;
@@ -564,7 +576,7 @@
Result := False;
xStart := GetTickCount64;
repeat
- if PeekRequest(outMsgID, outMsgType) then
+ if PeekRequest(outRequestID, outMsgType) then
Exit(True)
else if aTimeOut > 20 then
Sleep(10);
@@ -573,42 +585,42 @@
function TIPCServer.PeekRequest(out outMsgType: TMessageType): Boolean;
var
- xMsgID: Integer;
+ xRequestID: Integer;
begin
- Result := PeekRequest(xMsgID, outMsgType);
+ Result := PeekRequest(xRequestID, outMsgType);
end;
-function TIPCServer.PeekRequest(const aStream: TStream; out outMsgID: Integer;
+function TIPCServer.PeekRequest(const aStream: TStream; out outRequestID: Integer;
out outMsgType: TMessageType): Boolean;
begin
- Result := PeekRequest(outMsgID, outMsgType);
+ Result := PeekRequest(outRequestID, outMsgType);
if Result then
- Result := ReadRequest(outMsgID, aStream);
+ Result := ReadRequest(outRequestID, aStream);
end;
-function TIPCServer.PeekRequest(const aStream: TStream; out outMsgID: Integer;
+function TIPCServer.PeekRequest(const aStream: TStream; out outRequestID: Integer;
out outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
begin
- Result := PeekRequest(outMsgID, outMsgType, aTimeOut);
+ Result := PeekRequest(outRequestID, outMsgType, aTimeOut);
if Result then
- Result := ReadRequest(outMsgID, aStream);
+ Result := ReadRequest(outRequestID, aStream);
end;
function TIPCServer.PeekRequest(const aStream: TStream; out
outMsgType: TMessageType): Boolean;
var
- xMsgID: Integer;
+ xRequestID: Integer;
begin
- Result := PeekRequest(aStream, xMsgID, outMsgType);
+ Result := PeekRequest(aStream, xRequestID, outMsgType);
end;
-procedure TIPCServer.PostResponse(const aMsgID: Integer;
+procedure TIPCServer.PostResponse(const aRequestID: Integer;
const aMsgType: TMessageType; const aStream: TStream);
begin
- DoPostMessage(GetResponseFileName(aMsgID), aMsgType, aStream);
+ DoPostMessage(GetResponseFileName(aRequestID), aMsgType, aStream);
end;
-function TIPCServer.ReadRequest(const aMsgID: Integer; const aStream: TStream
+function TIPCServer.ReadRequest(const aRequestID: Integer; const aStream: TStream
): Boolean;
var
xStream: TStream;
@@ -617,15 +629,15 @@
xFileRequest: string;
begin
aStream.Size := 0;
- xFileRequest := GetPeekedRequestFileName(aMsgID);
+ xFileRequest := GetPeekedRequestFileName(aRequestID);
Result := CanReadMessage(xFileRequest, xStream, xMsgType, xMsgLen);
if Result then
begin
- aStream.CopyFrom(xStream, xMsgLen);
+ if xMsgLen > 0 then
+ aStream.CopyFrom(xStream, xMsgLen);
xStream.Free;
aStream.Position := 0;
DeleteFile(xFileRequest);
- Exit(True);
end;
end;
@@ -647,6 +659,9 @@
function TIPCServer.StartServer(const aDeletePendingRequests: Boolean): Boolean;
begin
+ if Active then
+ Exit(True);
+
FFileHandle := FileCreate(FFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
Result := (FFileHandle<>feInvalidHandle);
FActive := Result;
@@ -656,13 +671,12 @@
function TIPCServer.StopServer(const aDeletePendingRequests: Boolean): Boolean;
begin
- if not FActive then
+ if not Active then
Exit(True);
if FFileHandle<>feInvalidHandle then
FileClose(FFileHandle);
Result := DeleteFile(FFileName);
- FFileName := '';
if aDeletePendingRequests then
DeletePendingRequests;
@@ -671,4 +685,3 @@
end;
end.
-
-------------- next part --------------
Index: ide/advancedipc.pp
===================================================================
--- ide/advancedipc.pp (revision 49932)
+++ ide/advancedipc.pp (working copy)
@@ -312,7 +312,7 @@
var
xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
begin
- if FindFirst(ServerIDToFileName(aServerIDPrefix+'*', aGlobal), faAnyFile, xRec) = 0 then
+ if FindFirst(ServerIDToFileName(aServerIDPrefix+AllFilesMask, aGlobal), faAnyFile, xRec) = 0 then
begin
repeat
if (Pos('-', xRec.Name) = 0) and//file that we found is a pending message
@@ -463,7 +463,7 @@
xDir: string;
begin
xDir := ExtractFilePath(FFileName);
- if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+ if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
begin
repeat
DeleteFile(xDir+xRec.Name);
@@ -503,7 +503,7 @@
outMsgType := -1;
outMsgLen := 0;
Result := -1;
- if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+ if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
begin
repeat
Result := RequestFileNameToID(xRec.Name);
@@ -524,7 +524,7 @@
xRequestID: LongInt;
begin
Result := -1;
- if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+ if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
begin
repeat
xRequestID := RequestFileNameToID(xRec.Name);
@@ -540,7 +540,7 @@
xRec: {$IF FPC_FULLVERSION>=20701}TRawByteSearchRec{$ELSE}TSearchRec{$ENDIF};
begin
Result := 0;
- if FindFirst(GetRequestPrefix+'*', faAnyFile, xRec) = 0 then
+ if FindFirst(GetRequestPrefix+AllFilesMask, faAnyFile, xRec) = 0 then
begin
repeat
if RequestFileNameToID(xRec.Name) >= 0 then
More information about the fpc-devel
mailing list