Relay.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: Relay
  21    This unit implements the necessary objects to relay messages towards
  22    remote servers. It handles the re-routing of messages, when it's
  23    configured.
  24 }
  25
  26
  27 {$MODE DELPHI}
  28 unit Relay;
  29
  30 interface
  31 uses SysUtils, Classes, INIFiles, Base64, CompareWild, Common, Network,
  32      DNSMX, NetRFC, RFCSMTP;
  33
  34 type
  35
  36    TMailRoute = record
  37       Mask: string;
  38       Target: integer;
  39    end;
  40
  41    TSMTPExtensions = record
  42       Pipelining, Size, EbitMIME: boolean;
  43    end;
  44
  45    { A TRoutingTarget holds the data for a single relay host.
  46      The administrator may give a symbolic name to some relay hosts that
  47      identifies a distinct section in the configuration INI file, where
  48      all necessary data can be found to contact the particular relay host. }
  49
  50    TRoutingTarget = class
  51       constructor Create(Name, TargetHost: string; Port: integer; Auth: boolean; Username, Password: string);
  52    protected
  53       FName, FTargetHost, FUsername, FPassword: string;
  54       FPort: integer;
  55       FAuth: boolean;
  56    public
  57       property Name: string read FName;
  58       property Host: string read FTargetHost;
  59       property Port: integer read FPort;
  60       property Auth: boolean read FAuth;
  61       property Username: string read FUsername;
  62       property Password: string read FPassword;
  63       function Copy: TRoutingTarget;
  64    end;
  65
  66    { TRoutingTable manages re-routing. It can be asked where to relay e-mails
  67      for a specific host. It holds multiple instances of TRoutingTarget. }
  68
  69    TRoutingTable = class
  70       constructor Create;
  71       destructor Destroy; override;
  72    protected
  73       Targets: array of TRoutingTarget;
  74       Routes: array of TMailRoute;
  75       function FindOrLoadTarget(TargetName, TargetHost: string; Port: integer; Auth: boolean; Username, Password: string): integer;
  76    public
  77       procedure AddRoute(Mask: string; TargetName, TargetHost: string; Port: integer; Auth: boolean; Username, Password: string);
  78       function ReRoute(Host: string): string;
  79       function GetRouteInfo(Host: string): TRoutingTarget;
  80    end;
  81
  82    { TRelayer does the actual relaying to a host. It connects the target server
  83      and passes the message to it by SMTP protocol. }
  84
  85    TRelayer = class
  86       constructor Create(RoutingTable: TRoutingTable; Envelope: TEnvelope; EMailProperties: TEMailProperties);
  87       destructor Destroy; override;
  88    protected
  89       FEnvelope: TEnvelope;
  90       FEMailProperties: TEMailProperties;
  91       FTransactionComplete: boolean;
  92       FRoutingTarget: TRoutingTarget;
  93       RoutingTable: TRoutingTable;
  94       TCP: TTCPRFCConnection;
  95       Response: TRFCReply;
  96       SMTPExtensions: TSMTPExtensions;
  97       procedure AdministerMassFailure(var Result: boolean);
  98       function GetRelayServerName: string;
  99       function GetRelayServerPort: integer;
 100    public
 101       property Envelope: TEnvelope read FEnvelope;
 102       property EMailProperties: TEMailProperties read FEMailProperties;
 103       property IsTransactionComplete: boolean read FTransactionComplete;
 104       property RelayServerName: string read GetRelayServerName;
 105       property RelayServerPort: integer read GetRelayServerPort;
 106       function OpenConnection: boolean;
 107       function Greet: boolean;
 108       function SendEnvelope: boolean;
 109       function PrepareSendMessage: boolean;
 110       function DeliverMessagePart(Chunk: TStrings): boolean;
 111       procedure FinishDeliverMessage;
 112       procedure CloseConnection;
 113    end;
 114
 115    { TRelayManager is the main manager object of the entire relay unit.
 116      It loads all the configuration, sets up the corresponding objects,
 117      and it creates configured TRelayer-s. }
 118
 119    TRelayManager = class
 120       constructor Create(Config: TINIFile);
 121       destructor Destroy; override;
 122    protected
 123       RelayToList, NoRelayToList: TStrings;
 124       RoutingTable: TRoutingTable;
 125    public
 126       function CreateRelayer(Envelope: TEnvelope; EMailProperties: TEMailProperties): TRelayer;
 127       function IsOnRelayToList(HostName: string): boolean;
 128       function IsOnNoRelayToList(HostName: string): boolean;
 129       function OrganizeEnvelopes(Envelopes: TEnvelopeArray): TEnvelopeArray;
 130    end;
 131
 132
 133 var
 134
 135    RelayManager: TRelayManager;
 136
 137
 138
 139 implementation
 140
 141
 142 constructor TRoutingTarget.Create(Name, TargetHost: string; Port: Integer; Auth: boolean; Username, Password: string);
 143 begin
 144    inherited Create;
 145    FName:= Name;
 146    if TargetHost = '' then FTargetHost:= Name else FTargetHost:= TargetHost;
 147    FPort:= Port;
 148    FAuth:= Auth;
 149    FUsername:= Username;
 150    FPassword:= Password;
 151 end;
 152
 153 constructor TRoutingTable.Create;
 154 begin
 155    inherited Create;
 156    SetLength(Targets, 0);
 157    SetLength(Routes, 0);
 158 end;
 159
 160 destructor TRoutingTable.Destroy;
 161 var i: integer;
 162 begin
 163    for i:= 0 to Length(Targets) - 1 do
 164       Targets[i].Free;
 165    SetLength(Routes, 0);
 166    SetLength(Targets, 0);
 167    inherited Destroy;
 168 end;
 169
 170 constructor TRelayer.Create(RoutingTable: TRoutingTable; Envelope: TEnvelope; EMailProperties: TEMailProperties);
 171 begin
 172    inherited Create;
 173    Self.RoutingTable:= RoutingTable;
 174    FEnvelope:= Envelope;
 175    FEMailProperties:= EMailProperties;
 176    FTransactionComplete:= false;
 177    FRoutingTarget:= RoutingTable.GetRouteInfo(Envelope.RelayHost);
 178    Response:= TRFCReply.Create;
 179    FillChar(SMTPExtensions, SizeOf(TSMTPExtensions), #0);
 180 end;
 181
 182 destructor TRelayer.Destroy;
 183 begin
 184    FRoutingTarget.Free;
 185    Response.Free;
 186    inherited Destroy;
 187 end;
 188
 189 constructor TRelayManager.Create(Config: TINIFile);
 190 var i: integer; RouteMasks: TStringList; RouteName: string;
 191 begin
 192    inherited Create;
 193
 194    RelayToList:= TStringList.Create;
 195    RelayToList.Delimiter:= ',';
 196    RelayToList.DelimitedText:= Config.ReadString('Relay', 'RelayTo', '');
 197
 198    NoRelayToList:= TStringList.Create;
 199    NoRelayToList.Delimiter:= ',';
 200    NoRelayToList.DelimitedText:= Config.ReadString('Relay', 'NoRelayTo', '');
 201
 202    RoutingTable:= TRoutingTable.Create;
 203    RouteMasks:= TStringList.Create;
 204    Config.ReadSection('Relay\Routes', RouteMasks);
 205    for i:= 0 to RouteMasks.Count - 1 do begin
 206       RouteName:= Config.ReadString('Relay\Routes', RouteMasks.Strings[i], '!');
 207       RoutingTable.AddRoute(RouteMasks.Strings[i],
 208          RouteName,
 209          Config.ReadString('Relay\Routes\' + RouteName, 'Host', ''),
 210          Config.ReadInteger('Relay\Routes\' + RouteName, 'Port', STANDARD_SMTP_PORT),
 211          Config.ReadBool('Relay\Routes\' + RouteName, 'Auth', false),
 212          Config.ReadString('Relay\Routes\' + RouteName, 'Username', ''),
 213          Config.ReadString('Relay\Routes\' + RouteName, 'Password', '')
 214       );
 215    end;
 216    RouteMasks.Free;
 217 end;
 218
 219 destructor TRelayManager.Destroy;
 220 begin
 221    RelayToList.Free;
 222    RoutingTable.Free;
 223    inherited Destroy;
 224 end;
 225
 226
 227 function TRoutingTarget.Copy: TRoutingTarget;
 228 begin
 229    Result:= TRoutingTarget.Create(Name, Host, Port, Auth, Username, Password);
 230 end;
 231
 232 procedure TRoutingTable.AddRoute(Mask: string; TargetName, TargetHost: string; Port: integer; Auth: boolean; Username, Password: string);
 233 { It should be only called at start-up. It creates the necessary TRountingTarget
 234   objects. It doesn't create redundant targets. If more entries are there to
 235   relay to a specific server, then only one TRoutingTarget will be created
 236   for that relay host. It is ensured by FindOrLoadTarget. }
 237 var i: integer;
 238 begin
 239    i:= Length(Routes);
 240    SetLength(Routes, i + 1);
 241    Routes[i].Mask:= Mask;
 242    Routes[i].Target:= FindOrLoadTarget(TargetName, TargetHost, Port, Auth, Username, Password);
 243 end;
 244
 245 function TRoutingTable.FindOrLoadTarget(TargetName, TargetHost: string; Port: integer; Auth: boolean; Username, Password: string): integer;
 246 { Creates a new TRoutingTarget, but only if no other TRoutingTarget exists
 247   with the same name. If it does find an already-existing TRoutingTarget
 248   with the given name, it returns that instance. }
 249 var i, x: integer; Found: boolean;
 250 begin
 251    i:= 0; Found:= false;
 252    while (i < Length(Targets)) and (not Found) do begin
 253       if Targets[i].Name = TargetName then begin
 254          Found:= true;
 255          x:= i;
 256       end;
 257       Inc(i);
 258    end;
 259    if not Found then begin
 260       x:= Length(Targets);
 261       SetLength(Targets, x + 1);
 262       Targets[x]:= TRoutingTarget.Create(TargetName, TargetHost, Port, Auth, Username, Password);
 263    end;
 264    Result:= x;
 265 end;
 266
 267 function TRoutingTable.ReRoute(Host: string): string;
 268 { It returns the NAME of the relay host that's supposed to relay messages
 269   towards the specified host. The mentioned NAME can be a hostname or
 270   a symbolic name given in the configuration. If this function returns "!",
 271   that means that the message should be relayed to the named host itself. }
 272 var i: integer; Found: boolean;
 273 begin
 274    i:= 0; Found:= false;
 275    while (i < Length(Routes)) and (not Found) do begin
 276       if WildComp(UpperCase(Routes[i].Mask), UpperCase(Host)) then begin
 277          Result:= Targets[Routes[i].Target].Name;
 278          Found:= true;
 279       end;
 280       Inc(i);
 281    end;
 282    if not Found then Result:= Host;
 283 end;
 284
 285 function TRoutingTable.GetRouteInfo(Host: string): TRoutingTarget;
 286 { It returns the corresponding TRoutingTarget for a given name.
 287   That name may be a symbolic name, given in the configuration,
 288   or a valid hostname.
 289   Note, this function returns a COPY of the TRoutingTarget.
 290   The caller is responsible for freeing it.
 291   If there is no TRoutingTarget with the given name, the function
 292   creates a new TRoutingTarget and puts the given hostname into it. }
 293 var i: integer; Found: boolean;
 294 begin
 295    i:= 0; Found:= false;
 296    while (i < Length(Targets)) and (not Found) do begin
 297       if Targets[i].Name = Host then begin
 298          Result:= Targets[i].Copy;
 299          Found:= true;
 300       end;
 301       Inc(i);
 302    end;
 303    if not Found then Result:= TRoutingTarget.Create(Host, Host, STANDARD_SMTP_PORT, false, '', '');
 304 end;
 305
 306
 307 procedure TRelayer.AdministerMassFailure(var Result: boolean);
 308 begin
 309    Envelope.SetAllRecipientData(Response.GetNumericCode, Response.ReplyText.Text);
 310    Result:= false;
 311 end;
 312
 313 function TRelayer.GetRelayServerName: string;
 314 begin
 315    Result:= FRoutingTarget.Host;
 316 end;
 317
 318 function TRelayer.GetRelayServerPort: integer;
 319 begin
 320    Result:= FRoutingTarget.Port;
 321 end;
 322
 323 function TRelayer.OpenConnection: boolean;
 324 { Initiates connection to the relay site. It queries the MX records for the
 325   relay site's domain, and tries to connect the resulting hosts in the
 326   order of MX priorities. If there are no MX records for the domain,
 327   the domain's A record will be connected.
 328   The function returns TRUE, if it successfully established connection
 329   to any of the MX hostnames. }
 330 var MXList: TStrings; i: integer;
 331 begin
 332    MXList:= GetCorrectMXRecordList(RelayServerName);
 333    if MXList.Count >= 1 then begin
 334       TCP:= TTCPRFCConnection.Create;
 335       TCP.SetBindAddress(AF_INET,  MainServerConfig.BindAddress);
 336       TCP.SetBindAddress(AF_INET6, MainServerConfig.BindAddress6);
 337       TCP.Connect(MXList.Strings[0], RelayServerPort);
 338       TCP.SetSockTimeOut(DEF_SOCK_TIMEOUT);
 339       i:= 1;
 340       while (not TCP.Connected) and (i < MXList.Count) do begin
 341          TCP.Connect(MXList.Strings[i], RelayServerPort);
 342          Inc(i);
 343       end;
 344       Result:= TCP.Connected;
 345    end
 346    else Result:= false;
 347    MXList.Free;
 348    FTransactionComplete:= false;
 349 end;
 350
 351 function TRelayer.Greet: boolean;
 352 { This function reads and checks the relay server's greeting.
 353   Then identifies this server with an EHLO.
 354   Then, if necessary, authenticates at the connected relay server.
 355   The function returns true, if the authentication and the EHLO command were
 356   successful. }
 357 var
 358    i: integer;
 359    Authenticated: boolean;
 360    StringStream: TStringStream;
 361    Base64EncodingStream: TBase64EncodingStream;
 362    Line: string;
 363
 364 begin
 365    Response.Clear;
 366    AdministerMassFailure(Result);
 367    TCP.ReadResponse(Response);
 368
 369    { Expect 2xx reply. }
 370    if (Response.GetNumericCode div 100) = 2 then begin
 371
 372       TCP.SendCommand(SMTP_C_EHLO, MainServerConfig.Name);
 373       TCP.ReadResponse(Response);
 374
 375       if Response.GetNumericCode = SMTP_R_OK then begin
 376          for i:= 1 to Response.Count - 1 do begin
 377             Line:= UpperCase(Response.GetLine(i));
 378             if pos('PIPELINING', Line) = 1 then
 379                SMTPExtensions.Pipelining:= true
 380             else if pos('SIZE', Line) = 1 then
 381                SMTPExtensions.Size:= true
 382             else if pos('8BITMIME', Line) = 1 then
 383                SMTPExtensions.EbitMIME:= true;
 384          end;
 385          Result:= true;
 386       end
 387       else if (Response.GetNumericCode >= 500) and (Response.GetNumericCode <= 504) then begin
 388          { It seems the remote site did not understand our EHLO, that is,
 389            let's admit, quite odd in the 21st century...
 390            Whatever, let's fall back to RFC 821 then. }
 391          TCP.SendCommand(SMTP_C_HELO, MainServerConfig.Name);
 392          TCP.ReadResponse(Response);
 393          Result:= Response.GetNumericCode = SMTP_R_OK;
 394       end;
 395
 396       if Result then begin
 397          if FRoutingTarget.Auth then begin
 398             TCP.SendCommand(SMTP_C_AUTH, 'LOGIN');
 399             TCP.ReadResponse(Response);
 400             if Response.GetNumericCode = SMTP_R_AUTH_MESSAGE then begin
 401                StringStream:= TStringStream.Create('');
 402                Base64EncodingStream:= TBase64EncodingStream.Create(StringStream);
 403                Base64EncodingStream.Write(PChar(FRoutingTarget.Username)^, Length(FRoutingTarget.Username));
 404                Base64EncodingStream.Destroy;
 405                TCP.WriteLn(StringStream.DataString);
 406                StringStream.Destroy;
 407                TCP.ReadResponse(Response);
 408                if Response.GetNumericCode = SMTP_R_AUTH_MESSAGE then begin
 409                   StringStream:= TStringStream.Create('');
 410                   Base64EncodingStream:= TBase64EncodingStream.Create(StringStream);
 411                   Base64EncodingStream.Write(PChar(FRoutingTarget.Password)^, Length(FRoutingTarget.Password));
 412                   Base64EncodingStream.Destroy;
 413                   TCP.WriteLn(StringStream.DataString);
 414                   StringStream.Destroy;
 415                   TCP.ReadResponse(Response);
 416                   Authenticated:= Response.GetNumericCode = SMTP_R_AUTH_SUCCESSFUL;
 417                end
 418                else Authenticated:= false;
 419             end
 420             else Authenticated:= false;
 421          end
 422          else Authenticated:= true;
 423
 424          if not Authenticated then AdministerMassFailure(Result);
 425       end
 426       else AdministerMassFailure(Result);
 427
 428    end
 429    else AdministerMassFailure(Result);
 430 end;
 431
 432 function TRelayer.SendEnvelope: boolean;
 433 { Sends the envelope (that is the return-path and the recipient addresses).
 434   The function returns true, if the MAIL command were successful, and the
 435   relay server has accepted at least one of the recipient addresses.
 436   This function returns false if a null reply is read, which is considered
 437   as protocol violation.
 438   This function is aware of the SMTP extension, named PIPELINING. If it's
 439   supported by the server, we send RCPT commands stuffed, without waiting
 440   for a response. After all RCPTs are sent, we check all responses. }
 441 var
 442    i, c: integer; UltimateFail: boolean; Prms: string;
 443
 444    procedure ProcessRCPTResponse;
 445    begin
 446       TCP.ReadResponse(Response);
 447       { If we get an "OK" reply code, we increase the count of successful
 448         recipients. }
 449       if Response.GetNumericCode = SMTP_R_OK then Inc(c)
 450       { Response code 0 is non-existent in the SMTP protocol.
 451         If we receive something we _perceive_ as 0, then it is likely
 452         that something seriously went wrong. MgSMTP shouldn't treat
 453         this condition as permanent. }
 454       else if Response.GetNumericCode = 0 then UltimateFail:= true;
 455       Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
 456    end;
 457
 458 begin
 459    { The MAIL command is considered the beginning of the transaction. }
 460    FTransactionComplete:= false;
 461    UltimateFail:= false;
 462    Response.Clear;
 463    Prms:= 'FROM:<' + Envelope.ReturnPath + '>';
 464
 465    if SMTPExtensions.Size then
 466       Prms:= Prms + ' SIZE=' + IntToStr(EMailProperties.Size);
 467    if SMTPExtensions.EbitMIME and EMailProperties.HasFlag(EF_8BITMIME) then
 468       Prms:= Prms + ' BODY=8BITMIME';
 469
 470    TCP.SendCommand(SMTP_C_MAIL, Prms);
 471    TCP.ReadResponse(Response);
 472    if Response.GetNumericCode = SMTP_R_OK then begin
 473       c:= 0;
 474       for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 475          TCP.SendCommand(SMTP_C_RCPT, 'TO:<' + Envelope.GetRecipient(i).Address + '>');
 476          { If pipelining is not supported, read the responses now. }
 477          if not SMTPExtensions.Pipelining then ProcessRCPTResponse;
 478       end;
 479
 480       { If pipelining is supported, process all responses. }
 481       if SMTPExtensions.Pipelining then
 482          for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
 483             ProcessRCPTResponse;
 484
 485       Result:= (c <> 0) and (not UltimateFail);
 486
 487       { If there are no accepted recipients, and no protocol failure is
 488         discovered, we can't send the DATA command, and practically we
 489         can do nothing more for this transaction. Therefore it is
 490         considered complete by protocol. }
 491       FTransactionComplete:= (c = 0) and (not UltimateFail);
 492
 493       if not Result then begin
 494          { Either way, try to reset SMTP state in case of failure. }
 495          TCP.SendCommand(SMTP_C_RSET);
 496          TCP.ReadResponse(Response);
 497       end;
 498    end
 499    else AdministerMassFailure(Result);
 500 end;
 501
 502 function TRelayer.PrepareSendMessage;
 503 { Prepares mail transmission with the DATA command. }
 504 begin
 505    TCP.SendCommand(SMTP_C_DATA);
 506    TCP.ReadResponse(Response);
 507    Result:= Response.GetNumericCode = SMTP_R_START_MAIL_INPUT;
 508 end;
 509
 510 function TRelayer.DeliverMessagePart(Chunk: TStrings): boolean;
 511 { Sends a chunk of the message. }
 512 var i: integer;
 513 begin
 514    { Check for lines starting with dots. }
 515    for i:= 0 to Chunk.Count - 1 do
 516       if (Length(Chunk.Strings[i]) > 0) and (Chunk.Strings[i][1] = '.') then
 517          Chunk.Strings[i]:= '.' + Chunk.Strings[i];
 518
 519    { Send text. }
 520    Result:= TCP.WriteBuffer(PChar(Chunk.Text), Length(Chunk.Text)) <> -1;
 521 end;
 522
 523 procedure TRelayer.FinishDeliverMessage;
 524 { Finishes the message with a line containing a single dot. }
 525 var i: integer;
 526 begin
 527    TCP.WriteLn('.');
 528    TCP.ReadResponse(Response);
 529
 530    { Mark the transaction complete, if we have a valid response. }
 531    FTransactionComplete:= Response.GetNumericCode <> 0;
 532
 533    for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 534       { Set status code for recipients those were accepted in the envelope stage: }
 535       if Envelope.GetRecipient(i).Data = SMTP_R_OK then
 536          Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
 537    end;
 538 end;
 539
 540 procedure TRelayer.CloseConnection;
 541 begin
 542    TCP.SendCommand(SMTP_C_QUIT);
 543    {TCP.ReadResponse(Response);}
 544    TCP.Free;
 545 end;
 546
 547
 548 function TRelayManager.CreateRelayer(Envelope: TEnvelope; EMailProperties: TEMailProperties): TRelayer;
 549 begin
 550    Result:= TRelayer.Create(RoutingTable, Envelope, EMailProperties);
 551 end;
 552
 553 function TRelayManager.IsOnRelayToList(HostName: string): boolean;
 554 begin
 555    Result:= RelayToList.IndexOf(HostName) <> -1;
 556 end;
 557
 558 function TRelayManager.IsOnNoRelayToList(HostName: string): boolean;
 559 begin
 560    Result:= NoRelayToList.IndexOf(HostName) <> -1;
 561 end;
 562
 563 function TRelayManager.OrganizeEnvelopes(Envelopes: TEnvelopeArray): TEnvelopeArray;
 564 { Organizes the given envelopes for relaying.
 565   This function assumes that input envelopes are containing recipient
 566   addresses orientating to the same site.
 567   If it turns out that e-mails for multiple sites must be actually relayed
 568   through the same relay server, this function merges the envelopes for
 569   those sites; so later, such e-mails will be transmitted though a single
 570   connection.
 571
 572   For example, the configuration file indicates:
 573   - E-mails for "foo.com" must be relayed through "myrelaysmtp".
 574   - E-mails for "bar.com" must be also relayed through "myrelaysmtp".
 575   In this case, the envelopes for "foo.com" and "bar.com" will be merged,
 576   and the e-mail for these sites will be transmitted in one TCP connection. }
 577
 578 var i, j, k: integer; f: boolean; Recipient: TRecipient; OrgHost, TrgHost: string;
 579 begin
 580    SetLength(Result, 0);
 581    for i:= 0 to Length(Envelopes) - 1 do begin
 582       if Envelopes[i].GetNumberOfRecipients > 0 then begin
 583          Recipient:= Envelopes[i].GetRecipient(0);
 584          OrgHost:= EMailHost(Recipient.Address);
 585          TrgHost:= RoutingTable.ReRoute(OrgHost);
 586          if TrgHost = '!' then TrgHost:= OrgHost;
 587          j:= 0; f:= false;
 588          while (j < Length(Result)) and (not f) do begin
 589             f:= Result[j].RelayHost = TrgHost;
 590             Inc(j);
 591          end;
 592          { Note, if (not f) then j holds Length(Result). }
 593          if not f then begin
 594             SetLength(Result, j + 1);
 595             Result[j]:= TEnvelope.Create;
 596             Result[j].ReturnPath:= Envelopes[i].ReturnPath;
 597             Result[j].RelayHost:= TrgHost;
 598          end
 599          else Dec(j); { j must be decremented, because we over-incremented it in the loop. }
 600          with Result[j] do begin
 601             { Add first recipient to the envelope. }
 602             AddRecipient(Recipient);
 603             { Add the remaining recipients. }
 604             for k:= 1 to Envelopes[i].GetNumberOfRecipients - 1 do
 605                AddRecipient(Envelopes[i].GetRecipient(k));
 606          end;
 607       end;
 608    end;
 609 end;
 610
 611
 612 end.