Listener.pas

   1 {
   2    MegaBrutal's SMTP Server (MgSMTP)
   3    Copyright (C) 2010-2018 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    Unit: Listener
  21    This unit is responsible for listening for incoming connections, and
  22    serve them, communicating by the SMTP protocol.
  23
  24    It always places incoming e-mails in the spool, and lets it to process
  25    them later. However, this unit still links the Mailbox and Relay unit to
  26    verify addresses. The Policies unit also plays an important role, it
  27    determines what rights does the client have, and it authenticates users.
  28 }
  29
  30
  31 {$MODE DELPHI}
  32 unit Listener;
  33
  34 interface
  35 uses SysUtils, Classes, Base64, Network, NetRFC, RFCSMTP,
  36      Common, Log, Policies, Spool, Mailbox, Relay;
  37
  38 type
  39
  40    TMgSMTPListener = class(TTCPListener)
  41       constructor Create(const Address: string; Port, Family: word);
  42    protected
  43       procedure HandleClient(Connection: TTCPConnection); override;
  44       procedure ReceiveEMailData(TCP: TTCPRFCConnection; Response: TRFCReply; SpoolObject: TSpoolObjectCreator);
  45    end;
  46
  47
  48    procedure StartListeners;
  49    procedure StopListeners;
  50
  51
  52 implementation
  53
  54 var
  55
  56    MgSMTPListeners: array of TMgSMTPListener;
  57
  58
  59 procedure StartListeners;
  60 var i, j: integer; address, port: string; nport: word;
  61 begin
  62    SetLength(MgSMTPListeners, MainServerConfig.ListenAddresses.Count + MainServerConfig.ListenAddresses6.Count);
  63    for i:= 0 to MainServerConfig.ListenAddresses.Count - 1 do begin
  64       SplitParameters(MainServerConfig.ListenAddresses.Strings[i], address, port, ':');
  65       MgSMTPListeners[i]:= TMgSMTPListener.Create(address, StrToIntDef(port, STANDARD_SMTP_PORT), AF_INET);
  66       MgSMTPListeners[i].StartListen;
  67    end;
  68    j:= MainServerConfig.ListenAddresses.Count;
  69    for i:= 0 to MainServerConfig.ListenAddresses6.Count - 1 do begin
  70       ParseIPv6Address(MainServerConfig.ListenAddresses6.Strings[i], address, nport);
  71       MgSMTPListeners[j+i]:= TMgSMTPListener.Create(address, nport, AF_INET6);
  72       MgSMTPListeners[j+i].StartListen;
  73    end;
  74 end;
  75
  76 procedure StopListeners;
  77 var i: integer;
  78 begin
  79    for i:= 0 to Length(MgSMTPListeners) - 1 do begin
  80       MgSMTPListeners[i].StopListen;
  81       MgSMTPListeners[i].Free;
  82    end;
  83    SetLength(MgSMTPListeners, 0);
  84 end;
  85
  86
  87 function Base64Decode(Source: string): string;
  88 var StringStream: TStringStream; Base64DecodingStream: TBase64DecodingStream;
  89     c: char;
  90 begin
  91    StringStream:= TStringStream.Create(Source);
  92    Base64DecodingStream:= TBase64DecodingStream.Create(StringStream);
  93    Result:= '';
  94    while not Base64DecodingStream.EOF do begin
  95       Base64DecodingStream.Read(c, 1);
  96       Result:= Result + c;
  97    end;
  98    Base64DecodingStream.Destroy;
  99    StringStream.Destroy;
 100 end;
 101
 102 procedure SetEMailProperties(Parameters: string; SpoolObject: TSpoolObject);
 103 var CPrm, Rem, Key, Value: string;
 104 begin
 105    { Cut down e-mail address. }
 106    SplitParameters(Parameters, CPrm, Rem);
 107    repeat
 108       SplitParameters(Rem, CPrm, Rem);
 109       SplitParameters(CPrm, Key, Value, '=');
 110       Key:= UpperCase(Key);
 111       if Key = 'SIZE' then SpoolObject.EMailProperties.Size:= StrToIntDef(Value, 0)
 112       else if Key = 'BODY' then begin
 113          if UpperCase(Value) = '8BITMIME' then
 114             SpoolObject.EMailProperties.SetFlag(EF_8BITMIME);
 115       end;
 116    until (Rem = '');
 117 end;
 118
 119 function HandleRewrite(OriginalAddress: string; Mailbox: PMailbox; SpoolObject: TSpoolObjectCreator): string;
 120 var i: integer;
 121 begin
 122    for i:= 0 to Mailbox^.RewriteCount - 1 do
 123       SpoolObject.Envelope.AddRecipient(Mailbox^.GetRewriteToEntry(i));
 124    if Mailbox^.RewritePassThru then
 125       SpoolObject.Envelope.AddRecipient(OriginalAddress);
 126    if Mailbox^.RewriteCount > 0 then begin
 127       if Mailbox^.RewritePassThru then
 128          Result:= 'Rewrite: ' + OriginalAddress + ' -> ' + OriginalAddress + ',' + Mailbox^.GetRewriteToListStr
 129       else
 130          Result:= 'Rewrite: ' + OriginalAddress + ' -> ' + Mailbox^.GetRewriteToListStr;
 131    end
 132    else
 133       Result:= '';
 134 end;
 135
 136
 137 constructor TMgSMTPListener.Create(const Address: string; Port, Family: word);
 138 begin
 139    { Request connection objects with support for RFC-style commands & responses. }
 140    inherited Create(Address, Port, Family, NET_TCP_RFCSUPPORT);
 141    Logger.AddLine('Server', 'Listening on address: ' + Address + ':' + IntToStr(Port));
 142 end;
 143
 144
 145 procedure TMgSMTPListener.HandleClient(Connection: TTCPConnection);
 146 { This is the procedure that actually handles the clients. It receives
 147   an object that manages the established connection in the parameter.
 148   TTCPConnection is defined in the Network unit. }
 149 var
 150    TCP: TTCPRFCConnection;
 151    Originator: TIPNamePair;
 152    Response: TRFCReply;
 153    PolicyObject: TPolicyObject;
 154    SpoolObject: TSpoolObjectCreator;
 155    Cmd: shortstring; Prm, OPrm: string;
 156    Auth_Username, Auth_Password: string; FailedAuthAttempts: integer;
 157    HELOSent, SpoolAllocated, ReadSucceeded, UnexpectedFail: boolean;
 158    VStr: string; LogAgent: string;
 159    TempStr: string;
 160
 161    procedure SendAndLogResponse(NumericCode: word; ReplyText: shortstring; ExpectFail: boolean = false);
 162    begin
 163       if (Logger.AddLine(LogAgent, 'Response: ' + IntToStr(NumericCode) + ' ' + ReplyText)) or ExpectFail then begin
 164          Response.SetReply(NumericCode, ReplyText);
 165          TCP.SendResponse(Response);
 166       end
 167       else begin
 168          SendAndLogResponse(SMTP_R_SERVICE_NA, 'Internal error: could not write log', true);
 169          Logger.AddStdLine(LogAgent, 'Log write failure. Terminating active connection.');
 170          UnexpectedFail:= true;
 171       end;
 172    end;
 173
 174 begin
 175    TCP:= Connection as TTCPRFCConnection;
 176    TCP.SetSockTimeOut(DEF_SOCK_TIMEOUT);
 177    TCP.ReverseDNSLookup;
 178    Originator:= TCP.HostIP.Copy;
 179    Response:= TRFCReply.Create;
 180    {PolicyObject:= PolicyManager.MakePolicyObject(Originator.Copy);}
 181    PolicyObject:= PolicyManager.MakePolicyObject(Originator);
 182    SpoolObject:= nil;
 183    HELOSent:= false; SpoolAllocated:= false; UnexpectedFail:= false;
 184    FailedAuthAttempts:= 0;
 185
 186    { Prepare for logging. To make this connection distinguishable, we add
 187      the actual thread's ID to each log entry. }
 188    LogAgent:= 'Server ' + IntToStr(GetCurrentThreadId);
 189    Logger.AddLine(LogAgent, 'Client connected: ' + Originator.Name + ' (' + Originator.IP + ')');
 190    Logger.AddLine(LogAgent, 'Assigned rights (for host): ' + PolicyObject.RightsStr);
 191
 192    { Verify FCrDNS if necessary. Note, maybe it would have been simpler to
 193      check it around the TCP.ReverseDNSLookup call, and then only pass the
 194      trusted result to PolicyManager.MakePolicyObject. The main idea why I
 195      didn't implement it that way is that I'd like to see if the granted
 196      rights actually change after the FCrDNS check. }
 197    if PolicyManager.FCrDNSPolicy <> FCRDNS_NAIVE then begin
 198       if not TCP.VerifyFCrDNS then begin
 199          PolicyManager.RevalidatePolicyObject(PolicyObject, Originator, false, PolicyManager.FCrDNSPolicy = FCRDNS_MEAN);
 200          if PolicyManager.FCrDNSPolicy = FCRDNS_STRICT then
 201             PolicyObject.Deny(RIGHT_CONNECT);
 202          Logger.AddLine(LogAgent, 'WARNING: "' + Originator.Name + '" is not a forward-confirmed reverse hostname! Rights will be reassigned by IP only!');
 203          Logger.AddLine(LogAgent, 'Assigned rights (for host): ' + PolicyObject.RightsStr);
 204       end;
 205    end;
 206
 207    if PolicyObject.HasRight(RIGHT_CONNECT) then begin
 208       if not PolicyManager.HideVersion then VStr:= ' ' + MainServerConfig.VersionStr else VStr:= '';
 209       Response.SetReply(SMTP_R_READY, MainServerConfig.Name + ' SMTP server ready (MgSMTP' + VStr + ')');
 210       TCP.SendResponse(Response);
 211
 212       repeat
 213          ReadSucceeded:= TCP.ReadCommand(Cmd, Prm);
 214
 215          { Check if command only contains printable ASCII characters, not some binary garbage. }
 216          if ReadSucceeded then begin
 217             if IsPrintableString(Cmd) and IsPrintableString(Prm) then begin
 218                Logger.AddLine(LogAgent, 'Command: ' + Cmd + ' ' + Prm);
 219                Cmd:= UpperCase(Cmd);
 220             end
 221             else begin
 222                SendAndLogResponse(SMTP_R_SERVICE_NA, 'Non-printable characters are not allowed in SMTP commands! Stop abusing my service!');
 223                UnexpectedFail:= true;
 224             end;
 225          end;
 226
 227          if (Length(Cmd) = 0) or (not ReadSucceeded) or UnexpectedFail then { Nothing. }
 228
 229          else if (Cmd = 'GET') or (Cmd = 'HEAD') or (Cmd = 'POST') then begin
 230             SendAndLogResponse(SMTP_R_SERVICE_NA, 'Please learn to speak SMTP for I won''t speak HTTP. Stop abusing my service!');
 231             UnexpectedFail:= true;
 232          end
 233
 234          else if (Cmd = SMTP_C_HELO) or (Cmd = SMTP_C_EHLO) then begin
 235             Response.SetReply(SMTP_R_OK, MainServerConfig.Name);
 236             if Cmd = SMTP_C_EHLO then begin
 237                Response.Add('SIZE ' + IntToStr(PolicyObject.Databytes));
 238                {Response.Add('VRFY');}
 239                Response.Add('PIPELINING');
 240                Response.Add('8BITMIME');
 241                if PolicyManager.Users then begin
 242                   Response.Add('AUTH LOGIN');
 243                   Response.Add('AUTH=LOGIN');
 244                end;
 245             end;
 246             TCP.SendResponse(Response);
 247             Originator.Free;
 248             Originator:= TIPNamePair.Create(Prm, TCP.HostIP.IP);
 249             HELOSent:= true;
 250             Logger.AddLine(LogAgent, 'Client identified: ' + Originator.Name + ' (' + Originator.IP + ')');
 251          end
 252
 253          else if Cmd = SMTP_C_AUTH then begin
 254             if PolicyManager.Users then begin
 255                { Only "AUTH LOGIN" is supported. }
 256                SplitParameters(Prm, Prm, OPrm);
 257                if Prm = 'LOGIN' then begin
 258                   if OPrm = '' then begin
 259                      { Base64-encoded "Username:" }
 260                      Response.SetReply(SMTP_R_AUTH_MESSAGE, 'VXNlcm5hbWU6');
 261                      TCP.SendResponse(Response);
 262                      TCP.ReadLn(Auth_Username);
 263                      Auth_Username:= Base64Decode(Auth_Username);
 264                   end
 265                   else
 266                      Auth_Username:= Base64Decode(OPrm);
 267                   { Base64-encoded "Password:" }
 268                   Response.SetReply(SMTP_R_AUTH_MESSAGE, 'UGFzc3dvcmQ6');
 269                   TCP.SendResponse(Response);
 270                   TCP.ReadLn(Auth_Password);
 271                   { Verify }
 272                   if PolicyManager.AuthenticateUser(Auth_Username, Base64Decode(Auth_Password), PolicyObject) then begin
 273                      Response.SetReply(SMTP_R_AUTH_SUCCESSFUL, 'Authentication successful');
 274                      Logger.AddLine(LogAgent, 'Successfully authenticated as user: ' + Auth_Username);
 275                      Logger.AddLine(LogAgent, 'Assigned rights (for user): ' + PolicyObject.RightsStr);
 276                   end
 277                   else begin
 278                      Inc(FailedAuthAttempts);
 279                      Response.SetReply(SMTP_R_AUTH_FAILED, 'Authentication failed');
 280                      Logger.AddLine(LogAgent, 'AUTHENTICATION FAILED as user: ' + Auth_Username);
 281                   end;
 282                   TCP.SendResponse(Response);
 283                   if (PolicyManager.MaxAuthAttempts <> 0) and (PolicyManager.MaxAuthAttempts <= FailedAuthAttempts) then begin
 284                      SendAndLogResponse(SMTP_R_SERVICE_NA, 'Too many unsuccessful authentication attempts! Stop abusing my service!');
 285                      UnexpectedFail:= true;
 286                      Logger.AddLine(LogAgent, 'MAXIMUM AUTHENTICATION ATTEMPTS REACHED - DISCONNECTING CLIENT!');
 287                   end;
 288                end
 289                else
 290                   SendAndLogResponse(SMTP_R_PRM_NOT_IMPLEMENTED, 'Authentication type not implemented');
 291             end
 292             else
 293                SendAndLogResponse(SMTP_R_CMD_NOT_IMPLEMENTED, 'User authentication is not enabled on this server.');
 294          end
 295
 296          else if Cmd = SMTP_C_RSET then begin
 297             { We must be careful to always free the spool object, if we
 298               have allocated one, but we don't need it anymore. }
 299             if SpoolAllocated then begin
 300                if SpoolObject.Opened then SpoolObject.Discard;
 301                SpoolObject.Free;
 302                SpoolAllocated:= false;
 303             end;
 304             Response.SetReply(SMTP_R_OK, 'OK');
 305             TCP.SendResponse(Response);
 306          end
 307
 308          else if Cmd = SMTP_C_NOOP then begin
 309             Response.SetReply(SMTP_R_OK, 'Not like I was doing anything...');
 310             TCP.SendResponse(Response);
 311          end
 312
 313          else if Cmd = SMTP_C_QUIT then begin
 314             { No extra action is required here to close the connection.
 315               The repeat-until loop will quit anyway, and the connection
 316               will be closed afterwards. }
 317             Response.SetReply(SMTP_R_CLOSE, 'Goodbye. :)');
 318             TCP.SendResponse(Response);
 319          end
 320
 321          else if (HELOSent) or (not PolicyManager.ReqHELO) then begin
 322
 323             { Some commands are only accepted after the client has greeted
 324               us with a HELO or EHLO command. }
 325
 326             if Cmd = SMTP_C_MAIL then begin
 327                { A new spool object is allocated with the mail command. }
 328                if not SpoolAllocated then begin
 329                   OPrm:= Prm;
 330                   Prm:= CleanEMailAddress(Prm);
 331                   if (Prm = '') or (IsValidEMailAddress(Prm)) then begin
 332                      SpoolObject:= SpoolManager.CreateSpoolObject(Originator.Copy);
 333                      SpoolObject.Envelope.ReturnPath:= Prm;
 334                      SpoolObject.Databytes:= PolicyObject.Databytes;
 335                      SetEMailProperties(OPrm, SpoolObject);
 336                      if (SpoolObject.EMailProperties.Size <= SpoolObject.Databytes) then begin
 337                         Response.SetReply(SMTP_R_OK, 'OK');
 338                         TCP.SendResponse(Response);
 339                         SpoolAllocated:= true;
 340                         Logger.AddLine(LogAgent, 'Return-Path accepted: <' + Prm + '>');
 341                      end
 342                      else begin
 343                         SendAndLogResponse(SMTP_R_STOR_EXCEEDED, 'Declared message size exceeds the configured databytes limit');
 344                         SpoolObject.Free;
 345                      end;
 346                   end
 347                   else
 348                      SendAndLogResponse(SMTP_R_MB_SYNTAX_ERROR, '<' + Prm + '>: Sender address rejected: Syntax error');
 349                end
 350                else
 351                   SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'Return-Path is already specified, use RSET to discard it');
 352             end
 353
 354             else if Cmd = SMTP_C_RCPT then begin
 355                if SpoolAllocated then begin
 356                   Prm:= CleanEMailAddress(Prm);
 357
 358                   { According to the RFC, we must accept "POSTMASTER" address without a hostname. }
 359                   if UpperCase(Prm) = 'POSTMASTER' then Prm:= Prm + '@' + MainServerConfig.Name;
 360                   if IsValidEMailAddress(Prm) then begin
 361
 362                      if MailboxManager.IsLocalAddress(Prm) then begin
 363
 364                         { Many conditions need to be checked before accepting a local e-mail:
 365                           - Does this server accept local e-mails by configuration?
 366                           - Does the client have the right to STORE a local e-mail?
 367                           - Does the addressed mailbox exist?
 368                           - Does the mailbox have free quota?
 369                           If the answer is "no" for any of these questions, reject the address
 370                           with a proper error response. }
 371
 372                         if MainServerConfig.Mailbox then begin
 373                            if PolicyObject.HasRight(RIGHT_STORE) then begin
 374                               if MailboxManager.Verify(Prm) then begin
 375                                  if MailboxManager.VerifyAlias(Prm) then begin
 376                                     if ((not SpoolManager.AllowExceedQuota) and (MailboxManager.CheckQuota(EMailUserName(Prm), EMailHost(Prm), SpoolObject.EMailProperties.Size)))
 377                                     or ((SpoolManager.AllowExceedQuota) and (MailboxManager.CheckQuota(EMailUserName(Prm), EMailHost(Prm), 0))) then begin
 378
 379                                        if MailboxManager.Rewrite then begin
 380                                           TempStr:= HandleRewrite(Prm, MailboxManager.GetMailbox(EMailUserName(Prm), EMailHost(Prm)), SpoolObject);
 381                                           if Length(TempStr) > 0 then
 382                                              Logger.AddLine(LogAgent, TempStr);
 383                                        end
 384                                        else
 385                                           SpoolObject.Envelope.AddRecipient(Prm);
 386
 387                                        Response.SetReply(SMTP_R_OK, 'OK');
 388                                        TCP.SendResponse(Response);
 389                                        Logger.AddLine(LogAgent, 'Local recipient accepted: <' + Prm + '>');
 390                                     end
 391                                     else
 392                                        SendAndLogResponse(SMTP_R_STOR_EXCEEDED, '<' + Prm + '>: User quota exceeded');
 393                                  end
 394                                  else
 395                                     SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: Mailbox alias rejected');
 396                               end
 397                               else
 398                                  SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: No mailbox here by that name');
 399                            end
 400                            else
 401                               SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: Store access denied');
 402                         end
 403                         else
 404                            SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: This server doesn''t store local messages');
 405                      end
 406
 407                      else if MainServerConfig.Relay then begin
 408
 409                         { Things to check for relay addresses:
 410                           - Does the server ever accept relay addresses by configuration?
 411                           - Does the client has the right to RELAY messages or in the case
 412                             if the relay address is on the RelayTo list, does the client
 413                             has the STORE right?
 414                         }
 415
 416                         if (PolicyObject.HasRight(RIGHT_RELAY))
 417                            or (PolicyObject.HasRight(RIGHT_STORE) and RelayManager.IsOnRelayToList(EMailHost(Prm))) then begin
 418                            if not RelayManager.IsOnNoRelayToList(EMailHost(Prm)) then begin
 419                               SpoolObject.Envelope.AddRecipient(Prm);
 420                               Response.SetReply(SMTP_R_OK, 'OK');
 421                               TCP.SendResponse(Response);
 422                               Logger.AddLine(LogAgent, 'Relay recipient accepted: <' + Prm + '>');
 423                            end
 424                            else
 425                               SendAndLogResponse(SMTP_R_TRANS_FAILED, '<' + Prm + '>: Relaying towards this domain is not permitted');
 426                         end
 427                         else
 428                            SendAndLogResponse(SMTP_R_TRANS_FAILED, '<' + Prm + '>: Relay access denied, or maybe I just don''t like you');
 429                      end
 430                      else
 431                         SendAndLogResponse(SMTP_R_TRANS_FAILED, '<' + Prm + '>: Relaying has been disabled by configuration');
 432                   end
 433                   else
 434                      SendAndLogResponse(SMTP_R_MB_SYNTAX_ERROR, '<' + Prm + '>: Recipient address rejected: Syntax error');
 435                end
 436                else
 437                   SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'You must initiate e-mail transactions with MAIL command');
 438             end
 439
 440             else if Cmd = SMTP_C_DATA then begin
 441                if SpoolAllocated then begin
 442                   if SpoolObject.Envelope.IsComplete then begin
 443                      ReceiveEMailData(TCP, Response, SpoolObject);
 444                      Logger.AddLine(LogAgent, 'Response: ' + IntToStr(Response.NumericCode) + ' ' + Response.GetLine(0));
 445                      TCP.SendResponse(Response);
 446                      Logger.AddLine('Object ' + SpoolObject.Name, 'Message-ID: <' + SpoolObject.OriginalMessageID + '>');
 447                      SpoolObject.Free;
 448                      SpoolAllocated:= false;
 449                   end
 450                   else
 451                      SendAndLogResponse(SMTP_R_TRANS_FAILED, 'No valid recipients');
 452                end
 453                else
 454                   SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'You must initiate e-mail transactions with MAIL command');
 455             end
 456
 457             else if Cmd = SMTP_C_VRFY then
 458                SendAndLogResponse(SMTP_R_CANNOTVERIFY, 'Honestly, I don''t like to verify addresses')
 459
 460             else
 461                SendAndLogResponse(SMTP_R_CMD_SYNTAX_ERROR, 'Command not recognized (' + Cmd + ')');
 462          end
 463
 464          else
 465             SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'It would be more polite to say HELO first');
 466
 467       until (Cmd = SMTP_C_QUIT) or (not ReadSucceeded) or (UnexpectedFail);
 468
 469       if not ReadSucceeded then
 470          SendAndLogResponse(SMTP_R_SERVICE_NA, 'Socket read error');
 471    end
 472
 473    else begin
 474
 475       { If the client doesn't have the right to CONNECT here, disconnect it
 476         with a rather unfriendly message. }
 477
 478       SendAndLogResponse(SMTP_R_TRANS_FAILED, 'Host is not permitted by server configuration');
 479       SendAndLogResponse(SMTP_R_SERVICE_NA, 'You are not welcome here, I shall disconnect you');
 480       {repeat
 481          TCP.ReadCommand(Cmd, Prm);
 482          if Cmd <> SMTP_C_QUIT then
 483             Response.SetReply(SMTP_R_BAD_SEQUENCE, 'You are not welcome here, I suggest you to QUIT')
 484          else
 485             Response.SetReply(SMTP_R_CLOSE, 'Closing connection');
 486          TCP.SendResponse(Response);
 487       until Cmd = SMTP_C_QUIT;}
 488    end;
 489
 490    { Free the spool object (if we have any), close the connection,
 491      and free other allocated resources, log disconnection. }
 492
 493    if SpoolAllocated then begin
 494       if SpoolObject.Opened then SpoolObject.Discard;
 495       SpoolObject.Free;
 496    end;
 497    PolicyObject.Free;
 498    Response.Free;
 499    Originator.Free;
 500    TCP.Free;
 501    Logger.AddLine(LogAgent, 'Client disconnected.');
 502 end;
 503
 504 procedure TMgSMTPListener.ReceiveEMailData(TCP: TTCPRFCConnection; Response: TRFCReply; SpoolObject: TSpoolObjectCreator);
 505 { Receive e-mail lines until a line with a single dot (".") arrives.
 506   Check databytes limit!
 507   This procedure should never call TCP.SendResponse - the set up response
 508   will be sent by the caller! }
 509 var Line: string; Done, ReadOK: boolean;
 510 begin
 511    if SpoolObject.Open then begin
 512       Response.SetReply(SMTP_R_START_MAIL_INPUT, 'Start mail input; end with "<CRLF>.<CRLF>" sequence');
 513       TCP.SendResponse(Response);
 514       Done:= false;
 515       repeat
 516          ReadOK:= TCP.ReadLn(Line);
 517          if Line <> '.' then begin
 518             { If the line starts with a dot, remove it to comply with RFC. }
 519             if (Length(Line) > 1) and (Line[1] = '.') then Delete(Line, 1, 1);
 520             SpoolObject.DeliverMessagePart(Line);
 521          end
 522          else
 523             Done:= true;
 524       until Done or (not ReadOK);
 525       if ReadOK then begin
 526          if SpoolObject.GetErrorCode <> SCE_NO_ERROR then begin
 527
 528             case SpoolObject.GetErrorCode of
 529
 530                SCE_SIZE_EXCEEDED:
 531                   Response.SetReply(SMTP_R_STOR_EXCEEDED, 'Message size exceeds the configured databytes limit');
 532
 533                SCE_LOOP_DETECTED:
 534                begin
 535                   Response.Clear;
 536                   Response.SetNumericCode(SMTP_R_TRANS_FAILED);
 537                   Response.Add('Too many "Received" headers in mail data.');
 538                   Response.Add('It''s likely that your message got trapped in a mail relay loop. In most');
 539                   Response.Add('cases it is caused by faulty mail server configuration. Please notify the');
 540                   Response.Add('administrator by forwarding this failure notice to the following address:');
 541                   Response.Add('<postmaster@' + MainServerConfig.Name + '>!');
 542                end;
 543
 544                SCE_WRITE_FAIL:
 545                   Response.SetReply(SMTP_R_ABORTED, 'Could not write mail data. Try again later.');
 546
 547                else
 548                   Response.SetReply(SMTP_R_ABORTED, 'Unknown error. Could not queue mail data.');
 549
 550             end;
 551
 552             SpoolObject.Discard;
 553
 554          end
 555          else begin
 556             Response.SetReply(SMTP_R_OK, 'Queued as ' + SpoolObject.Name);
 557             SpoolObject.Close;
 558          end;
 559       end
 560       else begin
 561          Response.SetReply(SMTP_R_SERVICE_NA, 'Socket read error in DATA phase (timeout?)');
 562          SpoolObject.Discard;
 563       end;
 564    end
 565    else Response.SetReply(SMTP_R_ABORTED, 'Internal error: could not open spool object');
 566 end;
 567
 568
 569 end.