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;
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;
+ '+' + 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
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;
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;
{
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
protected
FEnvelope: TEnvelope;
FEMailProperties: TEMailProperties;
+ FTransactionComplete: boolean;
FRoutingTarget: TRoutingTarget;
RoutingTable: TRoutingTable;
TCP: TTCPRFCConnection;
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;
Self.RoutingTable:= RoutingTable;
FEnvelope:= Envelope;
FEMailProperties:= EMailProperties;
+ FTransactionComplete:= false;
FRoutingTarget:= RoutingTable.GetRouteInfo(Envelope.RelayHost);
Response:= TRFCReply.Create;
FillChar(SMTPExtensions, SizeOf(TSMTPExtensions), #0);
procedure TRelayer.AdministerMassFailure(var Result: boolean);
-var i: integer;
begin
- for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
- Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
+ Envelope.SetAllRecipientData(Response.GetNumericCode, Response.ReplyText.Text);
Result:= false;
end;
end
else Result:= false;
MXList.Free;
+ FTransactionComplete:= false;
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 identifies this server with a HELO.
The function returns true, if the authentication and the EHLO command were
successful. }
var
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);
{ 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
- i, c: integer; Prms: string;
+ i, c: integer; UltimateFail: boolean; Prms: string;
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
+ { The MAIL command is considered the beginning of the transaction. }
+ FTransactionComplete:= false;
+ UltimateFail:= false;
Response.Clear;
Prms:= 'FROM:<' + Envelope.ReturnPath + '>';
for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
ProcessRCPTResponse;
- Result:= c <> 0;
+ 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);
+
if not Result then begin
+ { Either way, try to reset SMTP state in case of failure. }
TCP.SendCommand(SMTP_C_RSET);
TCP.ReadResponse(Response);
end;
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
+ { 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;
{
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
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);
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
else
Result:= 4;
end
Result:= 1;
end;
-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
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
- { Maybe constant "32" should be configurable? }
+ { Maybe constant "64" should be configurable? }
Chunk.Clear;
- SpoolObject.ReadChunk(Chunk, 32);
+ SpoolObject.ReadChunk(Chunk, 64);
R:= Relayer.DeliverMessagePart(Chunk);
end;
if R then begin
end
else
SpoolObject.SetDeliveryStatus(false, Relayer.Envelope, DS_DELAYED or DS_CONNECTIONFAIL);
+
+ Result:= R;
Chunk.Free;
Headers.Free;
- end;
+ end
+ else Result:= false;
end;
function TDeliveryThread.NeedSendReport(SpoolObject: TSpoolObject): boolean;
if Relayer.Greet then
if Relayer.SendEnvelope then
DeliverRelayMessage(SpoolObject, Relayer);
+
+ AssignDeliveryStatusToSMTPCodes(CurrEnv, Relayer.IsTransactionComplete);
Relayer.CloseConnection;
Relayer.Free;
- AssignDeliveryStatusToSMTPCodes(CurrEnv);
HandleDeliveryResults(SpoolObject, false, CurrEnv, FailEnv, 0, '');
end
else begin
projects / mgsmtp.git / commitdiff