(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.
