2 MegaBrutal's SMTP Server (MgSMTP)
3 Copyright (C) 2010-2012 MegaBrutal
5 This program is free software: you can redistribute it and/or modify
6 it under the terms of the GNU Affero General Public License as published by
7 the Free Software Foundation, either version 3 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU Affero General Public License for more details.
15 You should have received a copy of the GNU Affero General Public License
16 along with this program. If not, see <http://www.gnu.org/licenses/>.
24 uses SysUtils
, Classes
, Common
;
28 DSMSG_CONNECTIONFAIL
= 'Failed to establish connection with relay server: ';
29 DSMSG_INTERNALFAIL
= 'Internal failure: ';
30 {DSMSG_MAILBOXNOTEXISTS = 'Although the recipient addressed a valid local mailbox'#13#10
31 + 'at the time when I queued it, meanwhile it became invalid'#13#10
32 + 'due to changes in the mail server''s configuration, thanks'#13#10
33 + 'to the beloved postmaster. I apologise.';}
34 DSMSG_MAILBOXNOTEXISTS
= 'Local mailbox does not exist.';
35 DSMSG_QUOTAEXCEEDED
= 'User quota exceeded.';
38 function GenerateBounceMessage(FailedRecipient
: TRecipient
; Headers
: TStrings
; ReturnPath
: string): TStrings
; overload
;
39 function GenerateBounceMessage(Envelope
: TEnvelope
; Headers
: TStrings
): TStrings
; overload
;
45 function GetFailureTypeStr(Status
: integer): string;
47 if (Status
and DS_UNEXPECTEDFAIL
) <> 0 then
48 Result
:= 'an unexpected'
49 else if (Status
and DS_CONNECTIONFAIL
) <> 0 then
50 Result
:= 'a connection'
51 else if (Status
and DS_INTERNALFAIL
) <> 0 then
52 Result
:= 'an internal'
53 else if (Status
and DS_PERMANENT
) <> 0 then
54 Result
:= 'a permanent'
55 else if (Status
and DS_DELAYED
) <> 0 then
56 Result
:= 'a temporary'
61 procedure GenerateHeader(Msg
: TStrings
; ReturnPath
: string);
64 Add('From: Mail Delivery System <MAILER-DAEMON@' + MainServerConfig
.Name
+ '>');
65 Add('To: <' + ReturnPath
+ '>');
66 Add('Subject: Delivery Status Notification');
68 Add('This is the mail delivery system at host ' + MainServerConfig
.Name
+ ',');
69 Add('embodied by MgSMTP software version ' + MainServerConfig
.VersionStr
+ '.');
74 procedure AddTechnicalDetails(Msg
: TStrings
; FailedRecipient
: TRecipient
);
77 if (FailedRecipient
.Data
and DS_SMTPFAIL
) <> 0 then begin
78 Add('The targetted mail server has rejected the message:');
79 Add(IntToStr(FailedRecipient
.Data
and DS_SMTPREPLYMASK
) + #32 + CleanEOLN(FailedRecipient
.RMsg
));
82 if Length(FailedRecipient
.RMsg
) > 0 then
83 Add(CleanEOLN(FailedRecipient
.RMsg
))
85 Add('No error message. This is an unexpected failure.');
86 Add('Possible that the relay server has unexpectedly');
87 Add('closed the connection.');
93 procedure AddHeaders(Msg
, Headers
: TStrings
);
97 Add('Below you can see the headers of your undelivered message.');
98 Add('Pay attention to the "Subject" and "Message-Id" headers to');
99 Add('get a clue which was it exactly.');
100 Add('------------------------------------------------------------');
105 function GenerateBounceMessage(FailedRecipient
: TRecipient
; Headers
: TStrings
; ReturnPath
: string): TStrings
;
108 Msg
:= TStringList
.Create
;
110 GenerateHeader(Msg
, ReturnPath
);
111 Add('I am sorry to inform you that I encountered a problem');
112 Add('while I was trying to deliver your message to the following');
113 Add('recipient: <' + FailedRecipient
.Address
+ '>.');
114 Add('This is ' + GetFailureTypeStr(FailedRecipient
.Data
) + ' failure.');
116 Add('Technical details:');
117 AddTechnicalDetails(Msg
, FailedRecipient
);
118 if (FailedRecipient
.Data
and DS_DELAYED
) <> 0 then begin
120 Add('It seems it''s a temporary failure, so I''ll keep on trying.');
122 else if (FailedRecipient
.Data
and DS_PERMANENT
) <> 0 then begin
124 Add('It''s a permanent failure, I''ve given up trying.');
126 AddHeaders(Msg
, Headers
);
131 function GenerateBounceMessage(Envelope
: TEnvelope
; Headers
: TStrings
): TStrings
;
132 var Msg
: TStrings
; FailedRecipient
: TRecipient
; i
: integer;
134 Msg
:= TStringList
.Create
;
136 GenerateHeader(Msg
, Envelope
.ReturnPath
);
137 Add('I am sorry to inform you that I encountered several');
138 Add('problems while I was trying to deliver your message to');
139 Add('multiple recipients.');
141 Add('Details follow:');
143 for i
:= 0 to Envelope
.GetNumberOfRecipients
- 1 do begin
145 FailedRecipient
:= Envelope
.GetRecipient(i
);
146 Add('Recipient <' + FailedRecipient
.Address
+ '>:');
147 AddTechnicalDetails(Msg
, FailedRecipient
);
149 Add('This is ' + GetFailureTypeStr(FailedRecipient
.Data
) + ' failure.');
150 if (FailedRecipient
.Data
and DS_DELAYED
) <> 0 then
151 Add('Delivery will be retried by certain intervals.')
152 else if (FailedRecipient
.Data
and DS_PERMANENT
) <> 0 then
153 Add('Delivery to this recipient has failed permanently.');
156 AddHeaders(Msg
, Headers
);