Re: Performance problem with hugh attachement

Giganews Newsgroups
Subject: Re: Performance problem with hugh attachement
Posted by:  Richard Gillingham (richa…@richardgillingham.com)
Date: Fri, 8 Apr 2005

Hi Charles

Another thing to consider is a memorystream that has a fixed buffer size -
then read in the file in blocks and stream a block at a time down the wire.
This way you avoid having to hold the whole file image inmemory (a bit along
the lines of the kbmMW file service).  I don't know if the SMTP server can
be changed to work this way but imaging it could be.

Richard

"Charles Molnar" <charles.moln…@micotan.com> wrote in message
news:354AFAAD30C6E240charles.moln…@micotan.com...
> Hi
>
> I was testing the IdSMTPServer and it is working reasonable till the
> size of the email reaches 5M. Over that it is getting extremly slow. Eg.
> an email with 14Mb attachement takes 3-5minutes to receive. Which I
> think is not acceptable.
>
> I know it is the problem of the TMemoryStream. With the original Borland
> TMemoryStream every time when the stream size is increased the whole
> stream content is reallocated and copied. While the email is received
> the stream size is always increased with the received chunk length. I'm
> not sure how bug is your receive buffer, but assume it is 1024 or 4096
> bytes. Let's say 1024, in this case the increasing size stream gets
> copied 14336 times. No wonder why is it slow.
>
> One way to solve it is to change the memory manager, but not the best
> solution, because it can introduce other problems. So I'm tring to stay
> away from it.
>
> As an other workaround I created the TSmartMemoryStream object which is
> inherited from the original TMemoryStream, the Realloc function is
> overrided so I can take charge of the memory reallocation.
> Size >  16384 => New Size :=  65536
> Size >  65536 => New Size :=  262144
> Size >  262144 => New Size :=  524288
> Size >  524288 => New Size := 1048576
> Size > 1048576 => New Size := 2097152
> Size >    (x)M => New Size :=  (x+1)M
>
> This little trick brings down the 3-5 minutes to 20seconds.
>
> Right now I can override the DATA command handler, and can use my own
> TSmartMemoryStream for the receive. I don't really like the solution,
> because any time when indy is updated I have to spend some time on
> checking or tweaking.
>
> For now I created my own DATA command handler and copied the whole
> CommandDATA function from the IdSMTPServer.pas. Of course I was facing
> all sorts of problems with protected member fucntions, etc... But it is
> working now.
>
> I attached it if somebody is interested.
>
> After the long introduction I'd like to know if the TeamB could put some
> kind of intelligence (like the SmartMemoryStream) in the code for better
> performance.
>
> Thanks
>
> --
> Karoly Molnar
> Software Development
> Micotan Software Company Ltd.

--------------------------------------------------------------------------------

> unit Unit1;
>
> interface
>
> uses
>  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
> Forms,
>  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdCmdTCPServer,
>  IdExplicitTLSClientServerBase, IdSMTPServer, IdCommandHandlers, IdReply,
>  IdGlobal, IdStack;
>
> type
>  TMyIdSMTPServer = class(TIdSMTPServer)
>    public
>      procedure SetEnhReply(AReply: TIdReply;
>      const ANumericCode: Integer; const AEnhReply, AText: String;
>      const IsEHLO: Boolean);
>      procedure MailSubmitOk(ASender: TIdCommand);
>      procedure MailSubmitLimitExceeded(ASender: TIdCommand);
>      procedure MailSubmitStorageExceededFull(ASender: TIdCommand);
>      procedure MailSubmitTransactionFailed(ASender: TIdCommand);
>      procedure MailSubmitLocalProcessingError(ASender: TIdCommand);
>      procedure MailSubmitSystemFull(ASender: TIdCommand);
>      procedure NoHello(ASender: TIdCommand);
>  end;
>
>  TForm1 = class(TForm)
>    IdSMTPServer1: TIdSMTPServer;
>    procedure FormDestroy(Sender: TObject);
>    procedure FormCreate(Sender: TObject);
>    procedure IdSMTPServer1TIdCommandHandler0Command(ASender: TIdCommand);
>    procedure IdSMTPServer1MailFrom(ASender: TIdSMTPServerContext;
>      const AAddress: string; var VAction: TIdMailFromReply);
>    procedure IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
>      const AAddress: string; var VAction: TIdRCPToReply; var VForward:
> string);
>    procedure IdSMTPServer1MsgReceive(ASender: TIdSMTPServerContext;
>      AMsg: TStream; var LAction: TIdDataReply);
>  private
>    { Private declarations }
>  public
>    { Public declarations }
>  end;
>
> var
>  Form1: TForm1;
>
> implementation
>
> {$R *.dfm}
>
> uses SmartMemoryStream, IdResourceStringsProtocols;
>
> { TMyIdSMTPServer }
>
> procedure TMyIdSMTPServer.MailSubmitTransactionFailed(ASender:
> TIdCommand);
> begin
>  inherited;
> end;
>
> procedure TMyIdSMTPServer.MailSubmitStorageExceededFull(ASender:
> TIdCommand);
> begin
>  inherited;
> end;
>
> procedure TMyIdSMTPServer.MailSubmitLimitExceeded(ASender: TIdCommand);
> begin
>  inherited;
> end;
>
> procedure TMyIdSMTPServer.MailSubmitLocalProcessingError(ASender:
> TIdCommand);
> begin
>  inherited;
> end;
>
> procedure TMyIdSMTPServer.MailSubmitOk(ASender: TIdCommand);
> begin
>  inherited;
> end;
>
> procedure TMyIdSMTPServer.MailSubmitSystemFull(ASender: TIdCommand);
> begin
>  inherited;
> end;
>
> procedure TMyIdSMTPServer.SetEnhReply(AReply: TIdReply;
>  const ANumericCode: Integer; const AEnhReply, AText: String;
>  const IsEHLO: Boolean);
> begin
>  inherited;
> end;
>
> procedure TMyIdSMTPServer.NoHello(ASender: TIdCommand);
> begin
>  inherited;
> end;
>
> { TForm1 }
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
>  IdSMTPServer1.Active := True;
> end;
>
> procedure TForm1.FormDestroy(Sender: TObject);
> begin
>  IdSMTPServer1.Active := False;
> end;
>
> procedure TForm1.IdSMTPServer1MsgReceive(ASender: TIdSMTPServerContext;
>  AMsg: TStream; var LAction: TIdDataReply);
> begin
>  LAction := dOk;
> end;
>
> procedure TForm1.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
>  const AAddress: string; var VAction: TIdRCPToReply; var VForward:
> string);
> begin
>  VAction := rAddressOk;
> end;
>
> procedure TForm1.IdSMTPServer1MailFrom(ASender: TIdSMTPServerContext;
>  const AAddress: string; var VAction: TIdMailFromReply);
> begin
>  VAction := mAccept;
> end;
>
> procedure TForm1.IdSMTPServer1TIdCommandHandler0Command(ASender:
> TIdCommand);
> var
>  LS : TIdSMTPServerContext;
>  LStream: TStream;
>  AMsg : TStream;
>  LAction : TIdDataReply;
>  ReceivedString : String;
> begin
>  ReceivedString := IdSMTPSvrReceivedString;
>  LS := ASender.Context as TIdSMTPServerContext;
>  if (LS.SMTPState <> idSMTPRcpt) then
>  begin
>    TMyIdSMTPServer( IdSMTPServer1 ).BadSequenceError(ASender);
>    Exit;
>  end;
>  if LS.HELO or LS.EHLO then
>  begin
>    TMyIdSMTPServer( IdSMTPServer1 ).SetEnhReply(ASender.Reply,354,
> '',RSSMTPSvrStartData,(ASender.Context as TIdSMTPServerContext).EHLO);
>    ASender.SendReply;
>    LS.PipeLining := False;
>
>    // !!! These two lines would need to change !!!
>    LStream := TSmartMemoryStream.Create;
>    AMsg    := TSmartMemoryStream.Create;
>    try
>      LAction := dOk;
>      ASender.Context.Connection.IOHandler.Capture(LStream, '.', True);
> {Do not Localize}
>      LStream.Position := 0;
>      if Assigned(IdSMTPServer1.OnReceived) then
>      begin
>        IdSMTPServer1.OnReceived(LS, ReceivedString);
>      end;
>      if LS.FinalStage then
>      Begin
>        // If at the final delivery stage, add the Return-Path line for the
> received MAIL FROM line.
>        WriteStringToStream(AMsg, 'Received-Path: <' + LS.From + '>' +
> EOL); {do not localize}
>      End;
>
>      if ReceivedString <> '' then
>      Begin
>        // Parse the ReceivedString and replace any of the special 'tokens'
>        ReceivedString := StringReplace(ReceivedString, '$hostname',
> GStack.HostByAddress(ASender.Context.Binding.PeerIP), [rfReplaceall]); {do
> not localize}
>        ReceivedString := StringReplace(ReceivedString, '$ipaddress',
> ASender.Context.Binding.PeerIP, [rfReplaceall]); {do not localize}
>        ReceivedString := StringReplace(ReceivedString, '$helo',
> LS.HeloString, [rfReplaceall]);
>        if LS.EHLO then
>        ReceivedString := StringReplace(ReceivedString, '$protocol',
> 'esmtp', [rfReplaceall]) {do not localize}
>        else
>        ReceivedString := StringReplace(ReceivedString, '$protocol',
> 'smtp', [rfReplaceall]); {do not localize}
>        ReceivedString := StringReplace(ReceivedString, '$servername',
> IdSMTPServer1.ServerName, [rfReplaceall]);
>        ReceivedString := StringReplace(ReceivedString, '$svrhostname',
> GStack.HostByAddress(ASender.Context.Binding.IP), [rfReplaceAll]);
>        ReceivedString := StringReplace(ReceivedString, '$svripaddress',
> ASender.Context.Binding.IP, [rfReplaceAll]);
>
>        WriteStringToStream(AMsg, ReceivedString + EOL);
>      End;
>      AMsg.CopyFrom(LStream, 0); // Copy the contents that was captured to
> the new stream.
>      if Assigned(IdSMTPServer1.OnMsgReceive) then
>      begin
>        IdSMTPServer1.OnMsgReceive(LS,AMsg,LAction);
>      end;
>    finally
>      FreeAndNil(LStream);
>      FreeAndNil(AMsg);
>    end;
>
>    case LAction of
>    dOk                  : TMyIdSMTPServer(
> IdSMTPServer1 ).MailSubmitOk(ASender); //accept the mail message
>    dMBFull              : TMyIdSMTPServer(
> IdSMTPServer1 ).MailSubmitStorageExceededFull(ASender); //Mail box full
>    dSystemFull          : TMyIdSMTPServer(
> IdSMTPServer1 ).MailSubmitSystemFull(ASender); //no more space on server
>    dLocalProcessingError : TMyIdSMTPServer(
> IdSMTPServer1 ).MailSubmitLocalProcessingError(ASender); //local
> processing error
>    dTransactionFailed    : TMyIdSMTPServer(
> IdSMTPServer1 ).MailSubmitTransactionFailed(ASender); //transaction failed
>    dLimitExceeded        : TMyIdSMTPServer(
> IdSMTPServer1 ).MailSubmitLimitExceeded(ASender); //exceeded
> administrative limit
>    end;
>
>  end
>  else // No EHLO / HELO was received
>  begin
>    TMyIdSMTPServer( IdSMTPServer1 ).NoHello(ASender);
>  end;
>  TIdSMTPServerContext(ASender.Context).PipeLining := False;
> end;
>
> end.

--------------------------------------------------------------------------------

> {******************************************************************************}
> {
>      }
> {                        Karoly Molnar (Gumicsoves)
>      }
> {
>      }
> {                      Usage: Use if it was a
>              }
> {
>      }
> {            Freely distributable, changeable, no copyrights at all.
>    }
> {
>      }
> {******************************************************************************}
>
> unit SmartMemoryStream;
>
> interface
>
> uses Classes;
>
> type
>  TSmartMemoryStream = class(TMemoryStream)
>  private
>    FMemoryDelta: Longint;
>  protected
>    function Realloc(var NewCapacity: Longint): Pointer; override;
>  public
>    constructor Create( AMemoryDelta: Longint = $100000 );
>  end;
>
> implementation
>
> constructor TSmartMemoryStream.Create(AMemoryDelta: Integer);
> begin
>  FMemoryDelta := AMemoryDelta;
> end;
>
> function TSmartMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
> begin
>  if ( NewCapacity < FMemoryDelta ) and ( NewCapacity < 1048576 ) then
>  begin
>    if NewCapacity > 524288 then
>      NewCapacity := 1048576
>
>    else if NewCapacity > 262144 then
>      NewCapacity := 524288
>
>    else if NewCapacity > 65536 then
>      NewCapacity := 262144
>
>    else if NewCapacity > 16384 then
>      NewCapacity := 65536;
>  end
>  else if ( NewCapacity mod FMemoryDelta ) <> 0 then
>    NewCapacity := FMemoryDelta * ( ( NewCapacity div FMemoryDelta ) + 1 );
>
>  Result := inherited Realloc( NewCapacity );
> end;
>
> end.

--------------------------------------------------------------------------------

> object Form1: TForm1
>  Left = 0
>  Top = 0
>  Width = 391
>  Height = 270
>  Caption = 'Form1'
>  Color = clBtnFace
>  Font.Charset = DEFAULT_CHARSET
>  Font.Color = clWindowText
>  Font.Height = -11
>  Font.Name = 'Tahoma'
>  Font.Style = []
>  OldCreateOrder = False
>  OnCreate = FormCreate
>  OnDestroy = FormDestroy
>  PixelsPerInch = 96
>  TextHeight = 13
>  object IdSMTPServer1: TIdSMTPServer
>    Bindings = <
>      item
>        IP = '0.0.0.0'
>        Port = 25
>      end>
>    CommandHandlers = <
>      item
>        CmdDelimiter = ' '
>        Command = 'DATA'
>        Disconnect = False
>        Name = 'TIdCommandHandler0'
>        NormalReply.Code = '200'
>        ParamDelimiter = ' '
>        Tag = 0
>        OnCommand = IdSMTPServer1TIdCommandHandler0Command
>      end>
>    ExceptionReply.Code = '500'
>    ExceptionReply.Text.Strings = (
>      'Unknown Internal Error')
>    Greeting.Code = '220'
>    Greeting.Text.Strings = (
>      'Welcome to the INDY SMTP Server')
>    HelpReply.Text.Strings = (
>      'Help follows')
>    MaxConnectionReply.Code = '300'
>    MaxConnectionReply.Text.Strings = (
>      'Too many connections. Try again later.')
>    ReplyTexts = <>
>    ReplyUnknownCommand.Code = '500'
>    ReplyUnknownCommand.Text.Strings = (
>      'Syntax Error')
>    ReplyUnknownCommand.EnhancedCode.StatusClass = 5
>    ReplyUnknownCommand.EnhancedCode.Subject = 5
>    ReplyUnknownCommand.EnhancedCode.Details = 2
>    ReplyUnknownCommand.EnhancedCode.Available = True
>    ReplyUnknownCommand.EnhancedCode.ReplyAsStr = '5.5.2'
>    OnMsgReceive = IdSMTPServer1MsgReceive
>    OnMailFrom = IdSMTPServer1MailFrom
>    OnRcptTo = IdSMTPServer1RcptTo
>    ServerName = 'Indy SMTP Server'
>    Left = 8
>    Top = 8
>  end
> end

Replies

In response to

Performance problem with hugh attachement posted by Charles Molnar on Thu, 07 Apr 2005