為什么我的Delphi Indy idHTTpServer在CLOSE_WAIT時停止響應？

Question

環境

我已經使用Indy組件TidHTTPServer在Delphi中創建了一個Web服務器。 我正在使用Indy版本10.5.8附帶的Delphi XE2。 該服務器正在作為一個桌面應用程序運行，其形式為顯示連接及其請求的日志。 它在Windows 7 Professional上運行。 請求是針對來自Firebird數據庫的SQL數據。 響應為JSON。 所有流量均為HTTP。

挑戰

當我與少量用戶進行測試時，一切工作正常。 現在，我已將其推廣到約400個用戶，出現了通信問題。 服務器停止響應請求，而我可以使其再次響應的唯一方法是重新啟動運行它的計算機，然后重新啟動它。 在高容量時間內，重新引導的需求更加頻繁。

病征

使用Windows netstat時，我注意到每當發生CLOSE_WAIT類型的TCP連接時，服務器就會停止響應請求，而我必須再次重新啟動

測試程序

即使服務器上沒有流量，我也能夠模擬這種掛起。 我創建了一個網頁，該網頁發送多個請求，每個請求之間都有延遲。

該網頁讓我指定要發出的請求數，每個請求之間要等待多長時間以及超時之前要等待多長時間。 甚至在兩次請求之間的一毫秒之間，服務器似乎也沒有問題。

測試結果

如果將每個請求的超時時間設置為一個很小的數字（例如1毫秒），則可以使Delphi HTTP Server掛起。 正如我所期望的，在1毫秒的超時時間內，對我的服務器的請求每次都會失敗。 超時太短了，我的服務器可能無法足夠快地響應。

我不明白的是，在客戶端強制超時后，即使請求數量相對較少（少於50個），Delphi Web服務器也不再響應任何請求。 當我在服務器計算機上運行netstat時，有許多CLOSE_WAIT套接字連接。 即使經過一個小時，並且在關閉服務器后，CLOSE_WAIT套接字連接仍然存在。

問題

到底是怎么回事？ 當有（甚至只有一個）CLOSE_WAIT套接字連接時，為什么我的Delphi Indy idHTTPServer停止響應？ CLOSE_WAIT不會消失，服務器也不會再次開始響應。 我必須重啟。

我在做什么

這是netstat命令顯示CLOSE_WAIT的結果：

C:\Windows\system32>netstat -abn | findstr 62000
TCP    0.0.0.0:62000          0.0.0.0:0             LISTENING
TCP    10.1.1.13:62000        9.49.1.3:57036        TIME_WAIT
TCP    10.1.1.13:62000        9.49.1.3:57162        CLOSE_WAIT
TCP    10.1.1.13:62000        9.49.1.3:57215        CLOSE_WAIT
TCP    10.1.1.13:62000        9.49.1.3:57244        CLOSE_WAIT
TCP    10.1.1.13:62000        9.49.1.3:57263        CLOSE_WAIT
TCP    10.1.1.13:62000        9.49.1.3:57279        ESTABLISHED
TCP    10.1.1.13:62000        104.236.216.73:59051  ESTABLISHED

這是我的Web服務器的本質：

unit MyWebServer;

interface

Uses
...

Type
  TfrmWebServer = class(TForm)
    ...
    IdHTTPServer: TIdHTTPServer;
    ...
    procedure IdHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    procedure IdHTTPServerDisconnect(AContext: TIdContext);
    procedure btnStartClick(Sender: TObject);
    ...  
    dbFirebird : TIBDatabase;
    txFireird  : TIBTransaction;
    ...
  private
    function CreateSomeResponseStringData: string;
  end;


implementation

procedure TfrmWebServer.btnStartClick(Sender: TObject);
  begin
    {set the IP's and proit to listen on}
    IdHTTPServer.Bindings.Clear;
    IdHTTPServer.Bindings.Add.IP   := GetSetting(OPTION_TCPIP_ADDRESS);
    IdHTTPServer.Bindings.Add.Port := Str2Int(GetSetting(OPTION_TCPIP_PORT));
    {start the web server}
    IdHTTPServer.Active := TRUE;
    ...
    dbFirebird.Transactrion := txFirebird;
    ...
  end;

procedure TfrmWebServer.IdHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  var
    qryFirebird : TIBSql;

  function CreateSomeResponseStringData: string;
    begin
      qryFirebird := NIL;
      qryFirebird := TIBSql.Create(IdHTTPServer);
      qryFirebird.Database := dbFirebird;
      dbFirebird.Connected := FALSE;
      dbFirebird.Connected := TRUE;
      qryFirebird.Active := TRUE;
      Result := {...whatever string will be returned}
    end;

  function CreateAnErrorResponse: string;
    begin
      Result := {...whatever string will be returned}
    end;

  begin
    try        
      AResponseInfo.ContentText := CreateSomeResponseStringData;
      {Clean up: What do I do here to make sure that the connection that was served is:
         - properly closed so that I don't run out of resourses?
         - anything that needs to be cleaned up is freed so no memory leaks
         - TIME_WAIT, CLOSE_WAIT, any other kind of _WAITs are not accumulating?}
    except;
      AResponseInfo.ContentText := CreateAnErrorResponse;
    end;
    qryFirebird.Free;
  end;

procedure TfrmWebServer.IdHTTPServerDisconnect(AContext: TIdContext);
  begin
    {Maybe I do the "Clean Up" here? I tried Disconnect as shown but still lots of 
    TIME_WAIT tcp/ip connections accumulate. even after the app is closed}    
    AContext.Connection.Disconnect;
  end;

end.  

Answer 1

此代碼至少存在兩個可能導致崩潰的主要問題：

1. 數據庫和事務對象是IdHTTPServer創建的所有線程的全局對象。 當您斷開數據庫連接時，它將斷開所有線程的連接。

2. 如果在分配內容文本時發生運行時錯誤，則此行AResponseInfo.ContentText := CreateAnErrorResponse; 不在異常塊中。

這是我要解決的方法：

...
procedure TfrmWebServer.btnStartClick(Sender: TObject);
  begin
    {set the IP's and port to listen on}
    IdHTTPServer.Bindings.Clear;
    IdHTTPServer.Default.Port    := Str2Int(GetSetting(OPTION_TCPIP_PORT));
    IdHTTPServer.Bindings.Add.IP := GetSetting(OPTION_TCPIP_ADDRESS);
    {start the web server}
    IdHTTPServer.Active := TRUE;
    ...
  end;

procedure TfrmWebServer.IdHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  var
    {make these local to each thread}
    qryFirebird : TIBSql;
    dbFirebird  : TIBDatabase;
    txFirebird  : TIBTransaction;

  function CreateSomeResponseStringData: string;
    begin
      dbFirebird  := TIBDatbase.Create(IdHTTPServer);
      txFirebird  := TIBTransaction.Create(IdHTTPServer);
      qryFirebird := TIBSql.Create(IdHTTPServer);
      dbFirebird.Transaction := txFirebird;
      qryFirebird.Database := dbFirebird;
      ...Add params that do the log in to database
      dbFirebird.Connected := TRUE;
      qryFirebird.Active := TRUE;
      Result := {...whatever string will be returned}
    end;

  function CreateAnErrorResponse: string;
    begin
      Result := {...whatever string will be returned}
    end;

  begin
    try
      try        
        ...
        AResponseInfo.ContentText := CreateSomeResponseStringData;
        ...
      except;
        try
          AResponseInfo.ContentText := CreateAnErrorResponse;
        except
          {give up}
        end;
      end;
    finaly
      qryFirebird.Free;
      dbFirebird.Free;
      txFirebird.Free;
    end;
  end;

end.