apache - Delphi Apache Link Module 请求取消内存不足

Question

我在 Delphi 中开发了一个 Apache 链接模块，它还包含通过 WebActionItem（多部分表单数据）的上传功能。

只要客户端不取消请求，上传也可以正常工作。但是，如果请求被中止，httpd.exe 的内存会不断增加。

在几秒钟内，内存达到最大 8 GB，Apache 的子进程被杀死。

奇怪的是，如果客户端取消了请求，我的上传功能根本就达不到。请求进来时只调用 WebModule 的初始化。

我的问题：

Apache 是否负责上传文件并将其传递给 Delphi WebModule？

如果客户端中止请求时根本没有调用 WebModule 中的上传函数，我该如何干预？

我非常感谢任何提示，因为我一直在寻找解决方案。

编辑：

dpr 文件的示例：

library mod_restserver;

uses
  {$IFDEF MSWINDOWS}
  Winapi.ActiveX,
  System.Win.ComObj,
  {$ENDIF }
  Web.WebBroker,
  Web.ApacheApp,
  Web.HTTPD24Impl,
  Data.DBXCommon,
  Datasnap.DSSession,
  RESTServer.Service.WebModules in 'RESTServer.Service.WebModules.pas' {webModul: TWebModule};

// httpd.conf-Einträge:
//
(*
 LoadModule webbroker_module modules/mod_restserver.dll

 <Location /rest>
    SetHandler mod_restserver-handler
 </Location>
*)
//
// Diese Einträge setzen voraus, dass das Ausgabeverzeichnis für dieses Projekt das apache/modules-Verzeichnis ist.
//
// httpd.conf-Einträge sollten unterschiedlich sein, wenn das Projekt auf eine der folgenden Weisen geändert wird:
//   1. Der Name der Variable TApacheModuleData wird geändert.
//   2. Das Projekt wird umbenannt.
//   3. Das Ausgabeverzeichnis ist nicht das Verzeichnis apache/modules.
//   4. Die Erweiterung der dynamischen Bibliothek ist von der Plattform abhängig. Verwenden Sie für Windows .dll und für Linux .so.
//

// Exportierte Variable deklarieren, damit Apache auf dieses Modul zugreifen kann.
var
  GModuleData: TApacheModuleData;
exports
  GModuleData name 'webbroker_module';

procedure TerminateThreads;
begin
  TDSSessionManager.Instance.Free;
  Data.DBXCommon.TDBXScheduler.Instance.Free;
end;

begin
{$IFDEF MSWINDOWS}
  CoInitFlags := COINIT_MULTITHREADED;
{$ENDIF}
  Web.ApacheApp.InitApplication(@GModuleData);
  Application.Initialize;
  Application.WebModuleClass := WebModuleClass;
  TApacheApplication(Application).OnTerminate := TerminateThreads;
  Application.Run;
end.

以及 webmodule 的示例：

unit RESTServer.Service.WebModules;

interface

uses
  {$IFDEF MSWINDOWS}
  Winapi.ActiveX,
  System.Win.ComObj,
  {$ENDIF }
  System.SysUtils, System.Classes,
  Web.HTTPApp, Web.WebFileDispatcher, Web.HTTPProd,
  Datasnap.DSHTTPWebBroker, Datasnap.DSServer, DataSnap.DSAuth, Datasnap.DSCommonServer,
  IPPeerServer, IdContext, Datasnap.DSHTTP, ReqMulti, JSON, System.IOUtils;

type
  TwebModul = class(TWebModule)
    dsServer: TDSServer;
    procedure WebModule1DefaultHandlerAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure webModulfileUploadAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);

  private
    { Private-Deklarationen }

  public
    { Public-Deklarationen }
  end;

var
  WebModuleClass: TComponentClass = TwebModul;

implementation


{$R *.dfm}

uses
  Web.WebReq, Datasnap.DSSession;

procedure TwebModul.WebModule1DefaultHandlerAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content :=
    '{"return":-1, "result":0, "msg":"ressource unknown"}';
end;

procedure TwebModul.webModulfileUploadAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  joResponse: TJSONObject;
  iCount,
  iReturn, iResult: Integer;
  sPath, s: String;
  aFile: TAbstractWebRequestFile;
  ms: TMemoryStream;
begin
  joResponse := TJSONObject.Create;
  iReturn := 0;
  iResult := 0;
  try
    try
      if Request.Files.Count > 0 then
      begin
        for iCount := 0 to Request.Files.Count - 1 do
        begin
          aFile := Request.Files.Items[iCount];
          ms := TMemoryStream.Create;
          try
            sPath := 'C:\Data\test.txt';
            //if not DirectoryExists(sPath) then
            //  TDirectory.CreateDirectory(sPath);
            aFile.Stream.Position := 0;
            ms.CopyFrom(aFile.Stream, aFile.Stream.Size);
            ms.SaveToFile(sPath);
          finally
            ms.free;
          end;
          Inc(iResult);
        end;
      end;
    except
      on E: Exception do
      begin
        s := E.Message;
        iReturn := 2;
        iResult := 0;
      end;
    end;
  finally
    joResponse.AddPair(TJSONPair.Create('return', TJSONNumber.Create(iReturn)));
    joResponse.AddPair(TJSONPair.Create('result', TJSONNumber.Create(iResult)));

    Response.ContentType := 'application/json; charset=utf-8';
    Response.Content := joResponse.ToJSON;
  end;
end;

initialization
  CoInitialize(nil);

finalization
  CoUninitialize;

end.

标签： apachedelphiuploadmultipartform-data