Listener.pas

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