TIdHTTPServer 停用时挂起

Question

首先，请参考一个类似但不完全重复的问题。这个问题是通过在 Windows 服务器上卸载有缺陷的 Windows 更新来解决的，这根本不是我的情况（因为我使用的是 Windows 11，没有此类更新）。

我的问题是，将

TIdHTTPServer

设置为

Active

时，

False

会挂起，就像其他问题一样，但仅限于特定场景：

1. 停用时至少有 1 个客户端仍处于连接状态
2. 如果在

   OnDisconnect

   事件处理程序中尝试进行任何日志记录

这是我的完整代码：

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
  IdComponent, IdCustomTCPServer, IdCustomHTTPServer, IdHTTPServer,
  IdContext, IdGlobal;

type
  TMainForm = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    Log: TMemo;
    Server: TIdHTTPServer;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure ServerConnect(AContext: TIdContext);
    procedure ServerDisconnect(AContext: TIdContext);
    procedure ServerCommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  private
    procedure PostLog(const S: String);
    procedure PostLogSYNC(const S: String);
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.btnStartClick(Sender: TObject);
begin
  PostLog('Server Starting...');
  btnStart.Enabled:= False;
  try
    Server.OnCommandGet := ServerCommandGet;
    Server.OnConnect:= ServerConnect;
    Server.OnDisconnect:= ServerDisconnect;
    Server.KeepAlive := False;// True;
    Server.DefaultPort := 808;
    Server.Active := True;
    PostLog('Server Started.');
  finally
    btnStop.Enabled:= True;
  end;
end;

procedure TMainForm.btnStopClick(Sender: TObject);
begin
  PostLog('Server Stopping...');
  btnStop.Enabled:= False;
  try
    try
      Server.Active := False;
    except
      on E: Exception do
        PostLog('Exception deactivating server: '+E.Message);
    end;
    PostLog('Server Stopped.');
  finally
    btnStart.Enabled:= True;
  end;
end;

function GenerateRandomAlphaNumChar: Char;
const
  AlphaNumChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789';
begin
  Result := AlphaNumChars[Random(Length(AlphaNumChars)) + 1];
end;

function MakeHugeFile: TStringStream;
begin
  //Create random 50 MB "file"...
  Randomize;
  Result:= TStringStream.Create;
  for var X: Integer := 1 to 1024 do begin
    for var Y: Integer := 1 to 1024 do begin
      for var Z: Integer := 1 to 50 do begin
        Result.WriteString(GenerateRandomAlphaNumChar);
      end;
    end;
  end;
end;

procedure TMainForm.ServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  AResponseInfo.ContentStream:= MakeHugeFile;
  AResponseInfo.ContentType:= 'application/octet-stream';
  AResponseInfo.ContentDisposition:= 'attachment ; filename = "Test.txt"';
  PostLogSYNC(AContext.Binding.PeerIP+' '+ARequestInfo.RawHTTPCommand);
end;

procedure TMainForm.ServerConnect(AContext: TIdContext);
begin
  PostLogSYNC(AContext.Binding.PeerIP+' Connected');
end;

procedure TMainForm.ServerDisconnect(AContext: TIdContext);
begin
  //PostLogSYNC(AContext.Binding.PeerIP+' Disconnected');

  //Doesn't matter whether I read from the bindings here.
  //In fact just trying to call TThrad.Synchronize at all causes the hang...
  TThread.Synchronize(nil, procedure
    begin
    end);
end;

procedure TMainForm.PostLog(const S: String);
begin
  Log.Lines.Append(S);
end;

procedure TMainForm.PostLogSYNC(const S: String);
begin
  TThread.Synchronize(nil, procedure
    begin
      PostLog(S);
    end);
end;

end.

为了重现，我让它以一个大的随机流响应，这需要一些时间才能获得。然后在此期间单击“停止”以停用服务器。

通过网络浏览器测试时，我得到：

Project ServerHang.exe raised exception class EIdNotConnected with message 'Not Connected'.

...对于每个当前活动的连接。

它在

IdIOHandler

中破裂：TIdIOHandler.ReadFromSource

如果我单击“运行”继续，它就会挂起，并且永远不会退出。

通过 Postman 测试时，它会立即挂起并且永远不会中断。

在没有调试的情况下运行也会导致挂起，我必须从任务管理器中终止该进程。

如何解决这个问题？

编辑

本来以为和KeepAlive有关，虽然确实有点影响，但最终还是没有修复。禁用 KeepAlive 后，简单的请求会快速完成并断开连接，因此我没有机会停止服务器。所以我将其更改为获取一堆随机数据，现在即使禁用 KeepAlive，它也会挂起。

Answer 1

...
          end;
        finally
          LBuffer := nil;
        end;
      end
      else if ARaiseExceptionIfDisconnected then begin
        raise EIdClosedSocket.Create(RSStatusDisconnected);
      end;
    end
    else if ARaiseExceptionIfDisconnected then begin
      raise EIdNotConnected.Create(RSNotConnected);  //<-- BREAKS HERE
    end;
    if LByteCount < 0 then
    begin
      LLastError := CheckForError(LByteCount);
      if LLastError = Id_WSAETIMEDOUT then begin
        // Timeout
        if ARaiseExceptionOnTimeout then begin
          raise EIdReadTimeout.Create(RSReadTimeout);
        end;
        Result := -1;
...

setter 是一个阻塞函数。在停用期间，它会关闭所有连接的客户端套接字并等待其工作线程关闭。

当您的

TIdHTTPServer.Active

处理程序尝试访问

EIdNotConected

setter 已关闭的客户端套接字时，会发生

OnCommandGet

异常。这是正常的，服务器将在内部处理此异常以停止调用线程。就让它吧。您看到异常只是因为您在调试器内运行代码。在调试器之外运行代码时，您不会看到此异常。至于挂起，这是因为您的

Active

处理程序正在尝试与主线程进行

OnDisconnect

，而主线程被阻塞等待

Synchronize()

设置器。您正在阻止客户端线程终止，从而阻止

Active

setter 完成。这是一个“有保证的死锁”。 为了避免这种情况，您需要： 使用

Active

或其他
• 非阻塞

  机制在停用期间通知您的主线程。

  只需停用工作线程而不是主线程中的
  TThread.Queue()
。