在销毁 Indy 组件时查明 EInvalidPointer 异常的原因
Pinpointing the cause of a EInvalidPointer exception when destroying Indy components
我想弄清楚如何解决销毁 Indy 组件时出现的竞争条件。当我们在表单上有一个 Indy TIdHTTPServer 组件时，我们在表单销毁期间收到零星的 EInvalidPointer 异常。
背景
我们有一个简单的表格，上面有一个 TIdHTTPServer，还有一个 OnCommandGet 事件：
procedure TForm2.httpCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
Filename: string;
function RespondFile: Boolean;
var
EnableTransferFile: Boolean;
SourceFilename: string;
begin
SourceFilename := CSourcePath + Filename;
if not FileExists(SourceFilename) then
Exit(False);
AResponseInfo.ContentType := http.MIMETable.GetFileMIMEType(SourceFilename);
AResponseInfo.ContentLength := FileSizeByName(SourceFilename);
AResponseInfo.WriteHeader;
EnableTransferFile := not (AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase);
AContext.Connection.IOHandler.WriteFile(SourceFilename, EnableTransferFile);
Result := True;
end;
begin
Filename := ARequestInfo.Document;
if Copy(Filename, 1, 1) = '/' then Delete(Filename, 1, 1);
if Filename.Contains('/') or Filename.Contains('\') then
begin
// Block path attempts
AResponseInfo.ResponseNo := 404;
Exit;
end;
if not RespondFile then
AResponseInfo.ResponseNo := 404;
end;
http 服务器在设计时设置 Active=True。
运行 程序
该程序提供一个简单的网页，该网页反复联系网络服务器（通过 XmlHttpRequest）并自行下载。这为竞争条件提供了触发器。
FormDestroy 和 Active := False（小分流）
当我销毁表单时，我知道我需要在 FormDestroy 事件中设置 Active:=False，否则在 Indy 线程上调用的 OnCommandGet 事件，不在主线程上，可以在表单被销毁时调用，并且表单成员和组件处于不确定状态。我们无法在回调入口处测试表单的 csDestroying 状态，因为这可以随时设置，即使我们的事件是 运行ning.
如果我们不在回调中引用表单 class 的任何成员，这种竞争条件不会真正导致问题。然而在实践中，我们经常需要访问表单的成员（使用合适的锁），因此在 FormDestroy 事件中设置 Active:=False 意味着我们可以控制监听线程何时被拆除。目前一切顺利。
procedure TForm2.FormDestroy(Sender: TObject);
begin
http.Active := False;
end;
崩溃
但是，我们在销毁表单时仍然偶尔会遇到EInvalidPointer异常。这出现在 TIdYarnOfThread.Destroy 的 httpScheduler 用户线程中：
:7775d8a8 KERNELBASE.RaiseException + 0x48
System.TObject.FreeInstance
System.ErrorAt(2,7841)
System.Error(reInvalidPtr)
System.TObject.FreeInstance
System._ClassDestroy(???)
IdSchedulerOfThread.TIdYarnOfThread.Destroy
System.TObject.Free
IdThread.TIdThread.Cleanup
IdThread.TIdThread.Execute
System.Classes.ThreadProc(DD5000)
System.ThreadWrapper(E510C0)
:75c938f4 KERNEL32.BaseThreadInitThunk + 0x24
:77a65663 ;
:77a6562e ;
对应的主线程栈为：
:77a76fec ntdll.NtDelayExecution + 0xc
:7775a4ef KERNELBASE.Sleep + 0xf
IdGlobal.IndySleep(???)
IdScheduler.TIdScheduler.TerminateAllYarns
IdCustomTCPServer.TIdCustomTCPServer.TerminateAllThreads
IdCustomTCPServer.TIdCustomTCPServer.Shutdown
IdCustomHTTPServer.TIdCustomHTTPServer.Shutdown
IdCustomTCPServer.TIdCustomTCPServer.SetActive(???)
idyracemain.TForm2.Timer1Timer(FDCC0)
Vcl.ExtCtrls.TTimer.Timer
Vcl.ExtCtrls.TTimer.WndProc(???)
System.Classes.StdWndProc(10552024,275,1,0)
:775384e3 user32.SetManipulationInputTarget + 0x53
:77516c30 ; C:\WINDOWS\SysWOW64\user32.dll
:77516531 ; C:\WINDOWS\SysWOW64\user32.dll
:775162f0 user32.DispatchMessageW + 0x10
Vcl.Forms.TApplication.ProcessMessage(???)
:005c22b0 TApplication.ProcessMessage + $F8
注意：上面的堆栈来自压力测试，该测试使用计时器强制出现此问题，因此引用了 TTimer。
从 System.TObject.FreeInstance 引发的 EInvalidPointer 异常通常是双重释放。我一直在调试它，但对 TIdYarn 还不够熟悉，无法理解它的完整生命周期。但是，以下过程可能是原因：
procedure TIdSchedulerOfThread.TerminateYarn(AYarn: TIdYarn);
var
LYarn: TIdYarnOfThread;
begin
Assert(AYarn<>nil);
LYarn := TIdYarnOfThread(AYarn);
if (LYarn.Thread <> nil) and (not LYarn.Thread.Suspended) then begin
// Is still running and will free itself
LYarn.Thread.Stop;
// Dont free the yarn. The thread frees it (IdThread.pas)
end else
begin
// If suspended, was created but never started
// ie waiting on connection accept
// RLebeau: free the yarn here as well. This allows TIdSchedulerOfThreadPool
// to put the suspended thread, if present, back in the pool.
IdDisposeAndNil(LYarn);
end;
end;
这里的问题是此过程 运行s 在拥有组件（通常是主线程）的线程上下文中。在过程测试线程是否挂起（即尚未启动）之后，线程可能会从另一个线程启动，导致 LYarn 对象被释放两次 - 一次由该函数释放，一次由其拥有的线程释放。
但我可能手头不对。此异常是否是我使用 TIdHttpServer 组件的方式错误导致的？如果是，我做错了什么以及如何解决它？
更新：MCVE
以下程序使用 Delphi 10 Seattle（发行版）和包含的 Indy 组件在我的机器上相当快地强制出现问题。因为这似乎是线程竞争条件，所以 YMMV 在不同的硬件上；您可能会发现单核 VM 有助于重现问题。您必须在调试器中 运行 捕获 EInvalidPointer 异常，否则它会被静默处理。
在测试时，我很少看到 EAccessViolation 和与 EInvalidPointer 具有相同主线程调用堆栈的挂起。我怀疑这些可能都有相同的根本原因。
在新表格中添加 TIdHTTPServer、TTimer、TLabel 和 TWebBrowser，并附加事件 TIdHTTPServer.OnCommandGet、TTimer.OnTimer和 Form.OnCreate 如下。设置 TIdHTTPServer.Bindings[0]=127.0.0.1,9999 和 KeepAlive=True。 KeepAlive=True 往往会在我的机器上更快地触发问题，但它仍然会在 KeepAlive=False.
上发生
当您在 Delphi 调试器中 运行 程序时，您通常会在几分钟内收到 EInvalidPointer。您通常可以通过在 TIdThread.Cleanup 上设置断点并在调试器中断时继续执行来更快地触发它。
unit idyracemain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdCustomHTTPServer,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdHTTPServer, Vcl.ExtCtrls,
Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw;
type
TForm2 = class(TForm)
http: TIdHTTPServer; //Bindings[0]=127.0.0.1:9999, KeepAlive=True
Timer1: TTimer;
Label1: TLabel;
WebBrowser1: TWebBrowser;
procedure httpCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
const doc =
'<!DOCTYPE html>'+
'<html lang="en"><head><title>Indy Stress</title></head><body>'+
'Attempts: <span id="counter">0</span>'+
'<script>'+
' var attempts = 0;'+
' window.setInterval(function() { '+
' var x = new XMLHttpRequest();'+
' document.getElementById("counter").innerText = ++attempts;'+
' x.open("GET", "/");'+
' x.send();'+
' }, 1);'+
'</script></body></html>';
procedure TForm2.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://127.0.0.1:'+IntToStr(http.Bindings[0].Port)); //9999
end;
procedure TForm2.httpCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := doc;
AResponseInfo.ContentType := 'text/html';
AResponseInfo.Expires := 1;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False; // Disable the timer because setting Active=false can take some time
http.Active := False;
http.Active := True;
Timer1.Interval := Random(200)+1;
Label1.Caption := 'Alive for '+IntToStr(Timer1.Interval)+' ms';
Timer1.Enabled := True;
end;
end.
我在这里的回复延迟很长时间，因为我刚刚在调查一个不相关的种族时再次发现这个 long-lost 问题。
Indy rev 5518 中 TIdThread.Cleanup() 的补丁解决了这个竞争条件。
我想弄清楚如何解决销毁 Indy 组件时出现的竞争条件。当我们在表单上有一个 Indy TIdHTTPServer 组件时，我们在表单销毁期间收到零星的 EInvalidPointer 异常。
背景
我们有一个简单的表格，上面有一个 TIdHTTPServer，还有一个 OnCommandGet 事件：
procedure TForm2.httpCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
Filename: string;
function RespondFile: Boolean;
var
EnableTransferFile: Boolean;
SourceFilename: string;
begin
SourceFilename := CSourcePath + Filename;
if not FileExists(SourceFilename) then
Exit(False);
AResponseInfo.ContentType := http.MIMETable.GetFileMIMEType(SourceFilename);
AResponseInfo.ContentLength := FileSizeByName(SourceFilename);
AResponseInfo.WriteHeader;
EnableTransferFile := not (AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase);
AContext.Connection.IOHandler.WriteFile(SourceFilename, EnableTransferFile);
Result := True;
end;
begin
Filename := ARequestInfo.Document;
if Copy(Filename, 1, 1) = '/' then Delete(Filename, 1, 1);
if Filename.Contains('/') or Filename.Contains('\') then
begin
// Block path attempts
AResponseInfo.ResponseNo := 404;
Exit;
end;
if not RespondFile then
AResponseInfo.ResponseNo := 404;
end;
http 服务器在设计时设置 Active=True。
运行 程序
该程序提供一个简单的网页，该网页反复联系网络服务器（通过 XmlHttpRequest）并自行下载。这为竞争条件提供了触发器。
FormDestroy 和 Active := False（小分流）
当我销毁表单时，我知道我需要在 FormDestroy 事件中设置 Active:=False，否则在 Indy 线程上调用的 OnCommandGet 事件，不在主线程上，可以在表单被销毁时调用，并且表单成员和组件处于不确定状态。我们无法在回调入口处测试表单的 csDestroying 状态，因为这可以随时设置，即使我们的事件是 运行ning.
如果我们不在回调中引用表单 class 的任何成员，这种竞争条件不会真正导致问题。然而在实践中，我们经常需要访问表单的成员（使用合适的锁），因此在 FormDestroy 事件中设置 Active:=False 意味着我们可以控制监听线程何时被拆除。目前一切顺利。
procedure TForm2.FormDestroy(Sender: TObject);
begin
http.Active := False;
end;
崩溃
但是，我们在销毁表单时仍然偶尔会遇到EInvalidPointer异常。这出现在 TIdYarnOfThread.Destroy 的 httpScheduler 用户线程中：
:7775d8a8 KERNELBASE.RaiseException + 0x48
System.TObject.FreeInstance
System.ErrorAt(2,7841)
System.Error(reInvalidPtr)
System.TObject.FreeInstance
System._ClassDestroy(???)
IdSchedulerOfThread.TIdYarnOfThread.Destroy
System.TObject.Free
IdThread.TIdThread.Cleanup
IdThread.TIdThread.Execute
System.Classes.ThreadProc(DD5000)
System.ThreadWrapper(E510C0)
:75c938f4 KERNEL32.BaseThreadInitThunk + 0x24
:77a65663 ;
:77a6562e ;
对应的主线程栈为：
:77a76fec ntdll.NtDelayExecution + 0xc
:7775a4ef KERNELBASE.Sleep + 0xf
IdGlobal.IndySleep(???)
IdScheduler.TIdScheduler.TerminateAllYarns
IdCustomTCPServer.TIdCustomTCPServer.TerminateAllThreads
IdCustomTCPServer.TIdCustomTCPServer.Shutdown
IdCustomHTTPServer.TIdCustomHTTPServer.Shutdown
IdCustomTCPServer.TIdCustomTCPServer.SetActive(???)
idyracemain.TForm2.Timer1Timer(FDCC0)
Vcl.ExtCtrls.TTimer.Timer
Vcl.ExtCtrls.TTimer.WndProc(???)
System.Classes.StdWndProc(10552024,275,1,0)
:775384e3 user32.SetManipulationInputTarget + 0x53
:77516c30 ; C:\WINDOWS\SysWOW64\user32.dll
:77516531 ; C:\WINDOWS\SysWOW64\user32.dll
:775162f0 user32.DispatchMessageW + 0x10
Vcl.Forms.TApplication.ProcessMessage(???)
:005c22b0 TApplication.ProcessMessage + $F8
注意：上面的堆栈来自压力测试，该测试使用计时器强制出现此问题，因此引用了 TTimer。
从 System.TObject.FreeInstance 引发的 EInvalidPointer 异常通常是双重释放。我一直在调试它，但对 TIdYarn 还不够熟悉，无法理解它的完整生命周期。但是，以下过程可能是原因：
procedure TIdSchedulerOfThread.TerminateYarn(AYarn: TIdYarn);
var
LYarn: TIdYarnOfThread;
begin
Assert(AYarn<>nil);
LYarn := TIdYarnOfThread(AYarn);
if (LYarn.Thread <> nil) and (not LYarn.Thread.Suspended) then begin
// Is still running and will free itself
LYarn.Thread.Stop;
// Dont free the yarn. The thread frees it (IdThread.pas)
end else
begin
// If suspended, was created but never started
// ie waiting on connection accept
// RLebeau: free the yarn here as well. This allows TIdSchedulerOfThreadPool
// to put the suspended thread, if present, back in the pool.
IdDisposeAndNil(LYarn);
end;
end;
这里的问题是此过程 运行s 在拥有组件（通常是主线程）的线程上下文中。在过程测试线程是否挂起（即尚未启动）之后，线程可能会从另一个线程启动，导致 LYarn 对象被释放两次 - 一次由该函数释放，一次由其拥有的线程释放。
但我可能手头不对。此异常是否是我使用 TIdHttpServer 组件的方式错误导致的？如果是，我做错了什么以及如何解决它？
更新：MCVE
以下程序使用 Delphi 10 Seattle（发行版）和包含的 Indy 组件在我的机器上相当快地强制出现问题。因为这似乎是线程竞争条件，所以 YMMV 在不同的硬件上；您可能会发现单核 VM 有助于重现问题。您必须在调试器中 运行 捕获 EInvalidPointer 异常，否则它会被静默处理。
在测试时，我很少看到 EAccessViolation 和与 EInvalidPointer 具有相同主线程调用堆栈的挂起。我怀疑这些可能都有相同的根本原因。
在新表格中添加 TIdHTTPServer、TTimer、TLabel 和 TWebBrowser，并附加事件 TIdHTTPServer.OnCommandGet、TTimer.OnTimer和 Form.OnCreate 如下。设置 TIdHTTPServer.Bindings[0]=127.0.0.1,9999 和 KeepAlive=True。 KeepAlive=True 往往会在我的机器上更快地触发问题，但它仍然会在 KeepAlive=False.
当您在 Delphi 调试器中 运行 程序时，您通常会在几分钟内收到 EInvalidPointer。您通常可以通过在 TIdThread.Cleanup 上设置断点并在调试器中断时继续执行来更快地触发它。
unit idyracemain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdCustomHTTPServer,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdHTTPServer, Vcl.ExtCtrls,
Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw;
type
TForm2 = class(TForm)
http: TIdHTTPServer; //Bindings[0]=127.0.0.1:9999, KeepAlive=True
Timer1: TTimer;
Label1: TLabel;
WebBrowser1: TWebBrowser;
procedure httpCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
const doc =
'<!DOCTYPE html>'+
'<html lang="en"><head><title>Indy Stress</title></head><body>'+
'Attempts: <span id="counter">0</span>'+
'<script>'+
' var attempts = 0;'+
' window.setInterval(function() { '+
' var x = new XMLHttpRequest();'+
' document.getElementById("counter").innerText = ++attempts;'+
' x.open("GET", "/");'+
' x.send();'+
' }, 1);'+
'</script></body></html>';
procedure TForm2.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://127.0.0.1:'+IntToStr(http.Bindings[0].Port)); //9999
end;
procedure TForm2.httpCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := doc;
AResponseInfo.ContentType := 'text/html';
AResponseInfo.Expires := 1;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False; // Disable the timer because setting Active=false can take some time
http.Active := False;
http.Active := True;
Timer1.Interval := Random(200)+1;
Label1.Caption := 'Alive for '+IntToStr(Timer1.Interval)+' ms';
Timer1.Enabled := True;
end;
end.
我在这里的回复延迟很长时间，因为我刚刚在调查一个不相关的种族时再次发现这个 long-lost 问题。
Indy rev 5518 中 TIdThread.Cleanup() 的补丁解决了这个竞争条件。