SMTP server drops many incoming messages

Giganews Newsgroups
Subject: SMTP server drops many incoming messages
Posted by:  kgmccoydt (kgmccoy…@idk-inc.com)
Date: Thu, 16 Feb 2006

I am running an Indy 10 based SMTP server.  When someone connects in an
attempt to send me a message, TIdSMTPServer.CommandDATA does a
reverse-dns hostname lookup of the incoming IP address.  Most of the
time it works fine and the message comes through.

Sometimes the hostname lookup fails for some reason and HostByIP throws
an exception.  This may happen if the sender does not have a PTR record
in their DNS record - I don't know for sure. It might also be a DNS
timeout issue as the lookup seems to take several seconds on ones that
fail. The exception caused by the DNS failure is probably as nature
intended.

The problem is that CommandDATA does not catch the exception correctly
and bombs completely, tossing the message!  My server was tossing
hundreds of legitimate messages, simply because it couldn't do a
hostname lookup.

I added a gross patch to fix the problem.  I trap the exception and
overwrite the $hostname token with "unknown" if the reverse DNS fails.
There is probably a cleaner way to do this, but it does seem to work.

I hope this helps someone else out.  This one had me pulling my hair out
in large handfuls. :-)

Best regards,

Kevin McCoy
gravitytester somewhereat idk-inc dot com

//------------- source code follows -------------

procedure TIdSMTPServer.CommandDATA(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
    BadSequenceError(ASender);
    Exit;
  end;
  if LS.HELO or LS.EHLO then
  begin
    SetEnhReply(ASender.Reply,354,
'',RSSMTPSvrStartData,(ASender.Context as TIdSMTPServerContext).EHLO);
    ASender.SendReply;
    LS.PipeLining := False;
    LStream := TMemoryStream.Create;
    AMsg    := TMemoryStream.Create;
    try
      LAction := dOk;
      ASender.Context.Connection.IOHandler.Capture(LStream, '.', True);
    {Do not Localize}
      LStream.Position := 0;
      if Assigned(OnReceived) then
      begin
        FOnReceived(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'

/***** added try/except block Kevin McCoy 16 Feb 2006 *****/
        try
            ReceivedString := StringReplace(ReceivedString,
'$hostname', GStack.HostByAddress(ASender.Context.Binding.PeerIP),
[rfReplaceall]); {do not localize}
        except
            on E:Exception do
                ReceivedString := StringReplace(ReceivedString,
'$hostname', 'unknown', [rfReplaceall]); {do not localize}
        END;
        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',
FServerName, [rfReplaceall]);
/***** added try/except block Kevin McCoy 16 Feb 2006 *****/
        try
            ReceivedString := StringReplace(ReceivedString,
'$svrhostname', GStack.HostByAddress(ASender.Context.Binding.IP),
[rfReplaceAll]);
        except
            on E:Exception do
                ReceivedString := StringReplace(ReceivedString,
'$svrhostname', 'unknown', [rfReplaceAll]);
        END;
        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(OnMsgReceive) then
      begin
        FOnMsgReceive(LS,AMsg,LAction);
      end;
    finally
      FreeAndNil(LStream);
      FreeAndNil(AMsg);
    end;
    case LAction of
    dOk                  : MailSubmitOk(ASender); //accept the mail
message
    dMBFull              : MailSubmitStorageExceededFull(ASender);
//Mail box full
    dSystemFull          : MailSubmitSystemFull(ASender); //no more
space on server
    dLocalProcessingError : MailSubmitLocalProcessingError(ASender);
//local processing error
    dTransactionFailed    : MailSubmitTransactionFailed(ASender);
//transaction failed
    dLimitExceeded        : MailSubmitLimitExceeded(ASender);
//exceeded administrative limit
    end;
  end
  else // No EHLO / HELO was received
  begin
    Self.NoHello(ASender);
  end;
  TIdSMTPServerContext(ASender.Context).PipeLining := False;
end;

//------------------------

Replies