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