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    TCP:= nil;
 180    FillChar(SMTPExtensions, SizeOf(TSMTPExtensions), #0);
 181 end;
 182
 183 destructor TRelayer.Destroy;
 184 begin
 185    FRoutingTarget.Free;
 186    Response.Free;
 187    if TCP <> nil then TCP.Free;
 188    inherited Destroy;
 189 end;
 190
 191 constructor TRelayManager.Create(Config: TINIFile);
 192 var i: integer; RouteMasks: TStringList; RouteName: string;
 193 begin
 194    inherited Create;
 195
 196    RelayToList:= TStringList.Create;
 197    RelayToList.Delimiter:= ',';
 198    RelayToList.DelimitedText:= Config.ReadString('Relay', 'RelayTo', '');
 199
 200    NoRelayToList:= TStringList.Create;
 201    NoRelayToList.Delimiter:= ',';
 202    NoRelayToList.DelimitedText:= Config.ReadString('Relay', 'NoRelayTo', '');
 203
 204    RoutingTable:= TRoutingTable.Create;
 205    RouteMasks:= TStringList.Create;
 206    Config.ReadSection('Relay\Routes', RouteMasks);
 207    for i:= 0 to RouteMasks.Count - 1 do begin
 208       RouteName:= Config.ReadString('Relay\Routes', RouteMasks.Strings[i], '!');
 209       RoutingTable.AddRoute(RouteMasks.Strings[i],
 210          RouteName,
 211          Config.ReadString('Relay\Routes\' + RouteName, 'Host', ''),
 212          Config.ReadInteger('Relay\Routes\' + RouteName, 'Port', STANDARD_SMTP_PORT),
 213          Config.ReadBool('Relay\Routes\' + RouteName, 'Auth', false),
 214          Config.ReadString('Relay\Routes\' + RouteName, 'Username', ''),
 215          Config.ReadString('Relay\Routes\' + RouteName, 'Password', '')
 216       );
 217    end;
 218    RouteMasks.Free;
 219 end;
 220
 221 destructor TRelayManager.Destroy;
 222 begin
 223    RelayToList.Free;
 224    RoutingTable.Free;
 225    inherited Destroy;
 226 end;
 227
 228
 229 function TRoutingTarget.Copy: TRoutingTarget;
 230 begin
 231    Result:= TRoutingTarget.Create(Name, Host, Port, Auth, Username, Password);
 232 end;
 233
 234 procedure TRoutingTable.AddRoute(Mask: string; TargetName, TargetHost: string; Port: integer; Auth: boolean; Username, Password: string);
 235 { It should be only called at start-up. It creates the necessary TRountingTarget
 236   objects. It doesn't create redundant targets. If more entries are there to
 237   relay to a specific server, then only one TRoutingTarget will be created
 238   for that relay host. It is ensured by FindOrLoadTarget. }
 239 var i: integer;
 240 begin
 241    i:= Length(Routes);
 242    SetLength(Routes, i + 1);
 243    Routes[i].Mask:= Mask;
 244    Routes[i].Target:= FindOrLoadTarget(TargetName, TargetHost, Port, Auth, Username, Password);
 245 end;
 246
 247 function TRoutingTable.FindOrLoadTarget(TargetName, TargetHost: string; Port: integer; Auth: boolean; Username, Password: string): integer;
 248 { Creates a new TRoutingTarget, but only if no other TRoutingTarget exists
 249   with the same name. If it does find an already-existing TRoutingTarget
 250   with the given name, it returns that instance. }
 251 var i, x: integer; Found: boolean;
 252 begin
 253    i:= 0; Found:= false;
 254    while (i < Length(Targets)) and (not Found) do begin
 255       if Targets[i].Name = TargetName then begin
 256          Found:= true;
 257          x:= i;
 258       end;
 259       Inc(i);
 260    end;
 261    if not Found then begin
 262       x:= Length(Targets);
 263       SetLength(Targets, x + 1);
 264       Targets[x]:= TRoutingTarget.Create(TargetName, TargetHost, Port, Auth, Username, Password);
 265    end;
 266    Result:= x;
 267 end;
 268
 269 function TRoutingTable.ReRoute(Host: string): string;
 270 { It returns the NAME of the relay host that's supposed to relay messages
 271   towards the specified host. The mentioned NAME can be a hostname or
 272   a symbolic name given in the configuration. If this function returns "!",
 273   that means that the message should be relayed to the named host itself. }
 274 var i: integer; Found: boolean;
 275 begin
 276    i:= 0; Found:= false;
 277    while (i < Length(Routes)) and (not Found) do begin
 278       if WildComp(UpperCase(Routes[i].Mask), UpperCase(Host)) then begin
 279          Result:= Targets[Routes[i].Target].Name;
 280          Found:= true;
 281       end;
 282       Inc(i);
 283    end;
 284    if not Found then Result:= Host;
 285 end;
 286
 287 function TRoutingTable.GetRouteInfo(Host: string): TRoutingTarget;
 288 { It returns the corresponding TRoutingTarget for a given name.
 289   That name may be a symbolic name, given in the configuration,
 290   or a valid hostname.
 291   Note, this function returns a COPY of the TRoutingTarget.
 292   The caller is responsible for freeing it.
 293   If there is no TRoutingTarget with the given name, the function
 294   creates a new TRoutingTarget and puts the given hostname into it. }
 295 var i: integer; Found: boolean;
 296 begin
 297    i:= 0; Found:= false;
 298    while (i < Length(Targets)) and (not Found) do begin
 299       if Targets[i].Name = Host then begin
 300          Result:= Targets[i].Copy;
 301          Found:= true;
 302       end;
 303       Inc(i);
 304    end;
 305    if not Found then Result:= TRoutingTarget.Create(Host, Host, STANDARD_SMTP_PORT, false, '', '');
 306 end;
 307
 308
 309 procedure TRelayer.AdministerMassFailure(var Result: boolean);
 310 begin
 311    Envelope.SetAllRecipientData(Response.GetNumericCode, Response.ReplyText.Text);
 312    Result:= false;
 313 end;
 314
 315 function TRelayer.GetRelayServerName: string;
 316 begin
 317    Result:= FRoutingTarget.Host;
 318 end;
 319
 320 function TRelayer.GetRelayServerPort: integer;
 321 begin
 322    Result:= FRoutingTarget.Port;
 323 end;
 324
 325 function TRelayer.OpenConnection: boolean;
 326 { Initiates connection to the relay site. It queries the MX records for the
 327   relay site's domain, and tries to connect the resulting hosts in the
 328   order of MX priorities. If there are no MX records for the domain,
 329   the domain's A record will be connected.
 330   The function returns TRUE, if it successfully established connection
 331   to any of the MX hostnames. }
 332 var MXList: TStrings; i: integer;
 333 begin
 334    MXList:= GetCorrectMXRecordList(RelayServerName);
 335    if MXList.Count >= 1 then begin
 336       TCP:= TTCPRFCConnection.Create;
 337       TCP.SetBindAddress(MainServerConfig.BindAddress);
 338       TCP.SetSockTimeOut(DEF_SOCK_TIMEOUT);
 339       i:= 0;
 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       if not TCP.Connected then FreeAndNil(TCP);
 346    end
 347    else Result:= false;
 348    MXList.Free;
 349    FTransactionComplete:= false;
 350 end;
 351
 352 function TRelayer.Greet: boolean;
 353 { This function reads and checks the relay server's greeting.
 354   Then identifies this server with an EHLO.
 355   Then, if necessary, authenticates at the connected relay server.
 356   The function returns true, if the authentication and the EHLO command were
 357   successful. }
 358 var
 359    i: integer;
 360    Authenticated: boolean;
 361    StringStream: TStringStream;
 362    Base64EncodingStream: TBase64EncodingStream;
 363    Line: string;
 364
 365 begin
 366    Response.Clear;
 367    AdministerMassFailure(Result);
 368    TCP.ReadResponse(Response);
 369
 370    { Expect 2xx reply. }
 371    if (Response.GetNumericCode div 100) = 2 then begin
 372
 373       TCP.SendCommand(SMTP_C_EHLO, MainServerConfig.Name);
 374       TCP.ReadResponse(Response);
 375
 376       if Response.GetNumericCode = SMTP_R_OK then begin
 377          for i:= 1 to Response.Count - 1 do begin
 378             Line:= UpperCase(Response.GetLine(i));
 379             if pos('PIPELINING', Line) = 1 then
 380                SMTPExtensions.Pipelining:= true
 381             else if pos('SIZE', Line) = 1 then
 382                SMTPExtensions.Size:= true
 383             else if pos('8BITMIME', Line) = 1 then
 384                SMTPExtensions.EbitMIME:= true;
 385          end;
 386          Result:= true;
 387       end
 388       else if (Response.GetNumericCode >= 500) and (Response.GetNumericCode <= 504) then begin
 389          { It seems the remote site did not understand our EHLO, that is,
 390            let's admit, quite odd in the 21st century...
 391            Whatever, let's fall back to RFC 821 then. }
 392          TCP.SendCommand(SMTP_C_HELO, MainServerConfig.Name);
 393          TCP.ReadResponse(Response);
 394          Result:= Response.GetNumericCode = SMTP_R_OK;
 395       end;
 396
 397       if Result then begin
 398          if FRoutingTarget.Auth then begin
 399             TCP.SendCommand(SMTP_C_AUTH, 'LOGIN');
 400             TCP.ReadResponse(Response);
 401             if Response.GetNumericCode = SMTP_R_AUTH_MESSAGE then begin
 402                StringStream:= TStringStream.Create('');
 403                Base64EncodingStream:= TBase64EncodingStream.Create(StringStream);
 404                Base64EncodingStream.Write(PChar(FRoutingTarget.Username)^, Length(FRoutingTarget.Username));
 405                Base64EncodingStream.Destroy;
 406                TCP.WriteLn(StringStream.DataString);
 407                StringStream.Destroy;
 408                TCP.ReadResponse(Response);
 409                if Response.GetNumericCode = SMTP_R_AUTH_MESSAGE then begin
 410                   StringStream:= TStringStream.Create('');
 411                   Base64EncodingStream:= TBase64EncodingStream.Create(StringStream);
 412                   Base64EncodingStream.Write(PChar(FRoutingTarget.Password)^, Length(FRoutingTarget.Password));
 413                   Base64EncodingStream.Destroy;
 414                   TCP.WriteLn(StringStream.DataString);
 415                   StringStream.Destroy;
 416                   TCP.ReadResponse(Response);
 417                   Authenticated:= Response.GetNumericCode = SMTP_R_AUTH_SUCCESSFUL;
 418                end
 419                else Authenticated:= false;
 420             end
 421             else Authenticated:= false;
 422          end
 423          else Authenticated:= true;
 424
 425          if not Authenticated then AdministerMassFailure(Result);
 426       end
 427       else AdministerMassFailure(Result);
 428
 429    end
 430    else AdministerMassFailure(Result);
 431 end;
 432
 433 function TRelayer.SendEnvelope: boolean;
 434 { Sends the envelope (that is the return-path and the recipient addresses).
 435   The function returns true, if the MAIL command were successful, and the
 436   relay server has accepted at least one of the recipient addresses.
 437   This function returns false if a null reply is read, which is considered
 438   as protocol violation.
 439   This function is aware of the SMTP extension, named PIPELINING. If it's
 440   supported by the server, we send RCPT commands stuffed, without waiting
 441   for a response. After all RCPTs are sent, we check all responses. }
 442 var
 443    i, c: integer; UltimateFail: boolean; Prms: string;
 444
 445    procedure ProcessRCPTResponse;
 446    begin
 447       TCP.ReadResponse(Response);
 448       { If we get an "OK" reply code, we increase the count of successful
 449         recipients. }
 450       if Response.GetNumericCode = SMTP_R_OK then Inc(c)
 451       { Response code 0 is non-existent in the SMTP protocol.
 452         If we receive something we _perceive_ as 0, then it is likely
 453         that something seriously went wrong. MgSMTP shouldn't treat
 454         this condition as permanent. }
 455       else if Response.GetNumericCode = 0 then UltimateFail:= true;
 456       Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
 457    end;
 458
 459 begin
 460    { The MAIL command is considered the beginning of the transaction. }
 461    FTransactionComplete:= false;
 462    UltimateFail:= false;
 463    Response.Clear;
 464    Prms:= 'FROM:<' + Envelope.ReturnPath + '>';
 465
 466    if SMTPExtensions.Size then
 467       Prms:= Prms + ' SIZE=' + IntToStr(EMailProperties.Size);
 468    if SMTPExtensions.EbitMIME and EMailProperties.HasFlag(EF_8BITMIME) then
 469       Prms:= Prms + ' BODY=8BITMIME';
 470
 471    TCP.SendCommand(SMTP_C_MAIL, Prms);
 472    TCP.ReadResponse(Response);
 473    if Response.GetNumericCode = SMTP_R_OK then begin
 474       c:= 0;
 475       for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 476          TCP.SendCommand(SMTP_C_RCPT, 'TO:<' + Envelope.GetRecipient(i).Address + '>');
 477          { If pipelining is not supported, read the responses now. }
 478          if not SMTPExtensions.Pipelining then ProcessRCPTResponse;
 479       end;
 480
 481       { If pipelining is supported, process all responses. }
 482       if SMTPExtensions.Pipelining then
 483          for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
 484             ProcessRCPTResponse;
 485
 486       Result:= (c <> 0) and (not UltimateFail);
 487
 488       { If there are no accepted recipients, and no protocol failure is
 489         discovered, we can't send the DATA command, and practically we
 490         can do nothing more for this transaction. Therefore it is
 491         considered complete by protocol. }
 492       FTransactionComplete:= (c = 0) and (not UltimateFail);
 493
 494       if not Result then begin
 495          { Either way, try to reset SMTP state in case of failure. }
 496          TCP.SendCommand(SMTP_C_RSET);
 497          TCP.ReadResponse(Response);
 498       end;
 499    end
 500    else AdministerMassFailure(Result);
 501 end;
 502
 503 function TRelayer.PrepareSendMessage;
 504 { Prepares mail transmission with the DATA command. }
 505 begin
 506    TCP.SendCommand(SMTP_C_DATA);
 507    TCP.ReadResponse(Response);
 508    Result:= Response.GetNumericCode = SMTP_R_START_MAIL_INPUT;
 509 end;
 510
 511 function TRelayer.DeliverMessagePart(Chunk: TStrings): boolean;
 512 { Sends a chunk of the message. }
 513 var i: integer;
 514 begin
 515    { Check for lines starting with dots. }
 516    for i:= 0 to Chunk.Count - 1 do
 517       if (Length(Chunk.Strings[i]) > 0) and (Chunk.Strings[i][1] = '.') then
 518          Chunk.Strings[i]:= '.' + Chunk.Strings[i];
 519
 520    { Send text. }
 521    Result:= TCP.WriteBuffer(PChar(Chunk.Text), Length(Chunk.Text)) <> -1;
 522 end;
 523
 524 procedure TRelayer.FinishDeliverMessage;
 525 { Finishes the message with a line containing a single dot. }
 526 var i: integer;
 527 begin
 528    TCP.WriteLn('.');
 529    TCP.ReadResponse(Response);
 530
 531    { Mark the transaction complete, if we have a valid response. }
 532    FTransactionComplete:= Response.GetNumericCode <> 0;
 533
 534    for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 535       { Set status code for recipients those were accepted in the envelope stage: }
 536       if Envelope.GetRecipient(i).Data = SMTP_R_OK then
 537          Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
 538    end;
 539 end;
 540
 541 procedure TRelayer.CloseConnection;
 542 begin
 543    TCP.SendCommand(SMTP_C_QUIT);
 544    {TCP.ReadResponse(Response);}
 545    FreeAndNil(TCP);
 546 end;
 547
 548
 549 function TRelayManager.CreateRelayer(Envelope: TEnvelope; EMailProperties: TEMailProperties): TRelayer;
 550 begin
 551    Result:= TRelayer.Create(RoutingTable, Envelope, EMailProperties);
 552 end;
 553
 554 function TRelayManager.IsOnRelayToList(HostName: string): boolean;
 555 begin
 556    Result:= RelayToList.IndexOf(HostName) <> -1;
 557 end;
 558
 559 function TRelayManager.IsOnNoRelayToList(HostName: string): boolean;
 560 begin
 561    Result:= NoRelayToList.IndexOf(HostName) <> -1;
 562 end;
 563
 564 function TRelayManager.OrganizeEnvelopes(Envelopes: TEnvelopeArray): TEnvelopeArray;
 565 { Organizes the given envelopes for relaying.
 566   This function assumes that input envelopes are containing recipient
 567   addresses orientating to the same site.
 568   If it turns out that e-mails for multiple sites must be actually relayed
 569   through the same relay server, this function merges the envelopes for
 570   those sites; so later, such e-mails will be transmitted though a single
 571   connection.
 572
 573   For example, the configuration file indicates:
 574   - E-mails for "foo.com" must be relayed through "myrelaysmtp".
 575   - E-mails for "bar.com" must be also relayed through "myrelaysmtp".
 576   In this case, the envelopes for "foo.com" and "bar.com" will be merged,
 577   and the e-mail for these sites will be transmitted in one TCP connection. }
 578
 579 var i, j, k: integer; f: boolean; Recipient: TRecipient; OrgHost, TrgHost: string;
 580 begin
 581    SetLength(Result, 0);
 582    for i:= 0 to Length(Envelopes) - 1 do begin
 583       if Envelopes[i].GetNumberOfRecipients > 0 then begin
 584          Recipient:= Envelopes[i].GetRecipient(0);
 585          OrgHost:= EMailHost(Recipient.Address);
 586          TrgHost:= RoutingTable.ReRoute(OrgHost);
 587          if TrgHost = '!' then TrgHost:= OrgHost;
 588          j:= 0; f:= false;
 589          while (j < Length(Result)) and (not f) do begin
 590             f:= Result[j].RelayHost = TrgHost;
 591             Inc(j);
 592          end;
 593          { Note, if (not f) then j holds Length(Result). }
 594          if not f then begin
 595             SetLength(Result, j + 1);
 596             Result[j]:= TEnvelope.Create;
 597             Result[j].ReturnPath:= Envelopes[i].ReturnPath;
 598             Result[j].RelayHost:= TrgHost;
 599          end
 600          else Dec(j); { j must be decremented, because we over-incremented it in the loop. }
 601          with Result[j] do begin
 602             { Add first recipient to the envelope. }
 603             AddRecipient(Recipient);
 604             { Add the remaining recipients. }
 605             for k:= 1 to Envelopes[i].GetNumberOfRecipients - 1 do
 606                AddRecipient(Envelopes[i].GetRecipient(k));
 607          end;
 608       end;
 609    end;
 610 end;
 611
 612
 613 end.