Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
TIdSMTPServer - Questions (differences between v9 and v10)
#11
(07-17-2024, 08:15 PM)Justin Case Wrote: Well after mulling this over, despite your advice to me it makes sense to actually call RCPTTo event again

Not really...

(07-17-2024, 08:15 PM)Justin Case Wrote: That event filters out the ok addresses.. but then in the MsgReceive event I still need to know if incoming mail is for a local account or external.

You do that by simply looking at the domain portion of each recipient. If the domain belongs to the local system, that recipient is a local account. Otherwise, relay the email to that domain's own SMTP server.

(07-17-2024, 08:15 PM)Justin Case Wrote: The LAction variable parameter of the call to the RCPTTo is rather useful here and despite essentially duplicating the previous behaviour that variable then makes it easier to determine what to do with the incoming mail

Then you should refactor your code so you can share logic in both events, eg:

Code:
function IsAddressInLocalDomain(const AAddress: String): Boolean;
begin
  Query1.Close;
  Query1.SQL.Text := SQL('CheckAddressDomainIsLocal');
  Query1.Prepare;
  Query1.ParamByName('address').AsString := Utils.Parse('@', AAddress, 1);
  Query1.ParamByName('domain').AsString := Utils.Parse('@', AAddress, 2);
  Query1.Open;
  try
    Query1.First;
    Result := not Query1.EOF;
  finally
    Query1.Close;
  end;
end;

procedure TDataModule1.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
  const AAddress: String; AParams: TStrings; var VAction: TIdRCPToReply;
  var VForward: String);
begin
  if IsAddressInLocalDomain(AAddress) then begin
    VAction := rAddressOk;
  end
  else if ASender.LoggedIn then begin
    VAction := rWillForward;
  end
  else begin
    VAction := rRelayDenied;
  end;
end;

procedure TDataModule1.IdSMTPServer1MsgReceive(
  ASender: TIdSMTPServerContext; AMsg: TStream;
  var VAction: TIdDataReply);
var
  I: Integer;
  ...
begin
  for I := 0 to ASender.RCPTList.Count -1 do
  begin
    if IsAddressInLocalDomain(ASender.RCPTList[I].Address) then
    begin
      {TODO : Save to database}
      ...
    end
    else
    begin
      {TODO : Send onwards elsewhere}
    end;
  end;
  VAction := dOk;
end;

That being said, you are only looking at the entire address as a whole. You should be looking just at the domain portion of the address to determine if it is targeting a local account or not. If the domain is local but the account is not found locally, your logic would try to relay that address, when it could just fail the address instead, eg:

Code:
function IsLocalDomain(const ADomain: String): Boolean;
begin
  Result := ADomain = 'my.domain'; // or whatever you need to do to check this...
end;

type
  TUserDomainResult = (UserInLocalDomain, UserNotInLocalDomain, ExternalUser);

function CheckUserInLocalDomain(const AUser, ADomain: String): TUserDomainResult;
begin
  if IsLocalDomain(ADomain) then
  begin
    Query1.Close;
    Query1.SQL.Text := SQL('CheckAddressDomainIsLocal');
    Query1.Prepare;
    Query1.ParamByName('address').AsString := AUser;
    Query1.ParamByName('domain').AsString := ADomain;
    Query1.Open;
    try
      Query1.First;
      if not Query1.EOF then
        Result := UserInLocalDomain
      else
        Result := UserNotInLocalDomain;
    finally
      Query1.Close;
    end;
  end
  else begin
    Result := ExternalUser;
  end;
end;

procedure TDataModule1.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
  const AAddress: String; AParams: TStrings; var VAction: TIdRCPToReply;
  var VForward: String);
var
  user, domain: string;
begin
  user := Utils.Parse('@', AAddress, 1);
  domain := Utils.Parse('@', AAddress, 2);
  case CheckUserInLocalDomain(user, domain) of
    UserInLocalDomain: begin
      VAction := rAddressOk;
    end;
    UserNotInLocalDomain: begin
      VAction := rInvalid; // or rRelayDenied or rNoForward
    end;
    ExternalUser: begin
      if ASender.LoggedIn then
        VAction := rWillForward
      else
        VAction := rRelayDenied;
    end;
  end;
end;

procedure TDataModule1.IdSMTPServer1MsgReceive(
  ASender: TIdSMTPServerContext; AMsg: TStream;
  var VAction: TIdDataReply);
var
  I: Integer;
  ...
begin
  for I := 0 to ASender.RCPTList.Count -1 do
  begin
    if IsLocalDomain(ASender.RCPTList[I].Domain) then
    begin
      {TODO : Save to database}
      ...
    end
    else
    begin
      {TODO : Send onwards elsewhere}
    end;
  end;
  VAction := dOk;
end;

Otherwise, you can have the OnRcptTo event accept all accounts in the local domain, even if they don't exist, and then have OnMsgReceive send a failure email back to the client if a local account is not found, eg:

Code:
procedure TDataModule1.IdSMTPServer1RcptTo(ASender: TIdSMTPServerContext;
  const AAddress: String; AParams: TStrings; var VAction: TIdRCPToReply;
  var VForward: String);
var
  domain: string;
begin
  domain := Utils.Parse('@', AAddress, 2);
  if IsLocalDomain(domain) then begin
    VAction := rAddressOk;
  end
  else if ASender.LoggedIn then begin
    VAction := rWillForward;
  end
  else begin
    VAction := rRelayDenied;
  end;
end;

procedure TDataModule1.IdSMTPServer1MsgReceive(
  ASender: TIdSMTPServerContext; AMsg: TStream;
  var VAction: TIdDataReply);
var
  I: Integer;
  ...
begin
  for I := 0 to ASender.RCPTList.Count -1 do
  begin
    if IsLocalDomain(ASender.RCPTList[I].Domain) then
    begin
      if IsUserInLocalDomain(ASender.RCPTList[I].Username, ASender.RCPTList[I].Domain) then
      begin
        {TODO : Save to database}
        ...
      end
      else
      begin
        {TODO : Send failure email to ASender.From if not blank }
      end;
    end
    else
    begin
      {TODO : Send onwards elsewhere}
    end;
  end;
  VAction := dOk;
end;

Now, THAT being said - another option would be to do the DB check in the OnRcptTo event and cache the results where the OnMsgReceive event can use them without having to hit the DB again. You could use the ASender.Data property for that. Or you could derive a new class from TIdSMTPServerContext to add caching logic, and then assign that class type to the TIdSMTPServer.ContextClass property.

Reply


Messages In This Thread
RE: TIdSMTPServer - Questions (differences between v9 and v10) - by rlebeau - 07-17-2024, 10:32 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)