delphiindyhttpserverindy10

TIdHTTPServer hangs when deactivated

First, please refer to a similar but not exactly duplicate question. That question was solved by uninstalling a defective Windows update on Windows server, which is not my case at all (as I'm on Windows 11 with no such update).

My issue is that the TIdHTTPServer hangs when setting Active to False, just like in that other question, but only in specific scenarios:

  1. At least 1 client is still connected at the time of deactivating
  2. If any logging is attempted within the OnDisconnect event handler

Here's my complete code:

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.

To reproduce, I've made it to respond with a large random stream which will take some time to get. Then click "Stop" during this time to deactivate the server.

When testing via a web browser, I get:

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

...for each currently active connection.

It breaks inside IdIOHandler in TIdIOHandler.ReadFromSource:

...
          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;
...

If I click Run to continue, that's when it hangs, and never comes out of it.

When testing via Postman, it just immediately hangs and never breaks.

Running without debugging also results in a hang, where I have to kill the process from task manager.

How do I resolve this issue?

EDIT

I originally thought it was related to KeepAlive, and although it does affect it a little, it ultimately still did not fix it. With KeepAlive disabled, simple requests complete and disconnect quickly, and so I didn't have a chance to stop the server. So I changed it to fetch a bunch of random data, and now it hangs even with KeepAlive disabled.

Solution

  • Like most Indy servers, TIdHTTPServer is multi-threaded. Its events are called in the context of worker threads, not in the main thread.

    The TIdHTTPServer.Active setter is a blocking function. During a deactivation, it closes all connected client sockets and waits for their worker threads to shut down. The calling thread is blocked until this task is finished.

    The EIdNotConected exception occurs when your OnCommandGet handler is trying to access a client socket that the Active setter has already closed. This is normal. Let the exception escape back into the server so it can stop the client thread, and trigger the OnDisconnect event.

    You are seeing the exception only because you are running your code inside the debugger. You will not see this exception when running your code outside of the debugger.

    As for the hang, this is because your OnDisconnect handler is calling TThread.Synchronize() to sync with the main thread while the main thread is waiting on the Active setter. TThread.Synchronize() is also a blocking function, it blocks the calling thread until the requested procedure exits. So, you are blocking client threads from terminating, thus blocking the Active setter from finishing its cleanup. This is a guaranteed deadlock. To avoid this, you need to either: