Until now, I was calling the following function every second :
function TForm1.ListeConnecteMaj():Boolean;
var
i : integer;
List : TIdContextList;
Client : TSimpleClient;
begin
List := TCPServer1.Contexts.LockList;
try
NbSConnect := List.Count;
for i := 0 to List.Count -1 do
begin
Client := List[i];
..... // getting information from Client
end;
finally
TCPServeur1.Contexts.UnlockList;
end;
end;
As I need to support hundreds of simultaneaous connections, I want to reduce as much as possible the duration of the LockList.
I've tried this. It works but is it really safe ?
function TForm1.ListeConnecteMaj():Boolean;
var
i : integer;
List : TIdContextList;
Client : TSimpleClient;
begin
List := TCPServer.Contexts.LockList;
TCPServeur.Contexts.UnlockList;
try
NbSConnect := List.Count;
for i := 0 to List.Count -1 do
begin
Client := List[i];
..... // getting information from Client
end;
finally
end;
end;
It works but is it really safe?
No, it is not thread-safe.
You can safely use List reference acquired by LockList until you call UnlockList. The moment you call UnlockList, list will no longer be protected and any List access after that point can cause concurrency issues.
Your original code is the proper way to use LockList/UnlockList.
As #DalijaPrasnikar's answer explains, your proposal is not safe, no. As soon as the list is unlocked, the server is able to freely modify the contents of the list as clients connect and disconnect, which will cause concurrency issues with your code.
I would suggest a different approach - rather than polling the client list every second, I would use the OnConnect and OnDisconnect events to add/remove elements from your UI as needed whenever the client list changes. If you are trying to track status updates per client during socket operations, you can post notifications to the main UI thread as they happen.
Thanks for your answers.
Following this CheckQueue exemple would it be possible to do the following :
replace " List := TCPServer.Contexts.LockList;" with " List.Assign(TCPServer.Contexts.LockList); "
Related
My primary goal is to run two time consuming functions or procedures one after the other has finished executing. My current approach is to place the second function invocation after the while loop (assuming I have passed one Interface type object to it in the AsyncMultiSync array param) in the code below I got from AsyncCalls Documentation.md in Github. Additionally, when I am trying to run the exact provided code below, I see that the threads do their job and the execution reaches to the first access to the vcl thread Memo but the second access to the memo freezes the application (for directories having quite a lot of files in the GetFiles call) P.S. English is not my first language and I might have trouble explaining it but if you demote this for title or MCVE, it will be my last question here as per SO rules.
uses
..AsyncCalls;
{ Ex - 2 using global function }
function GetFiles(Directory: string; Filenames: TStrings): Integer;
var
h: THandle;
FindData: TWin32FindData;
begin
h := FindFirstFile(PChar(Directory + '\*.*'), FindData);
if h <> INVALID_HANDLE_VALUE then
begin
repeat
if (StrComp(FindData.cFileName, '.') <> 0) and (StrComp(FindData.cFileName, '..') <> 0) then
begin
Filenames.Add(Directory + '\' + FindData.cFileName);
if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
GetFiles(Filenames[Filenames.Count - 1], Filenames);
end;
until not FindNextFile(h, FindData);
Winapi.Windows.FindClose(h);
end;
Result := 0;
end;
procedure TForm1.ButtonGetFilesClick(Sender: TObject);
var
i: integer;
Dir1Files, Dir2Files: TStrings;
Dir1, Dir2 IAsyncCall;
begin
Dir1Files := TStringList.Create;
Dir2Files := TStringList.Create;
ButtonGetFiles.Enabled := False;
try
Dir1 := TAsyncCalls.Invoke<string, TStrings>(GetFiles, 'C:\portables\autoit-v3', Dir1Files);
Dir2 := TAsyncCalls.Invoke<string, TStrings>(GetFiles, 'E:\mySyntax-Repository-works', Dir2Files);
{ Wait until both async functions have finished their work. While waiting make the UI
reacting on user interaction. }
while AsyncMultiSync([Dir1, Dir2], True, 10) = WAIT_TIMEOUT do
Application.ProcessMessages;
{ Form1.Caption := 'after file search';}
MemoFiles.Lines.Assign(Dir1Files);
MemoFiles.Lines.AddStrings(Dir2Files); {-->causes freeze}
finally
ButtonGetFiles.Enabled := True;
Dir2Files.Free;
Dir1Files.Free;
end;
end;
One alternative solution to use is JvThread as it contains well commented demos. Multiple JvThread objects can be wired via onFinish events to start one after another. If required, that many Sync functions can be constructed to talk to the VCL thread where race risk exists(between the thread and the VCL thread). And if required, each JvThread can be force-finished i.e.'breaked' by terminating it, based on some logic, inside of the thread execution code or in the associated Sync function in the VCL thread. How is it different from using timers or threaded timers triggering each other one after another in the first place given we use quite a few global form fields? Answer is there is no onFinish equivalent for timers and it will take more effort and less elegance to achieve the same. Omnithread is somewhat restrictive for its BSD licence, Native threads beat the RAD spirit of Delphi, and Task library not available in lighter installs like XE5.
I am using IP*Works! V9. I try to restrict the returned emails to only the one matching a restriction using SearchMailbox. My code looks like this:
lIMap.Mailbox := 'INBOX';
lIMap.SelectMailbox;
lIMap.CheckMailbox;
lIMap.Config('FETCHAFTERSEARCH=True');
lIMap.SearchMailbox('SUBJECT Diessenhofen UNSEEN');
if (lIMap.MessageCount > 0) then
begin
...
end;
MessageCount always reflects the total number of emails instead of one (there is one match in my inbox).
The IMAP server is Kereo
The documentation says it doesn't work like that. SearchMailbox doesn't restrict what's available to you, instead it calls a user-supplied function and fires an even once for each message in the search result.
Thanks to the answer of #arnt, I figured out a solution that works for me.
Yes, for every Message that corresponds to the search criteria, the event OnMessageInfo is fired.
Since I need to go through all messages in a loop, I ended up doing this:
procedure TReadIMapObjectsFavFktProperty.MessageInfo(Sender: TObject;
const MessageId, Subject, MessageDate, From, Flags: String;
Size:Int64);
begin
if (MessageList.IndexOf(MessageId) < 0) then
begin
MessageList.Add(MessageId);
end;
end;
where MessageList is a TStringList with delimiter ',';
I can then get all messages using either
lIMap.MessageSet := MessageList.Text;
again firing the same event or loop through them using the size of the MessageList like this:
for aa := 0 to MessageList.Count - 1 do
begin
lIMap.MessageSet := MessageList.Strings[aa];
lIMap.FetchMessageInfo;
...
end;
I want to restrict the number of incoming connections that a TIdTcpServer can take, but the rule I need to apply is a little complex, so I don't think the MaxConnections property will work for me.
I have an application running N servers, each using a different protocol on a different port. I need to limit the total number of clients across all N servers. So for example, with 16 servers, and 16 clients allowed, I would allow one client on each, or 16 all on a single server.
It's possible I could manipulate the MaxConnections dynamically to fix this (e.g. set them all to zero when I determine we're 'full', and back to 16 or whatever when we're not full, but this feels a little too tricksy.
Is there some kind of virtual IsConnectionAllowed method that I can override with my own logic, or a suitable place in the connection process where I can raise an exception if I determine the limit has been exceeded?
Create a new component - TIdTCPServerCollection for example - which is the "owner" of all server components.
In this component, declare a thread-safe property which stores the available - currently unused - connection count.
In the server connect and disconnect logic, decrement / increment this variable, and set MaxConnections to reflect the new limit.
One option might be to implement a custom TIdScheduler class that derives from one of the TIdSchedulerofThread... components and override its virtual AcquireYarn() method to either:
raise an EAbort exception if the scheduler's ActiveYarns list has reached the max allowed number of connections. This might cause too tight a loop in TIdTCPServer listening threads, though. To mitigate that, you could put a small timer in the method and only raise the exception if the list remains maxed out for a short period of time.
block the calling thread (the TIdTCPServer listening thread) until the ActiveYarns has fewer yarns than your max connection limit, then call the inherited method to return a new TIdYarn object normally.
For example:
type
TMyScheduler = class(TIdSchedulerOfThreadDefault)
public
function AcquireYarn: TIdYarn; override;
end;
function TMyScheduler.AcquireYarn: TIdYarn;
begin
if not ActiveYarns.IsCountLessThan(SomeLimit) then
begin
Sleep(1000);
if not ActiveYarns.IsCountLessThan(SomeLimit) then
Abort;
end;
Result := inherited;
end;
Then assign a single instance of this class to the Scheduler property of all the servers. TIdTCPServer calls AcquireYarn() before accepting a new client connection.
Another option, for Windows only, would be to derive a new TIdStack class from TIdStackWindows and override its virtual Accept() method to use Winsock's WSAAccept() function instead of its accept() function. WSAAccept() allows you to assign a callback function that decides whether a new client is accepted or rejected based on criteria passed to the callback (QOS, etc). That callback could check a global counter you maintain for how many active connections are running (or just sum up all of the servers' active Contexts counts), and then return CF_REJECT if the limit has been reached, otherwise return CF_ACCEPT. You could then use the SetStackClass() function in the IdStack unit to assign your class as the active Stack for all Indy socket connections.
For example:
type
TMyStack = class(TIdStackWindows)
public
function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
end;
function MyAcceptCallback(lpCallerId: LPWSABUF; lpCallerData: LPWSABUF; lpSQOS, pGQOS: LPQOS; lpCalleeId, lpCalleeData: LPWSABUF; g: PGROUP; dwCallbackData: DWORD_PTR): Integer; stdcall;
begin
if NumActiveConnections >= SomeLimit then
Result := CF_REJECT
else
Result := CF_ACCEPT;
end;
function TMyStack.Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
var
LSize: Integer;
LAddr: SOCKADDR_STORAGE;
begin
LSize := SizeOf(LAddr);
//Result := IdWinsock2.accept(ASocket, IdWinsock2.PSOCKADDR(#LAddr), #LSize);
Result := IdWinsock2.WSAAccept(ASocket, IdWinsock2.PSOCKADDR(#LAddr), #LSize, #MyAcceptCallback, 0);
if Result <> INVALID_SOCKET then begin
case LAddr.ss_family of
Id_PF_INET4: begin
VIP := TranslateTInAddrToString(PSockAddrIn(#LAddr)^.sin_addr, Id_IPv4);
VPort := ntohs(PSockAddrIn(#LAddr)^.sin_port);
VIPVersion := Id_IPv4;
end;
Id_PF_INET6: begin
VIP := TranslateTInAddrToString(PSockAddrIn6(#LAddr)^.sin6_addr, Id_IPv6);
VPort := ntohs(PSockAddrIn6(#LAddr)^.sin6_port);
VIPVersion := Id_IPv6;
end;
else begin
CloseSocket(Result);
Result := INVALID_SOCKET;
IPVersionUnsupported;
end;
end;
end;
end;
initialization
SetStackClass(TMyStack);
This way, Indy will never see any rejected client connections at all, and you do not have to worry about implementing any other hacks inside of TIdTCPServer or its various dependencies. Everything will work normally and simply block as expected whenever TIdStack.Accept() does not return an accepted client.
I'm doing just for fun an unread messages checker application in Delphi. I'm using Indy 10. I can connect with Gmail and can retrieve all the messages but I'm facing a problem here: I cannot tell if a message is already read or not. There is a flag property in the TidMessage component that should tell me if the message has been read.
The code looks like this:
procedure TForm1.btTestConnectionClick(Sender: TObject);
var
i: Integer;
count: Integer;
flag: TIdMessageFlags;
begin
if (pop3Test.Connected) then begin
pop3Test.Disconnect;
end;
pop3Test.Username := edAccount.Text;
pop3Test.Password := edPassword.Text;
pop3Test.Host := HOST;
pop3Test.AuthType := patUserPass;
pop3Test.Port := PORT;
pop3Test.Connect;
Count := 0;
for i := pop3Test.CheckMessages downto 1 do begin
pop3Test.Retrieve(i, IdMessage1);
if (mfSeen in IdMessage1.Flags) then begin
Count := Count + 1;
end;
end;
ShowMessage(IntToStr(Count));
pop3Test.Disconnect;
end;
In the test mailbox there is one unread message but all the retrieved messages have the flags enum property empty so the result is always 0. Am I doing something wrong? Is it a problem of Indy/Gmail compatibility?
Thanks.
EDIT: I'm definitely doing something wrong as testing with a Hotmail account shows the same empty-flags property problem.
the POP3 protocol does not support Message state information on the server like read, replied to, or deleted . try using IMAP for Gmail instead.
The best (and quickest) way to find this answer would be to search the Indy sourcecode for "mfSeen" You should find it only utilized in idIMAP* units. RRUZ is correct - POP3 doesn't offer this inherent ability. In POP3 you need to track this on the client side. This flag was added to IdMessage for IMAP purposes, and not necessarily for POP3.
TIdMessageFlags should likely have been named TIdIMAPMessageFlags
I use Indy for TCP communication (D2009, Indy 10).
After evaluating a client request, I want to send the answer to the client. I therefore store the TIdContext, like this (pseudocode)
procedure ConnectionManager.OnIncomingRequest (Context : TIdContext);
begin
Task := TTask.Create;
Task.Context := Context;
ThreadPool.AddTask (Task);
end;
procedure ThreadPool.Execute (Task : TTask);
begin
// Perform some computation
Context.Connection.IOHandler.Write ('Response');
end;
But what if the client terminates the connection somewhere between the request and the answer being ready for sending? How can I check if the context is still valid? I tried
if Assigned (Context) and Assigned (Context.Connection) and Context.Connection.Connected then
Context.Connection.IOHandler.Write ('Response');
but it does not help. In some cases the program just hangs and if I pause execution I can see that the current line is the one with the if conditions.
What happens here? How can I avoid trying to send using dead connections?
Okay, I found a solution. Instead of storing the TIdContext I use the context list provided by TIdTcpServer:
procedure ThreadPool.Execute (Task : TTask);
var
ContextList : TList;
Context : TIdContext;
FoundContext : Boolean;
begin
// Perform some computation
FoundContext := False;
ContextList := FIdTCPServer.Contexts.LockList;
try
for I := 0 to ContextList.Count-1 do
begin
Context := TObject (ContextList [I]) as TIdContext;
if (Context.Connection.Socket.Binding.PeerIP = Task.ClientInfo.IP) and
(Context.Connection.Socket.Binding.PeerPort = Task.ClientInfo.Port) then
begin
FoundContext := True;
Break;
end;
end;
finally
FIdTCPServer.Contexts.UnlockList;
end;
if not FoundContext then
Exit;
// Context is a valid connection, send the answer
end;
That works for me.
If the client closes the connection, the client machine/network card dies or you have some other network problem between you and the client, you might not know about it until the next time you try to write to the connection.
You could use a heartbeat. Occasionally send a message to the client with a short timeout to see if the connection is still valid. This way, you'll know sooner if there has been an unexpected disconnect. You could wrap it in a "CheckConnection" function and call it before sending your response.