- Previously it was possible that MgSMTP erroneously administered
an e-mail as delivered, when the server accepted the recipient in
the RCPT stage, but disconnected before or in the DATA stage.
This patch mainly addresses this issue, by making sure that the
transaction is completed, before administering a final status.
- MgSMTP is now more tolerant with non-compliant replies,
e.g., accepts 250 for connection opening, not only 220.
- Increased relay send buffer size from 32 lines to 64.
modified: Common.pas
modified: MgSMTP.pas
modified: Relay.pas
modified: Spool.pas
procedure AddRecipient(Recipient: TRecipient); overload;
procedure SetReturnPath(Address: string);
procedure SetRecipientData(Index, Data: integer; RMsg: string = '');
procedure AddRecipient(Recipient: TRecipient); overload;
procedure SetReturnPath(Address: string);
procedure SetRecipientData(Index, Data: integer; RMsg: string = '');
+ procedure SetAllRecipientData(Data: integer; RMsg: string = '');
procedure SetRelayHost(HostName: string);
property ReturnPath: string read FReturnPath write SetReturnPath;
property RelayHost: string read FRelayHost write SetRelayHost;
procedure SetRelayHost(HostName: string);
property ReturnPath: string read FReturnPath write SetReturnPath;
property RelayHost: string read FRelayHost write SetRelayHost;
function EMailTimeStamp(DateTime: TDateTime): string;
function EMailTimeStampCorrected(DateTime: TDateTime): string;
function StatusToStr(Status: integer): string;
function EMailTimeStamp(DateTime: TDateTime): string;
function EMailTimeStampCorrected(DateTime: TDateTime): string;
function StatusToStr(Status: integer): string;
- procedure AssignDeliveryStatusToSMTPCodes(Envelope: TEnvelope);
+ procedure AssignDeliveryStatusToSMTPCodes(Envelope: TEnvelope; TransactionComplete: boolean);
function CleanEOLN(S: string): string;
function GenerateRandomString(Length: integer): string;
function CleanEOLN(S: string): string;
function GenerateRandomString(Length: integer): string;
+ '+' + IntToStr(Status and DS_SMTPREPLYMASK);
end;
+ '+' + IntToStr(Status and DS_SMTPREPLYMASK);
end;
-procedure AssignDeliveryStatusToSMTPCodes(Envelope: TEnvelope);
+procedure AssignDeliveryStatusToSMTPCodes(Envelope: TEnvelope; TransactionComplete: boolean);
var i, code, cond, status: integer; Recipient: TRecipient;
begin
for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
var i, code, cond, status: integer; Recipient: TRecipient;
begin
for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
cond:= code div 100;
case cond of
0: status:= DS_DELAYED or DS_UNEXPECTEDFAIL;
cond:= code div 100;
case cond of
0: status:= DS_DELAYED or DS_UNEXPECTEDFAIL;
- 2: status:= DS_DELIVERED;
+ 2: if TransactionComplete then status:= DS_DELIVERED
+ else status:= DS_DELAYED or DS_UNEXPECTEDFAIL;
4: status:= DS_DELAYED;
5: status:= DS_PERMANENT;
else status:= DS_PERMANENT or DS_UNEXPECTEDFAIL;
4: status:= DS_DELAYED;
5: status:= DS_PERMANENT;
else status:= DS_PERMANENT or DS_UNEXPECTEDFAIL;
FRecipients[Index].Data:= Data;
end;
FRecipients[Index].Data:= Data;
end;
+procedure TEnvelope.SetAllRecipientData(Data: integer; RMsg: string = '');
+var i: integer;
+begin
+ for i:= 0 to Length(FRecipients) - 1 do
+ SetRecipientData(i, Data, RMsg);
+end;
+
procedure TEnvelope.SetReturnPath(Address: string);
begin
FReturnPath:= Address;
procedure TEnvelope.SetReturnPath(Address: string);
begin
FReturnPath:= Address;
document what bugfix/feature are you testing with the actual build.
This will be logged to help you differentiate outputs of subsequent
builds in your logs. If left empty, it won't be added to the logs. }
document what bugfix/feature are you testing with the actual build.
This will be logged to help you differentiate outputs of subsequent
builds in your logs. If left empty, it won't be added to the logs. }
- DEVCOMMENT = 'EHLO->HELO fallback';
+ DEVCOMMENT = 'Detect unexpected disconnection';
{
MegaBrutal's SMTP Server (MgSMTP)
{
MegaBrutal's SMTP Server (MgSMTP)
- Copyright (C) 2010 MegaBrutal
+ Copyright (C) 2010-2015 MegaBrutal
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
protected
FEnvelope: TEnvelope;
FEMailProperties: TEMailProperties;
protected
FEnvelope: TEnvelope;
FEMailProperties: TEMailProperties;
+ FTransactionComplete: boolean;
FRoutingTarget: TRoutingTarget;
RoutingTable: TRoutingTable;
TCP: TTCPRFCConnection;
FRoutingTarget: TRoutingTarget;
RoutingTable: TRoutingTable;
TCP: TTCPRFCConnection;
public
property Envelope: TEnvelope read FEnvelope;
property EMailProperties: TEMailProperties read FEMailProperties;
public
property Envelope: TEnvelope read FEnvelope;
property EMailProperties: TEMailProperties read FEMailProperties;
+ property IsTransactionComplete: boolean read FTransactionComplete;
property RelayServerName: string read GetRelayServerName;
property RelayServerPort: integer read GetRelayServerPort;
function OpenConnection: boolean;
property RelayServerName: string read GetRelayServerName;
property RelayServerPort: integer read GetRelayServerPort;
function OpenConnection: boolean;
Self.RoutingTable:= RoutingTable;
FEnvelope:= Envelope;
FEMailProperties:= EMailProperties;
Self.RoutingTable:= RoutingTable;
FEnvelope:= Envelope;
FEMailProperties:= EMailProperties;
+ FTransactionComplete:= false;
FRoutingTarget:= RoutingTable.GetRouteInfo(Envelope.RelayHost);
Response:= TRFCReply.Create;
FillChar(SMTPExtensions, SizeOf(TSMTPExtensions), #0);
FRoutingTarget:= RoutingTable.GetRouteInfo(Envelope.RelayHost);
Response:= TRFCReply.Create;
FillChar(SMTPExtensions, SizeOf(TSMTPExtensions), #0);
procedure TRelayer.AdministerMassFailure(var Result: boolean);
procedure TRelayer.AdministerMassFailure(var Result: boolean);
- for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
- Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
+ Envelope.SetAllRecipientData(Response.GetNumericCode, Response.ReplyText.Text);
end
else Result:= false;
MXList.Free;
end
else Result:= false;
MXList.Free;
+ FTransactionComplete:= false;
end;
function TRelayer.Greet: boolean;
{ This function reads and checks the relay server's greeting.
end;
function TRelayer.Greet: boolean;
{ This function reads and checks the relay server's greeting.
+ Then identifies this server with an EHLO.
Then, if necessary, authenticates at the connected relay server.
Then, if necessary, authenticates at the connected relay server.
- Then identifies this server with a HELO.
The function returns true, if the authentication and the EHLO command were
successful. }
var
The function returns true, if the authentication and the EHLO command were
successful. }
var
Response.Clear;
AdministerMassFailure(Result);
TCP.ReadResponse(Response);
Response.Clear;
AdministerMassFailure(Result);
TCP.ReadResponse(Response);
- if Response.GetNumericCode = SMTP_R_READY then begin
+
+ { Expect 2xx reply. }
+ if (Response.GetNumericCode div 100) = 2 then begin
TCP.SendCommand(SMTP_C_EHLO, MainServerConfig.Name);
TCP.ReadResponse(Response);
TCP.SendCommand(SMTP_C_EHLO, MainServerConfig.Name);
TCP.ReadResponse(Response);
{ Sends the envelope (that is the return-path and the recipient addresses).
The function returns true, if the MAIL command were successful, and the
relay server has accepted at least one of the recipient addresses.
{ Sends the envelope (that is the return-path and the recipient addresses).
The function returns true, if the MAIL command were successful, and the
relay server has accepted at least one of the recipient addresses.
+ This function returns false if a null reply is read, which is considered
+ as protocol violation.
This function is aware of the SMTP extension, named PIPELINING. If it's
supported by the server, we send RCPT commands stuffed, without waiting
for a response. After all RCPTs are sent, we check all responses. }
var
This function is aware of the SMTP extension, named PIPELINING. If it's
supported by the server, we send RCPT commands stuffed, without waiting
for a response. After all RCPTs are sent, we check all responses. }
var
- i, c: integer; Prms: string;
+ i, c: integer; UltimateFail: boolean; Prms: string;
procedure ProcessRCPTResponse;
begin
TCP.ReadResponse(Response);
procedure ProcessRCPTResponse;
begin
TCP.ReadResponse(Response);
- if Response.GetNumericCode = SMTP_R_OK then Inc(c);
+ { If we get an "OK" reply code, we increase the count of sucessful
+ recipients. }
+ if Response.GetNumericCode = SMTP_R_OK then Inc(c)
+ { Response code 0 is non-existent in the SMTP protocol.
+ If we receive something we _perceive_ as 0, then it is likely
+ that something seriously went wrong. MgSMTP shouldn't treat
+ this condition as permanent. }
+ else if Response.GetNumericCode = 0 then UltimateFail:= true;
Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
end;
begin
Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
end;
begin
+ { The MAIL command is considered the beginning of the transaction. }
+ FTransactionComplete:= false;
+ UltimateFail:= false;
Response.Clear;
Prms:= 'FROM:<' + Envelope.ReturnPath + '>';
Response.Clear;
Prms:= 'FROM:<' + Envelope.ReturnPath + '>';
for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
ProcessRCPTResponse;
for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
ProcessRCPTResponse;
+ Result:= (c <> 0) and (not UltimateFail);
+
+ { If there are no accepted recipients, and no protocol failure is
+ discovered, we can't send the DATA command, and practically we
+ can do nothing more for this transaction. Therefore it is
+ considered complete by protocol. }
+ FTransactionComplete:= (c = 0) and (not UltimateFail);
+
+ { Either way, try to reset SMTP state in case of failure. }
TCP.SendCommand(SMTP_C_RSET);
TCP.ReadResponse(Response);
end;
TCP.SendCommand(SMTP_C_RSET);
TCP.ReadResponse(Response);
end;
begin
TCP.WriteLn('.');
TCP.ReadResponse(Response);
begin
TCP.WriteLn('.');
TCP.ReadResponse(Response);
+
+ { Mark the transaction complete, if we have a valid response. }
+ FTransactionComplete:= Response.GetNumericCode <> 0;
+
for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
+ { Set status code for recipients those were accepted in the envelope stage: }
if Envelope.GetRecipient(i).Data = SMTP_R_OK then
Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
end;
if Envelope.GetRecipient(i).Data = SMTP_R_OK then
Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
end;
{
MegaBrutal's SMTP Server (MgSMTP)
{
MegaBrutal's SMTP Server (MgSMTP)
- Copyright (C) 2010-2014 MegaBrutal
+ Copyright (C) 2010-2015 MegaBrutal
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
SpoolConfig: TSpoolConfig;
SpoolFilters: TSpoolFilters;
function DeliverLocalMessage(SpoolObject: TSpoolObjectReader; MailboxPtr: pointer; ReturnPath, Recipient: string): integer;
SpoolConfig: TSpoolConfig;
SpoolFilters: TSpoolFilters;
function DeliverLocalMessage(SpoolObject: TSpoolObjectReader; MailboxPtr: pointer; ReturnPath, Recipient: string): integer;
- procedure DeliverRelayMessage(SpoolObject: TSpoolObjectReader; Relayer: TRelayer);
+ function DeliverRelayMessage(SpoolObject: TSpoolObjectReader; Relayer: TRelayer): boolean;
procedure HandleFailure(SpoolObject: TSpoolObjectReader; IsLocal: boolean; FailEnvelope: TEnvelope; FailedRecipient: TRecipient; AddStatus: integer; FailMsg: string);
procedure HandleDeliveryResults(SpoolObject: TSpoolObjectReader; IsLocal: boolean; Envelope, FailEnvelope: TEnvelope; AddStatus: integer; FailMsg: string);
procedure CreateBounceMessage(SourceSpoolObject: TSpoolObjectReader; FailEnvelope: TEnvelope);
procedure HandleFailure(SpoolObject: TSpoolObjectReader; IsLocal: boolean; FailEnvelope: TEnvelope; FailedRecipient: TRecipient; AddStatus: integer; FailMsg: string);
procedure HandleDeliveryResults(SpoolObject: TSpoolObjectReader; IsLocal: boolean; Envelope, FailEnvelope: TEnvelope; AddStatus: integer; FailMsg: string);
procedure CreateBounceMessage(SourceSpoolObject: TSpoolObjectReader; FailEnvelope: TEnvelope);
R:= Mailbox^.DeliverMessagePart(LockID, Chunk);
end;
if R then begin
R:= Mailbox^.DeliverMessagePart(LockID, Chunk);
end;
if R then begin
- if Mailbox^.FinishDeliverMessage(LockID) then begin
- Result:= 0;
- { It's better to set in Execute. }
- {SpoolObject.QuickSetDeliveryStatus(Recipient, DS_DELIVERED);}
- end
+ if Mailbox^.FinishDeliverMessage(LockID) then
+ Result:= 0
-procedure TDeliveryThread.DeliverRelayMessage(SpoolObject: TSpoolObjectReader; Relayer: TRelayer);
+function TDeliveryThread.DeliverRelayMessage(SpoolObject: TSpoolObjectReader; Relayer: TRelayer): boolean;
+{ Relay message to remote server.
+ Returns true if the transaction went through (doesn't necessarily mean
+ that the message was actually accepted). }
var Headers, Chunk: TStrings; R: boolean;
begin
if Relayer.PrepareSendMessage then begin
var Headers, Chunk: TStrings; R: boolean;
begin
if Relayer.PrepareSendMessage then begin
Chunk:= TStringList.Create;
{ Leave a line between the headers and the body. }
Headers.Add('');
Chunk:= TStringList.Create;
{ Leave a line between the headers and the body. }
Headers.Add('');
R:= Relayer.DeliverMessagePart(Headers);
while (not SpoolObject.IsEOF) and R do begin
R:= Relayer.DeliverMessagePart(Headers);
while (not SpoolObject.IsEOF) and R do begin
- { Maybe constant "32" should be configurable? }
+ { Maybe constant "64" should be configurable? }
- SpoolObject.ReadChunk(Chunk, 32);
+ SpoolObject.ReadChunk(Chunk, 64);
R:= Relayer.DeliverMessagePart(Chunk);
end;
if R then begin
R:= Relayer.DeliverMessagePart(Chunk);
end;
if R then begin
end
else
SpoolObject.SetDeliveryStatus(false, Relayer.Envelope, DS_DELAYED or DS_CONNECTIONFAIL);
end
else
SpoolObject.SetDeliveryStatus(false, Relayer.Envelope, DS_DELAYED or DS_CONNECTIONFAIL);
Chunk.Free;
Headers.Free;
Chunk.Free;
Headers.Free;
+ end
+ else Result:= false;
end;
function TDeliveryThread.NeedSendReport(SpoolObject: TSpoolObject): boolean;
end;
function TDeliveryThread.NeedSendReport(SpoolObject: TSpoolObject): boolean;
if Relayer.Greet then
if Relayer.SendEnvelope then
DeliverRelayMessage(SpoolObject, Relayer);
if Relayer.Greet then
if Relayer.SendEnvelope then
DeliverRelayMessage(SpoolObject, Relayer);
+
+ AssignDeliveryStatusToSMTPCodes(CurrEnv, Relayer.IsTransactionComplete);
Relayer.CloseConnection;
Relayer.Free;
Relayer.CloseConnection;
Relayer.Free;
- AssignDeliveryStatusToSMTPCodes(CurrEnv);
HandleDeliveryResults(SpoolObject, false, CurrEnv, FailEnv, 0, '');
end
else begin
HandleDeliveryResults(SpoolObject, false, CurrEnv, FailEnv, 0, '');
end
else begin
projects / mgsmtp.git / commitdiff