Bounce.pas

   1 {
   2    MegaBrutal's SMTP Server (MgSMTP)
   3    Copyright (C) 2010-2012 MegaBrutal
   4
   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.
   9
  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.
  14
  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/>.
  17 }
  18
  19
  20 {$MODE DELPHI}
  21 unit Bounce;
  22
  23 interface
  24 uses SysUtils, Classes, Common;
  25
  26 const
  27
  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.';
  36
  37
  38    function GenerateBounceMessage(FailedRecipient: TRecipient; Headers: TStrings; ReturnPath: string): TStrings; overload;
  39    function GenerateBounceMessage(Envelope: TEnvelope; Headers: TStrings): TStrings; overload;
  40
  41
  42 implementation
  43
  44
  45 function GetFailureTypeStr(Status: integer): string;
  46 begin
  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'
  57    else
  58       Result:= '';
  59 end;
  60
  61 procedure GenerateHeader(Msg: TStrings; ReturnPath: string);
  62 begin
  63    with Msg do begin
  64       Add('From: Mail Delivery System <MAILER-DAEMON@' + MainServerConfig.Name + '>');
  65       Add('To: <' + ReturnPath + '>');
  66       Add('Subject: Delivery Status Notification');
  67       Add('');
  68       Add('This is the mail delivery system at host ' + MainServerConfig.Name + ',');
  69       Add('embodied by MgSMTP software version ' + MainServerConfig.VersionStr + '.');
  70       Add('');
  71    end;
  72 end;
  73
  74 procedure AddTechnicalDetails(Msg: TStrings; FailedRecipient: TRecipient);
  75 begin
  76    with Msg do begin
  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));
  80       end
  81       else begin
  82          if Length(FailedRecipient.RMsg) > 0 then
  83             Add(CleanEOLN(FailedRecipient.RMsg))
  84          else begin
  85             Add('No error message. This is an unexpected failure.');
  86             Add('Possible that the relay server has unexpectedly');
  87             Add('closed the connection.');
  88          end;
  89       end;
  90    end;
  91 end;
  92
  93 procedure AddHeaders(Msg, Headers: TStrings);
  94 begin
  95    with Msg do begin
  96       Add('');
  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('------------------------------------------------------------');
 101       AddStrings(Headers);
 102    end;
 103 end;
 104
 105 function GenerateBounceMessage(FailedRecipient: TRecipient; Headers: TStrings; ReturnPath: string): TStrings;
 106 var Msg: TStrings;
 107 begin
 108    Msg:= TStringList.Create;
 109    with Msg do begin
 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.');
 115       Add('');
 116       Add('Technical details:');
 117       AddTechnicalDetails(Msg, FailedRecipient);
 118       if (FailedRecipient.Data and DS_DELAYED) <> 0 then begin
 119          Add('');
 120          Add('It seems it''s a temporary failure, so I''ll keep on trying.');
 121       end
 122       else if (FailedRecipient.Data and DS_PERMANENT) <> 0 then begin
 123          Add('');
 124          Add('It''s a permanent failure, I''ve given up trying.');
 125       end;
 126       AddHeaders(Msg, Headers);
 127    end;
 128    Result:= Msg;
 129 end;
 130
 131 function GenerateBounceMessage(Envelope: TEnvelope; Headers: TStrings): TStrings;
 132 var Msg: TStrings; FailedRecipient: TRecipient; i: integer;
 133 begin
 134    Msg:= TStringList.Create;
 135    with Msg do begin
 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.');
 140       Add('');
 141       Add('Details follow:');
 142       Add('');
 143       for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 144          Add('');
 145          FailedRecipient:= Envelope.GetRecipient(i);
 146          Add('Recipient <' + FailedRecipient.Address + '>:');
 147          AddTechnicalDetails(Msg, FailedRecipient);
 148          Add('');
 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.');
 154          Add('');
 155       end;
 156       AddHeaders(Msg, Headers);
 157    end;
 158    Result:= Msg;
 159 end;
 160
 161
 162 end.