{
MegaBrutal's SMTP Server (MgSMTP)
- Copyright (C) 2010 MegaBrutal
+ Copyright (C) 2010-2018 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;
begin
MXList:= GetCorrectMXRecordList(RelayServerName);
if MXList.Count >= 1 then begin
- TCP:= TTCPRFCConnection.Create(MXList.Strings[0], RelayServerPort);
+ TCP:= TTCPRFCConnection.Create;
+ TCP.SetBindAddress(MainServerConfig.BindAddress);
+ TCP.Connect(MXList.Strings[0], RelayServerPort);
TCP.SetSockTimeOut(DEF_SOCK_TIMEOUT);
i:= 1;
while (not TCP.Connected) and (i < MXList.Count) do begin
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);
end;
Result:= true;
end
- else AdministerMassFailure(Result);
+ else if (Response.GetNumericCode >= 500) and (Response.GetNumericCode <= 504) then begin
+ { It seems the remote site did not understand our EHLO, that is,
+ let's admit, quite odd in the 21st century...
+ Whatever, let's fall back to RFC 821 then. }
+ TCP.SendCommand(SMTP_C_HELO, MainServerConfig.Name);
+ TCP.ReadResponse(Response);
+ Result:= Response.GetNumericCode = SMTP_R_OK;
+ end;
if Result then begin
if FRoutingTarget.Auth then begin
else Authenticated:= true;
if not Authenticated then AdministerMassFailure(Result);
- end;
+ end
+ else AdministerMassFailure(Result);
end
else AdministerMassFailure(Result);
{ 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 successful
+ 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;