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 = 'PUT') or (Cmd = 'POST')
 234             or (Cmd = 'DELETE') or (Cmd = 'CONNECT') or (Cmd = 'OPTIONS')
 235             or (Cmd = 'PATCH') or (Cmd = 'TRACE') then begin
 236             SendAndLogResponse(SMTP_R_SERVICE_NA, 'Please learn to speak SMTP for I won''t speak HTTP. Stop abusing my service!');
 237             UnexpectedFail:= true;
 238          end
 239
 240          else if (Cmd = SMTP_C_HELO) or (Cmd = SMTP_C_EHLO) then begin
 241             Response.SetReply(SMTP_R_OK, MainServerConfig.Name);
 242             if Cmd = SMTP_C_EHLO then begin
 243                Response.Add('SIZE ' + IntToStr(PolicyObject.Databytes));
 244                {Response.Add('VRFY');}
 245                Response.Add('PIPELINING');
 246                Response.Add('8BITMIME');
 247                if PolicyManager.Users then begin
 248                   Response.Add('AUTH LOGIN');
 249                   Response.Add('AUTH=LOGIN');
 250                end;
 251             end;
 252             TCP.SendResponse(Response);
 253             Originator.Free;
 254             Originator:= TIPNamePair.Create(Prm, TCP.HostIP.IP);
 255             HELOSent:= true;
 256             Logger.AddLine(LogAgent, 'Client identified: ' + Originator.Name + ' (' + Originator.IP + ')');
 257          end
 258
 259          else if Cmd = SMTP_C_AUTH then begin
 260             if PolicyManager.Users then begin
 261                { Only "AUTH LOGIN" is supported. }
 262                SplitParameters(Prm, Prm, OPrm);
 263                if Prm = 'LOGIN' then begin
 264                   if OPrm = '' then begin
 265                      { Base64-encoded "Username:" }
 266                      Response.SetReply(SMTP_R_AUTH_MESSAGE, 'VXNlcm5hbWU6');
 267                      TCP.SendResponse(Response);
 268                      TCP.ReadLn(Auth_Username);
 269                      Auth_Username:= Base64Decode(Auth_Username);
 270                   end
 271                   else
 272                      Auth_Username:= Base64Decode(OPrm);
 273                   { Base64-encoded "Password:" }
 274                   Response.SetReply(SMTP_R_AUTH_MESSAGE, 'UGFzc3dvcmQ6');
 275                   TCP.SendResponse(Response);
 276                   TCP.ReadLn(Auth_Password);
 277                   { Verify }
 278                   if PolicyManager.AuthenticateUser(Auth_Username, Base64Decode(Auth_Password), PolicyObject) then begin
 279                      Response.SetReply(SMTP_R_AUTH_SUCCESSFUL, 'Authentication successful');
 280                      Logger.AddLine(LogAgent, 'Successfully authenticated as user: ' + Auth_Username);
 281                      Logger.AddLine(LogAgent, 'Assigned rights (for user): ' + PolicyObject.RightsStr);
 282                   end
 283                   else begin
 284                      Inc(FailedAuthAttempts);
 285                      Response.SetReply(SMTP_R_AUTH_FAILED, 'Authentication failed');
 286                      Logger.AddLine(LogAgent, 'AUTHENTICATION FAILED as user: ' + Auth_Username);
 287                   end;
 288                   TCP.SendResponse(Response);
 289                   if (PolicyManager.MaxAuthAttempts <> 0) and (PolicyManager.MaxAuthAttempts <= FailedAuthAttempts) then begin
 290                      SendAndLogResponse(SMTP_R_SERVICE_NA, 'Too many unsuccessful authentication attempts! Stop abusing my service!');
 291                      UnexpectedFail:= true;
 292                      Logger.AddLine(LogAgent, 'MAXIMUM AUTHENTICATION ATTEMPTS REACHED - DISCONNECTING CLIENT!');
 293                   end;
 294                end
 295                else
 296                   SendAndLogResponse(SMTP_R_PRM_NOT_IMPLEMENTED, 'Authentication type not implemented');
 297             end
 298             else
 299                SendAndLogResponse(SMTP_R_CMD_NOT_IMPLEMENTED, 'User authentication is not enabled on this server.');
 300          end
 301
 302          else if Cmd = SMTP_C_RSET then begin
 303             { We must be careful to always free the spool object, if we
 304               have allocated one, but we don't need it anymore. }
 305             if SpoolAllocated then begin
 306                if SpoolObject.Opened then SpoolObject.Discard;
 307                SpoolObject.Free;
 308                SpoolAllocated:= false;
 309             end;
 310             Response.SetReply(SMTP_R_OK, 'OK');
 311             TCP.SendResponse(Response);
 312          end
 313
 314          else if Cmd = SMTP_C_NOOP then begin
 315             Response.SetReply(SMTP_R_OK, 'Not like I was doing anything...');
 316             TCP.SendResponse(Response);
 317          end
 318
 319          else if Cmd = SMTP_C_QUIT then begin
 320             { No extra action is required here to close the connection.
 321               The repeat-until loop will quit anyway, and the connection
 322               will be closed afterwards. }
 323             Response.SetReply(SMTP_R_CLOSE, 'Goodbye. :)');
 324             TCP.SendResponse(Response);
 325          end
 326
 327          else if (HELOSent) or (not PolicyManager.ReqHELO) then begin
 328
 329             { Some commands are only accepted after the client has greeted
 330               us with a HELO or EHLO command. }
 331
 332             if Cmd = SMTP_C_MAIL then begin
 333                { A new spool object is allocated with the mail command. }
 334                if not SpoolAllocated then begin
 335                   OPrm:= Prm;
 336                   Prm:= CleanEMailAddress(Prm);
 337                   if (Prm = '') or (IsValidEMailAddress(Prm)) then begin
 338                      SpoolObject:= SpoolManager.CreateSpoolObject(Originator.Copy);
 339                      SpoolObject.Envelope.ReturnPath:= Prm;
 340                      SpoolObject.Databytes:= PolicyObject.Databytes;
 341                      SetEMailProperties(OPrm, SpoolObject);
 342                      if (SpoolObject.EMailProperties.Size <= SpoolObject.Databytes) then begin
 343                         Response.SetReply(SMTP_R_OK, 'OK');
 344                         TCP.SendResponse(Response);
 345                         SpoolAllocated:= true;
 346                         Logger.AddLine(LogAgent, 'Return-Path accepted: <' + Prm + '>');
 347                      end
 348                      else begin
 349                         SendAndLogResponse(SMTP_R_STOR_EXCEEDED, 'Declared message size exceeds the configured databytes limit');
 350                         SpoolObject.Free;
 351                      end;
 352                   end
 353                   else
 354                      SendAndLogResponse(SMTP_R_MB_SYNTAX_ERROR, '<' + Prm + '>: Sender address rejected: Syntax error');
 355                end
 356                else
 357                   SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'Return-Path is already specified, use RSET to discard it');
 358             end
 359
 360             else if Cmd = SMTP_C_RCPT then begin
 361                if SpoolAllocated then begin
 362                   Prm:= CleanEMailAddress(Prm);
 363
 364                   { According to the RFC, we must accept "POSTMASTER" address without a hostname. }
 365                   if UpperCase(Prm) = 'POSTMASTER' then Prm:= Prm + '@' + MainServerConfig.Name;
 366                   if IsValidEMailAddress(Prm) then begin
 367
 368                      if MailboxManager.IsLocalAddress(Prm) then begin
 369
 370                         { Many conditions need to be checked before accepting a local e-mail:
 371                           - Does this server accept local e-mails by configuration?
 372                           - Does the client have the right to STORE a local e-mail?
 373                           - Does the addressed mailbox exist?
 374                           - Does the mailbox have free quota?
 375                           If the answer is "no" for any of these questions, reject the address
 376                           with a proper error response. }
 377
 378                         if MainServerConfig.Mailbox then begin
 379                            if PolicyObject.HasRight(RIGHT_STORE) then begin
 380                               if MailboxManager.Verify(Prm) then begin
 381                                  if MailboxManager.VerifyAlias(Prm) then begin
 382                                     if ((not SpoolManager.AllowExceedQuota) and (MailboxManager.CheckQuota(EMailUserName(Prm), EMailHost(Prm), SpoolObject.EMailProperties.Size)))
 383                                     or ((SpoolManager.AllowExceedQuota) and (MailboxManager.CheckQuota(EMailUserName(Prm), EMailHost(Prm), 0))) then begin
 384
 385                                        if MailboxManager.Rewrite then begin
 386                                           TempStr:= HandleRewrite(Prm, MailboxManager.GetMailbox(EMailUserName(Prm), EMailHost(Prm)), SpoolObject);
 387                                           if Length(TempStr) > 0 then
 388                                              Logger.AddLine(LogAgent, TempStr);
 389                                        end
 390                                        else
 391                                           SpoolObject.Envelope.AddRecipient(Prm);
 392
 393                                        Response.SetReply(SMTP_R_OK, 'OK');
 394                                        TCP.SendResponse(Response);
 395                                        Logger.AddLine(LogAgent, 'Local recipient accepted: <' + Prm + '>');
 396                                     end
 397                                     else
 398                                        SendAndLogResponse(SMTP_R_STOR_EXCEEDED, '<' + Prm + '>: User quota exceeded');
 399                                  end
 400                                  else
 401                                     SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: Mailbox alias rejected');
 402                               end
 403                               else
 404                                  SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: No mailbox here by that name');
 405                            end
 406                            else
 407                               SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: Store access denied');
 408                         end
 409                         else
 410                            SendAndLogResponse(SMTP_R_MAILBOX_NA, '<' + Prm + '>: This server doesn''t store local messages');
 411                      end
 412
 413                      else if MainServerConfig.Relay then begin
 414
 415                         { Things to check for relay addresses:
 416                           - Does the server ever accept relay addresses by configuration?
 417                           - Does the client has the right to RELAY messages or in the case
 418                             if the relay address is on the RelayTo list, does the client
 419                             has the STORE right?
 420                         }
 421
 422                         if (PolicyObject.HasRight(RIGHT_RELAY))
 423                            or (PolicyObject.HasRight(RIGHT_STORE) and RelayManager.IsOnRelayToList(EMailHost(Prm))) then begin
 424                            if not RelayManager.IsOnNoRelayToList(EMailHost(Prm)) then begin
 425                               SpoolObject.Envelope.AddRecipient(Prm);
 426                               Response.SetReply(SMTP_R_OK, 'OK');
 427                               TCP.SendResponse(Response);
 428                               Logger.AddLine(LogAgent, 'Relay recipient accepted: <' + Prm + '>');
 429                            end
 430                            else
 431                               SendAndLogResponse(SMTP_R_TRANS_FAILED, '<' + Prm + '>: Relaying towards this domain is not permitted');
 432                         end
 433                         else
 434                            SendAndLogResponse(SMTP_R_TRANS_FAILED, '<' + Prm + '>: Relay access denied, or maybe I just don''t like you');
 435                      end
 436                      else
 437                         SendAndLogResponse(SMTP_R_TRANS_FAILED, '<' + Prm + '>: Relaying has been disabled by configuration');
 438                   end
 439                   else
 440                      SendAndLogResponse(SMTP_R_MB_SYNTAX_ERROR, '<' + Prm + '>: Recipient address rejected: Syntax error');
 441                end
 442                else
 443                   SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'You must initiate e-mail transactions with MAIL command');
 444             end
 445
 446             else if Cmd = SMTP_C_DATA then begin
 447                if SpoolAllocated then begin
 448                   if SpoolObject.Envelope.IsComplete then begin
 449                      ReceiveEMailData(TCP, Response, SpoolObject);
 450                      Logger.AddLine(LogAgent, 'Response: ' + IntToStr(Response.NumericCode) + ' ' + Response.GetLine(0));
 451                      TCP.SendResponse(Response);
 452                      Logger.AddLine('Object ' + SpoolObject.Name, 'Message-ID: <' + SpoolObject.OriginalMessageID + '>');
 453                      SpoolObject.Free;
 454                      SpoolAllocated:= false;
 455                   end
 456                   else
 457                      SendAndLogResponse(SMTP_R_TRANS_FAILED, 'No valid recipients');
 458                end
 459                else
 460                   SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'You must initiate e-mail transactions with MAIL command');
 461             end
 462
 463             else if Cmd = SMTP_C_VRFY then
 464                SendAndLogResponse(SMTP_R_CANNOTVERIFY, 'Honestly, I don''t like to verify addresses')
 465
 466             else
 467                SendAndLogResponse(SMTP_R_CMD_SYNTAX_ERROR, 'Command not recognized (' + Cmd + ')');
 468          end
 469
 470          else
 471             SendAndLogResponse(SMTP_R_BAD_SEQUENCE, 'It would be more polite to say HELO first');
 472
 473       until (Cmd = SMTP_C_QUIT) or (not ReadSucceeded) or (UnexpectedFail);
 474
 475       if not ReadSucceeded then
 476          SendAndLogResponse(SMTP_R_SERVICE_NA, 'Socket read error');
 477    end
 478
 479    else begin
 480
 481       { If the client doesn't have the right to CONNECT here, disconnect it
 482         with a rather unfriendly message. }
 483
 484       SendAndLogResponse(SMTP_R_TRANS_FAILED, 'Host is not permitted by server configuration');
 485       SendAndLogResponse(SMTP_R_SERVICE_NA, 'You are not welcome here, I shall disconnect you');
 486       {repeat
 487          TCP.ReadCommand(Cmd, Prm);
 488          if Cmd <> SMTP_C_QUIT then
 489             Response.SetReply(SMTP_R_BAD_SEQUENCE, 'You are not welcome here, I suggest you to QUIT')
 490          else
 491             Response.SetReply(SMTP_R_CLOSE, 'Closing connection');
 492          TCP.SendResponse(Response);
 493       until Cmd = SMTP_C_QUIT;}
 494    end;
 495
 496    { Free the spool object (if we have any), close the connection,
 497      and free other allocated resources, log disconnection. }
 498
 499    if SpoolAllocated then begin
 500       if SpoolObject.Opened then SpoolObject.Discard;
 501       SpoolObject.Free;
 502    end;
 503    PolicyObject.Free;
 504    Response.Free;
 505    Originator.Free;
 506    TCP.Free;
 507    Logger.AddLine(LogAgent, 'Client disconnected.');
 508 end;
 509
 510 procedure TMgSMTPListener.ReceiveEMailData(TCP: TTCPRFCConnection; Response: TRFCReply; SpoolObject: TSpoolObjectCreator);
 511 { Receive e-mail lines until a line with a single dot (".") arrives.
 512   Check databytes limit!
 513   This procedure should never call TCP.SendResponse - the set up response
 514   will be sent by the caller! }
 515 var Line: string; Done, ReadOK: boolean;
 516 begin
 517    if SpoolObject.Open then begin
 518       Response.SetReply(SMTP_R_START_MAIL_INPUT, 'Start mail input; end with "<CRLF>.<CRLF>" sequence');
 519       TCP.SendResponse(Response);
 520       Done:= false;
 521       repeat
 522          ReadOK:= TCP.ReadLn(Line);
 523          if Line <> '.' then begin
 524             { If the line starts with a dot, remove it to comply with RFC. }
 525             if (Length(Line) > 1) and (Line[1] = '.') then Delete(Line, 1, 1);
 526             SpoolObject.DeliverMessagePart(Line);
 527          end
 528          else
 529             Done:= true;
 530       until Done or (not ReadOK);
 531       if ReadOK then begin
 532          if SpoolObject.GetErrorCode <> SCE_NO_ERROR then begin
 533
 534             case SpoolObject.GetErrorCode of
 535
 536                SCE_SIZE_EXCEEDED:
 537                   Response.SetReply(SMTP_R_STOR_EXCEEDED, 'Message size exceeds the configured databytes limit');
 538
 539                SCE_LOOP_DETECTED:
 540                begin
 541                   Response.Clear;
 542                   Response.SetNumericCode(SMTP_R_TRANS_FAILED);
 543                   Response.Add('Too many "Received" headers in mail data.');
 544                   Response.Add('It''s likely that your message got trapped in a mail relay loop. In most');
 545                   Response.Add('cases it is caused by faulty mail server configuration. Please notify the');
 546                   Response.Add('administrator by forwarding this failure notice to the following address:');
 547                   Response.Add('<postmaster@' + MainServerConfig.Name + '>!');
 548                end;
 549
 550                SCE_WRITE_FAIL:
 551                   Response.SetReply(SMTP_R_ABORTED, 'Could not write mail data. Try again later.');
 552
 553                else
 554                   Response.SetReply(SMTP_R_ABORTED, 'Unknown error. Could not queue mail data.');
 555
 556             end;
 557
 558             SpoolObject.Discard;
 559
 560          end
 561          else begin
 562             Response.SetReply(SMTP_R_OK, 'Queued as ' + SpoolObject.Name);
 563             SpoolObject.Close;
 564          end;
 565       end
 566       else begin
 567          Response.SetReply(SMTP_R_SERVICE_NA, 'Socket read error in DATA phase (timeout?)');
 568          SpoolObject.Discard;
 569       end;
 570    end
 571    else Response.SetReply(SMTP_R_ABORTED, 'Internal error: could not open spool object');
 572 end;
 573
 574
 575 end.