ICS 9.3 Memory leak THttpAppSrv.PutDispatchVirtualDocument()

[YvesV 0]

I found a memory leak in unit OverbyteIcsHttpAppServer.pas in the function THttpAppSrv.PutDispatchVirtualDocument() 

Below the fix (search for "fix") and also in attachment the fixed OverbyteIcsHttpAppServer.pas file.

Note: a similar memory leak or a temp file that never will be deleted will probably also occur for large content. See the begin - end above the else with the fix.

 

 

function THttpAppSrv.PutDispatchVirtualDocument(ClientCnx : THttpAppSrvConnection;
                                            var Flags : THttpGetFlag; ExecFlag  : Boolean = False): Boolean;  { V9.1 added Exec }
var
    I, J    : Integer;
    PathBuf : String;
    Status  : Boolean;
    Proc    : TMethod;
    OK      : Boolean;
    Disp    : THttpDispatchElement;
    SObj    : TUrlHandler;
begin
    for I := 0 to FPutHandler.Count - 1 do begin
        Disp := FPutHandler.Disp[I];
        PathBuf := Disp.Path;
        J := Length(PathBuf);
        if PathBuf[J] = '*' then begin
            SetLength(PathBuf, J - 1);
            Status := AnsiStartsText(PathBuf, ClientCnx.Path);
        end
        else
            Status := (CompareText(PathBuf, ClientCnx.Path) = 0);

      { if HostTag specified, match it }
{$IFDEF USE_SSL}
        if Status and (ClientCnx.HostTag <> '') and (Disp.HostTag <> '') then begin
            if (Disp.HostTag <> ClientCnx.HostTag) then Status := False;
        end;
{$ENDIF}

        if Status then begin
            Result    := TRUE;
            if ExecFlag then begin    { V9.1 support upload using PUT }
                Disp      := FPutHandler.Disp[I];
                Flags     := Disp.FLags;
                OK        := TRUE;
                if Disp.Proc <> nil then begin
                    Proc.Code := Disp.Proc;
                    Proc.Data := ClientCnx;
                    ClientCnx.BeforePutHandler(TMyHttpHandler(Proc), OK);
                    if OK and (Proc.Code <> nil) then
                        TMyHttpHandler(Proc)(FLags);
                end
                else if Disp.SObjClass <> nil then begin
                    SObj := Disp.SobjClass.Create(Self);
                    try
                        SObj.FClient        := ClientCnx;
                        SObj.FFlags         := Disp.FLags;
                        SObj.FMsg_WM_FINISH := FMsg_WM_FINISH;
                        SObj.FWndHandle     := FHandle;
                        SObj.FMethod        := httpMethodPut;
                        ClientCnx.OnDestroying := SObj.ClientDestroying;
                        ClientCnx.BeforeObjPutHandler(SObj, OK);
                        if OK then begin
                            SObj.Execute;
                            Flags := SObj.FFlags;
                        end
                        else begin
                            Flags := SObj.FFlags;
                            FreeAndNil(SObj);
                        end;
                    except
                        on E:Exception do
                        begin
                            FreeAndNil(SObj);
                            if Assigned (FOnVirtualExceptionEvent) then
                                FOnVirtualExceptionEvent (Self, E, httpMethodPut, ClientCnx.Path);
                        end;
                    end;
                end;
            end
            else begin    { V9.1 support upload using PUT }
             { V9.1 abort request now if content too large }
                if (FMaxUploadMB > 0) and ((ClientCnx.RequestContentLength div IcsMBYTE) > FMaxUploadMB) then begin
                    Flags := hg403;
                    Exit;
                end;

             { V9.1 create stream, FileStream for very large content, otherwise MemoryStream  }
                ClientCnx.MaxPostMB := FMaxStreamMB;
                if (FMaxStreamMB > 0) and ((ClientCnx.RequestContentLength div IcsMBYTE) > FMaxStreamMB) then begin
                    if FUploadDir = '' then
                        FUploadDir := IcsGetTempPath;
                    FUploadDir := IncludeTrailingPathDelimiter(FUploadDir);
                    ClientCnx.PostTempName := FUploadDir + 'ics-httpserv' + IntToStr(Random(999999999)) + '.tmp';
                    ClientCnx.PostedDataStream := TIcsBufferedFileStream.Create(ClientCnx.PostTempName, fmCreate OR fmShareDenyNone, MAX_BUFSIZE);
                end
                else begin
                    //// 19/11/2024 Yves Vermeersch
                    // Fix memory leak
                    if Assigned(ClientCnx.PostedDataStream) then
                      ClientCnx.PostedDataStream.Free;
                    //// End fix
                    ClientCnx.PostedDataStream := TMemoryStream.Create;
                    TMemoryStream(ClientCnx.PostedDataStream).SetSize(ClientCnx.RequestContentLength);
                end;

            { V9.1 content PostData pointer will be set if accessed, ditto TBytes and String version }
                ClientCnx.PostedDataLen  := 0;
                ClientCnx.FPostedDataPtr := Nil;        { V9.1 }
                SetLength(ClientCnx.FPostedDataTB, 0);  { V9.1 }
                ClientCnx.FPostedDataStr := '';         { V9.1 }
                ClientCnx.FLineMode      := FALSE;
                Flags                    := hgAcceptData;
            end;
            Exit;
        end;
    end;
    Result := FALSE;
end;

 

OverbyteIcsHttpAppServer.pas

[Angus Robertson 574]

Thanks, fix will be added for the next release shortly.

 

Angus