I've written a multitreaded tcp server using fpFork() call. Works fine, but after client disconnects a zombie process remains. There is an infinite loop where I wait for incoming connection, fork, pass this conenction to the child, which take care of it and then exits. However the child remains as zombie until the parent terminates.
while True do
begin
// Accept connection
ClientAddrLen := sizeof(ClientAddr);
ClientSock := fpaccept(ServerSock, #ClientAddr, #ClientAddrLen);
if ClientSock > 0 then // Success?
begin
Pid := fpFork();
// Error fork
if pid < 0 then
begin
CloseSocket(ClientSock);
continue;
end
// Child process
else if pid = 0 then
begin
CloseSocket(ServerSock);
handleClient(ClientSock);
CloseSocket(ClientSock);
Halt(0);
end
// parent process
else if pid > 0 then
begin
CloseSocket(ClientSock);
continue;
end;
end;
end;
I headr about function fpWait() or fpWaitPid() but free pascal documentation lacks examples and googling it is worthless, thus I don't even how to use it.
I'm using fpc 2.6.4 on FreeBSD.
Update 1
After some trial-and-error testing, reading manuals and discussions I tried some combinations. I put following functions in the parent part of executed code:
else if pid > 0 then
begin
CloseSocket(ClientSock);
//here
continue;
end;
a) Using WaitProcess(pid) (is equivalet with fpWaitPid(pid, #Status, 0))
With this parent process wait for the child, however as the parent was waiting it couldn't accept another connection until the child is terminated.
b) Using fpWaitPid(pid, #Status, WNOHANG)
This function does not block the program, but it doesn't bother doing anything. Like the function is not even there. It's confusing, because everywhere i read about this (it was coded in C,but it doe's not matter, these functions are only wrappers around unix calls) was suggested use of this.
At this point I have no idea what could be wrong. Thank you in advance.
When child process was ended it's bacame a zombee and system sending the SIGCHLD signal to the parent process. Parent process have will call wait (fpwait in freepascal) function when it accept the SIGCHLD signal. If parent process call wait function system send to parent process exit code of the child process and erase it's record and free it's pid.
If parent process don't react on SIGCHLD signals and (or) don't call wait function then zombee process's quantity will multiply until the parent process's termination.
procedure DoSigChld; cdecl;
var stat : longint;
begin
fpwait(stat);
end;
SignalAction.sa_handler := #DoSigChld;
fpsigaction(SIGCHLD, #SignalAction, nil);
Related
I want to wait for a WebBrowser control to finish navigation. So i create an Event, and then i want to wait for it to be set:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
FEvent.ResetEvent;
WebBrowser.Navigate2('about:blank'); //Event is signalled in the DocumentComplete event
Self.WaitFor;
end;
And then i set the event in the DocumentComplete event:
procedure TContoso.DocumentComplete(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);
var
doc: IHTMLDocument2;
begin
if (pDisp <> FWebBrowser.DefaultInterface) then
begin
//This DocumentComplete event is for another frame
Exit;
end;
//Set the event that it's complete
FEvent.SetEvent;
end;
The problem comes in how to wait for this event to happen.
WaitFor it
First reaction would be to wait for the event to become triggered:
procedure TContoso.WaitFor;
begin
FEvent.WaitFor;
end;
The problem with that is that the DocumentComplete event can never fire, because the application never goes idle enough to allow the COM event to get through.
Busy Sleep Wait
My first reaction was to do a busy sleep, waiting for a flag:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
FIsDocumentComplete := False;
WebBrowser.Navigate2('about:blank'); //Flag is set in the DocumentComplete event
Self.WaitFor;
end;
procedure TContoso.WaitFor;
var
n: Iterations;
const
MaxIterations = 25; //100ms each * 10 * 5 = 5 seconds
begin
while n < MaxIterations do
begin
if FIsDocumentComplete then
Exit;
Inc(n);
Sleep(100); //100ms
end;
end;
The problem with a Sleep, is that it doesn't allow the application to do idle enough to allow the COM event messages to get through.
Use CoWaitForMultipleHandles
After research, it seems that COM folks created a function created exactly for this situation:
While a thread in a Single-Threaded Apartment (STA) blocks, we will pump certain messages for you. Message pumping during blocking is one of the black arts at Microsoft. Pumping too much can cause reentrancy that invalidates assumptions made by your application. Pumping too little causes deadlocks. Starting with Windows 2000, OLE32 exposes CoWaitForMultipleHandles so that you can pump “just the right amount.”
So i tried that:
procedure TContoso.WaitFor;
var
hr: HRESULT;
dwIndex: DWORD;
begin
hr := CoWaitForMultipleHandles(0, 5000, 1, #FEvent.Handle, {out}dwIndex);
OleCheck(hr);
end;
The problem is that just doesn't work; it doesn't allow the COM event to appear.
Use UseCOMWait wait
i could also try Delphi's own mostly secret feature of TEvent: UseCOMWait
Set UseCOMWait to True to ensure that when a thread is blocked and waiting for the object, any STA COM calls can be made back into this thread.
Excellent! Lets use that:
FEvent := TEvent.Create(True);
function TContoso.WaitFor: Boolean;
begin
FEvent.WaitFor;
end;
Except that doesn't work; because the callback event never gets fired.
MsgWaitForMultipleBugs
So now i start to delve into the awful, awful, awful, awful, buggy, error-prone, re-entrancy inducing, sloppy, requires a mouse nudge, sometimes crashes world of MsgWaitForMultipleObjects:
function TContoso.WaitFor: Boolean;
var
// hr: HRESULT;
// dwIndex: DWORD;
// msg: TMsg;
dwRes: DWORD;
begin
// hr := CoWaitForMultipleHandles(0, 5000, 1, #FEvent.Handle, {out}dwIndex);
// OleCheck(hr);
// Result := (hr = S_OK);
Result := False;
while (True) do
begin
dwRes := MsgWaitForMultipleObjects(1, #FEvent.Handle, False, 5000, QS_SENDMESSAGE);
if (dwRes = WAIT_OBJECT_0) then
begin
//Our event signalled
Result := True;
Exit;
end
else if (dwRes = WAIT_TIMEOUT) then
begin
//We waited our five seconds; give up
Exit;
end
else if (dwRes = WAIT_ABANDONED_0) then
begin
//Our event object was destroyed; something's wrong
Exit;
end
else if (dwRes = (WAIT_OBJECT_0+1)) then
begin
GetMessage(msg, 0, 0, 0);
if msg.message = WM_QUIT then
begin
{
http://blogs.msdn.com/oldnewthing/archive/2005/02/22/378018.aspx
PeekMessage will always return WM_QUIT. If we get it, we need to
cancel what we're doing and "re-throw" the quit message.
The other important thing about modality is that a WM_QUIT message
always breaks the modal loop. Remember this in your own modal loops!
If ever you call the PeekMessage function or The GetMessage
function and get a WM_QUIT message, you must not only exit your
modal loop, but you must also re-generate the WM_QUIT message
(via the PostQuitMessage message) so the next outer layer will
see the WM_QUIT message and do its cleanup as well. If you fail
to propagate the message, the next outer layer will not know that
it needs to quit, and the program will seem to "get stuck" in its
shutdown code, forcing the user to terminate the process the hard way.
}
PostQuitMessage(msg.wParam);
Exit;
end;
TranslateMessage(msg);
DispatchMessage(msg);
end;
end;
The above code is wrong because:
i don't know what kind of message to wake up for (are com events sent?)
i don't know i don't want to call GetMessage, because that gets messages; i only want to get the COM message (see point one)
i might should be using PeekMessage (see point 2)
i don't know if i have to call GetMessage in a loop until it returns false (see Old New Thing)
I've been programming long enough to run away, far away, if i'm going to pump my own messages.
The questions
So i have four questions. All related. This post is one of the four:
How to make WebBrower.Navigate2 synchronous?
How to pump COM messages?
Does pumping COM messages cause COM events to callback?
How to use CoWaitForMultipleHandles
I am writing in, and using Delphi. But obviously any native code would work (C, C++, Assembly, Machine code).
See also
MSDN Blog: Managed Blocking - Chris Brumme
CoWaitForMultipleHandles API doesn't behave as documented
Visual Studio Forums: How to use "CoWaitForMultipleHandles" ?
MSDN: CoWaitForMultipleHandles function
MSDN Blog: Apartments and Pumping in the CLR - Chris Brumme
Which blocking operations cause an STA thread to pump COM messages?
The short and long of it is that you have to pump ALL messages normally, you can't just single out COM messages by themselves (and besides, there is no documented messages that you can peek/pump by themselves, they are known only to COM's internals).
How to make WebBrower.Navigate2 synchronous?
You can't. But you don't have to wait for the OnDocumentComplete event, either. You can busy-loop inside of NavigateToEmpty() itself until the WebBrowser's ReadyState property is READYSTATE_COMPLETE, pumping the message queue when messages are waiting to be processed:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
begin
WebBrowser.Navigate2('about:blank');
while (WebBrowser.ReadyState <> READYSTATE_COMPLETE) and (not Application.Terminated) do
begin
// if MsgWaitForMultipleObjects(0, Pointer(nil)^, False, 5000, QS_ALLINPUT) = WAIT_OBJECT_0 then
// if GetQueueStatus(QS_ALLINPUT) <> 0 then
Application.ProcessMessages;
end;
end;
How to pump COM messages?
You can't, not by themselves anyway. Pump everything, and be prepared to handle any reentry issues that result from that.
Does pumping COM messages cause COM events to callback?
Yes.
How to use CoWaitForMultipleHandles
Try something like this:
procedure TContoso.NavigateToEmpty(WebBrowser: IWebBrowser2);
var
hEvent: THandle;
dwIndex: DWORD;
hr: HRESULT;
begin
// when UseCOMWait() is true, TEvent.WaitFor() does not wait for, or
// notify, when messages are pending in the queue, so use
// CoWaitForMultipleHandles() directly instead. But you have to still
// use a waitable object, just don't signal it...
hEvent := CreateEvent(nil, True, False, nil);
if hEvent = 0 then RaiseLastOSError;
try
WebBrowser.Navigate2('about:blank');
while (WebBrowser.ReadyState <> READYSTATE_COMPLETE) and (not Application.Terminated) do
begin
hr := CoWaitForMultipleHandles(COWAIT_INPUTAVAILABLE, 5000, 1, hEvent, dwIndex);
case hr of
S_OK: Application.ProcessMessages;
RPC_S_CALLPENDING, RPC_E_TIMEOUT: begin end;
else
RaiseLastOSError(hr);
end;
end;
finally
CloseHandle(hEvent);
end;
end;
When using pipes to read from spawned processes, is it possible to terminate said program when it asks for input?
If it doesn't terminate, the usual ReadFile loop until the pipe is closed will block forever:
tsi.cb := SizeOf(TStartupInfo);
tsi.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
tsi.hStdInput := hInputRead;
tsi.hStdOutput := hOutputWrite;
tsi.hStdError := hErrorWrite;
if not CreateProcess(nil, PAnsiChar(Cmd), #sa, #sa, true, 0, nil, PAnsiChar(WorkDir), tsi, tpi) then
exit;
// Close handles we don't need. We are only interested in its output
CloseHandle(hOutputWrite);
CloseHandle(hInputRead);
CloseHandle(hErrorWrite);
repeat
// ReadFile will never return while our programs waits for input
if not ReadFile(OutputRead, Buf, SizeOf(Buf), nRead, nil) or (nRead = 0) then
begin
if GetLastError = ERROR_BROKEN_PIPE then
Break
else
ErrFunc('Pipe read error, could not execute file');
end;
// do something with buf...
until False;
Terminating by itself is quite easy (just use TerminateProcess), but one only knows when to call TerminateProcess when its too late, i.e. when it hangs.
First, you're not using pipes in the Win32 sense, you're using redirected console output.
That being said, however, you can wait on the file handle and abort if the wait times out.
I am trying out following code. However, if I click on form's close button while this code is running, nothing happens. How can I correct this? I need to close the form even when this loop is executing.
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 9999999 do
begin
Memo1.Lines.Add('hi');
Application.ProcessMessages;
end;
end;
Have a look at what's going on inside Application.ProcessMessages.
When you close the main form, windows sends a WM_QUIT message to the program. The relevant part of TApplication.ProcessMessages looks like this:
if Msg.Message <> WM_QUIT then
begin
//skipped
end
else
begin
{$IF DEFINED(CLR)}
if Assigned(FOnShutDown) then FOnShutDown(self);
DoneApplication;
{$IFEND}
FTerminate := True;
end;
I assume this is not a CLR program, so the only thing that happens at this point is setting FTerminate := True on Application. This is reflected in the Application.Terminated property.
When the application shuts down, one of the things it does in order to shut down safely is wait for all threads to finish. This code happens to be running in the main thread, but the principle would be the same in any thread: If you're doing a long-running task that might have to finish early, you have to explicitly check for early termination.
Knowing this, it's easy to figure out how to fix your code:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 9999999 do
begin
Memo1.Lines.Add('hi');
Application.ProcessMessages;
if Application.Terminated then
Break;
end;
end;
Also, beware of using Application.ProcessMessages in the first place, as it will process all messages for the application. For a simple idea of what might go wrong, try adding IntToStr(i) instead of 'hi' to Memo1.Lines, knock a couple of orders of magnitude off the counter, and then click the button two or three times in rapid succession and watch the output...
Check for Apllication Terminated:
for i := 0 to 9999999 do
begin
Memo1.Lines.Add('hi');
Application.ProcessMessages;
if Application.Terminated then Exit;
end;
You need to run any tight loop in a thread. This will solve the problem.
BUT if you want to keep the code as it is, Application.ProcessMessages will make your loop terribly slow. So you need to run Application.ProcessMessages not so often:
Counter:= 0;
for i := 0 to 9999999 do
begin
DoSomeStuff;
{ Prevent freeze }
inc(Counter);
if counter > 10000 then
begin
Counter:= 0;
Application.ProcessMessages;
if Application.Terminated then Exit;
end;
end;
I want to get a list with all the threads (except the main, GUI thread) from within my application in order to do some action(s) with them. (set priority, kill, pause etc.)
How to do that?
Another option is use the CreateToolhelp32Snapshot,Thread32First and Thread32Next functions.
See this very simple example (Tested in Delphi 7 and Windows 7).
program ListthreadsofProcess;
{$APPTYPE CONSOLE}
uses
PsAPI,
TlHelp32,
Windows,
SysUtils;
function GetTthreadsList(PID:Cardinal): Boolean;
var
SnapProcHandle: THandle;
NextProc : Boolean;
TThreadEntry : TThreadEntry32;
begin
SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); //Takes a snapshot of the all threads
Result := (SnapProcHandle <> INVALID_HANDLE_VALUE);
if Result then
try
TThreadEntry.dwSize := SizeOf(TThreadEntry);
NextProc := Thread32First(SnapProcHandle, TThreadEntry);//get the first Thread
while NextProc do
begin
if TThreadEntry.th32OwnerProcessID = PID then //Check the owner Pid against the PID requested
begin
Writeln('Thread ID '+inttohex(TThreadEntry.th32ThreadID,8));
Writeln('base priority '+inttostr(TThreadEntry.tpBasePri));
Writeln('');
end;
NextProc := Thread32Next(SnapProcHandle, TThreadEntry);//get the Next Thread
end;
finally
CloseHandle(SnapProcHandle);//Close the Handle
end;
end;
begin
{ TODO -oUser -cConsole Main : Insert code here }
GettthreadsList(GetCurrentProcessId); //get the PID of the current application
//GettthreadsList(5928);
Readln;
end.
You can use my TProcessInfo class:
var
CurrentProcess : TProcessItem;
Thread : TThreadItem;
begin
CurrentProcess := ProcessInfo1.RunningProcesses.FindByID(GetCurrentProcessId);
for Thread in CurrentProcess.Threads do
Memo1.Lines.Add(Thread.ToString);
end;
You can also have a look at http://blog.delphi-jedi.net/2008/03/19/how-to-get-the-threads-of-a-process/
You can access this information using WMI.
The WIN32_Process can give you all information about process executing on Machine. For each process you can give ThreadsCount, Handle,...
Another class, WIN32_Thread can give you detailled information about all Threads running on Machine. This class hace a property called ProcessId for search especific threads for 1 process (class WIN32_Process).
For test it you can execute this on CommandLine window:
// all processes
WMIC PROCESS
// information about Delphi32
WMIC PROCESS WHERE Name="delphi32.exe"
// some information about Delphi32
WMIC PROCESS WHERE Name="delphi32.exe" GET Name,descrption,threadcount,Handle
(NOTE: The handle for delphi32.exe in my machine is **3680**)
Similar you can do with WIN32_Thread using the Handle of process.
Excuse.me for my bad english.
Regards.
If they are your threads, then I would create an application global Thread Manager to register themselves with upon creation. Then you can properly monitor, pause and shutdown threads gracefully using your Thread Manager.
I'm testing the existence of a file in a remote share (on a Windows server). The underlying function used for testing is WinAPI's GetFileAttributes, and what happens is that function can take an inordinate amount of time (dozens of seconds) in various situations, like when the target server being offline, when there are rights or DNS issues, etc.
However, in my particular case, it's always a LAN access, so if the file can't be accessed in less than 1 second, then it typically won't be accessible by waiting dozens of seconds more...
Is there an alternative to GetFileAttributes that wouldn't stall? (apart from calling it in a thread and killing the thread after a timeout, which seems to bring its own bag of issues)
The problem isn't GetFileAttributes really. It typically uses just one call to the underlying file system driver. It's that IO which is stalling.
Still, the solution is probably easy. Call CancelSynchronousIo() after one second (this obviously requires a second thread as your first is stuck inside GetFileAttributes).
One cool thing about delegates is you can always BeginInvoke and EndInvoke them. Just make sure the called method doesn't throw an exception out since [I believe] it will cause a crash (unhandled exception).
AttributeType attributes = default(AttributeType);
Action<string> helper =
(path) =>
{
try
{
// GetFileAttributes
attributes = result;
}
catch
{
}
};
IAsyncResult asyncResult = helper.BeginInvoke();
// whatever
helper.EndInvoke();
// at this point, the attributes local variable has a valid value.
I think your best solution is to use a thread-pool thread to perform the work.
assign a unit of work to query the attributes of a file
let GetFileAttributes run to completion
post the results back to your form
when your thread function completes, the thread automatically returns back to the pool (no need to kill it)
By using the thread pool you save the costs of creating new threads.
And you save the misery of trying to get rid of them.
Then you have your handy helper method that runs an object's method procedure on a thread-pool thread using QueueUserWorkItem:
RunInThreadPoolThread(
GetFileAttributesThreadMethod,
TGetFileAttributesData.Create('D:\temp\foo.xml', Self.Handle),
WT_EXECUTEDEFAULT);
You create the object to hold the thread data information:
TGetFileAttributesData = class(TObject)
public
Filename: string;
WndParent: HWND;
Attributes: DWORD;
constructor Create(Filename: string; WndParent: HWND);
end;
and you create your thread callback method:
procedure TForm1.GetFileAttributesThreadMethod(Data: Pointer);
var
fi: TGetFileAttributesData;
begin
fi := TObject(Data) as TGetFileAttributesData;
if fi = nil then
Exit;
fi.attributes := GetFileAttributes(PWideChar(fi.Filename));
PostMessage(fi.WndParent, WM_GetFileAttributesComplete, NativeUInt(Data), 0);
end;
then you just handle the message:
procedure WMGetFileAttributesComplete(var Msg: TMessage); message WM_GetFileAttributesComplete;
procedure TfrmMain.WMGetFileAttributesComplete(var Msg: TMessage);
var
fi: TGetFileAttributesData;
begin
fi := TObject(Pointer(Msg.WParam)) as TGetFileAttributesData;
try
ShowMessage(Format('Attributes of "%s": %.8x', [fi.Filename, fi.attributes]));
finally
fi.Free;
end;
end;
The magical RunInThreadPoolThread is just a bit of fluff that lets you execute an instance method in a thread:
Which is just a wrapper that lets you call method on an instance variable:
TThreadMethod = procedure (Data: Pointer) of object;
TThreadPoolCallbackContext = class(TObject)
public
ThreadMethod: TThreadMethod;
Context: Pointer;
end;
function ThreadPoolCallbackFunction(Parameter: Pointer): Integer; stdcall;
var
tpContext: TThreadPoolCallbackContext;
begin
try
tpContext := TObject(Parameter) as TThreadPoolCallbackContext;
except
Result := -1;
Exit;
end;
try
tpContext.ThreadMethod(tpContext.Context);
finally
try
tpContext.Free;
except
end;
end;
Result := 0;
end;
function RunInThreadPoolThread(const ThreadMethod: TThreadMethod; const Data: Pointer; Flags: ULONG): BOOL;
var
tpContext: TThreadPoolCallbackContext;
begin
{
Unless you know differently, the flag you want to use is 0 (WT_EXECUTEDEFAULT).
If your callback might run for a while you can pass the WT_ExecuteLongFunction flag.
Sure, I'm supposed to pass WT_EXECUTELONGFUNCTION if my function takes a long time, but how long is long?
http://blogs.msdn.com/b/oldnewthing/archive/2011/12/09/10245808.aspx
WT_EXECUTEDEFAULT (0):
By default, the callback function is queued to a non-I/O worker thread.
The callback function is queued to a thread that uses I/O completion ports, which means they cannot perform
an alertable wait. Therefore, if I/O completes and generates an APC, the APC might wait indefinitely because
there is no guarantee that the thread will enter an alertable wait state after the callback completes.
WT_EXECUTELONGFUNCTION (0x00000010):
The callback function can perform a long wait. This flag helps the system to decide if it should create a new thread.
WT_EXECUTEINPERSISTENTTHREAD (0x00000080)
The callback function is queued to a thread that never terminates.
It does not guarantee that the same thread is used each time. This flag should be used only for short tasks
or it could affect other timer operations.
This flag must be set if the thread calls functions that use APCs.
For more information, see Asynchronous Procedure Calls.
Note that currently no worker thread is truly persistent, although worker threads do not terminate if there
are any pending I/O requests.
}
tpContext := TThreadPoolCallbackContext.Create;
tpContext.ThreadMethod := ThreadMethod;
tpContext.Context := Data;
Result := QueueUserWorkItem(ThreadPoolCallbackFunction, tpContext, Flags);
end;
Exercise for the reader: Create a Cancelled flag inside the GetFileAttributesData object that tells the thread that it must free the data object and not post a message to the parent.
It's all a long way of saying that you're creating:
DWORD WINAPI GetFileAttributes(
_In_ LPCTSTR lpFileName,
_Inout_ LPOVERLAPPED lpOverlapped,
_In_ LPOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine
);