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