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(MainServerConfig.BindAddress);
 336       TCP.Connect(MXList.Strings[0], RelayServerPort);
 337       TCP.SetSockTimeOut(DEF_SOCK_TIMEOUT);
 338       i:= 1;
 339       while (not TCP.Connected) and (i < MXList.Count) do begin
 340          TCP.Connect(MXList.Strings[i], RelayServerPort);
 341          Inc(i);
 342       end;
 343       Result:= TCP.Connected;
 344    end
 345    else Result:= false;
 346    MXList.Free;
 347    FTransactionComplete:= false;
 348 end;
 349
 350 function TRelayer.Greet: boolean;
 351 { This function reads and checks the relay server's greeting.
 352   Then identifies this server with an EHLO.
 353   Then, if necessary, authenticates at the connected relay server.
 354   The function returns true, if the authentication and the EHLO command were
 355   successful. }
 356 var
 357    i: integer;
 358    Authenticated: boolean;
 359    StringStream: TStringStream;
 360    Base64EncodingStream: TBase64EncodingStream;
 361    Line: string;
 362
 363 begin
 364    Response.Clear;
 365    AdministerMassFailure(Result);
 366    TCP.ReadResponse(Response);
 367
 368    { Expect 2xx reply. }
 369    if (Response.GetNumericCode div 100) = 2 then begin
 370
 371       TCP.SendCommand(SMTP_C_EHLO, MainServerConfig.Name);
 372       TCP.ReadResponse(Response);
 373
 374       if Response.GetNumericCode = SMTP_R_OK then begin
 375          for i:= 1 to Response.Count - 1 do begin
 376             Line:= UpperCase(Response.GetLine(i));
 377             if pos('PIPELINING', Line) = 1 then
 378                SMTPExtensions.Pipelining:= true
 379             else if pos('SIZE', Line) = 1 then
 380                SMTPExtensions.Size:= true
 381             else if pos('8BITMIME', Line) = 1 then
 382                SMTPExtensions.EbitMIME:= true;
 383          end;
 384          Result:= true;
 385       end
 386       else if (Response.GetNumericCode >= 500) and (Response.GetNumericCode <= 504) then begin
 387          { It seems the remote site did not understand our EHLO, that is,
 388            let's admit, quite odd in the 21st century...
 389            Whatever, let's fall back to RFC 821 then. }
 390          TCP.SendCommand(SMTP_C_HELO, MainServerConfig.Name);
 391          TCP.ReadResponse(Response);
 392          Result:= Response.GetNumericCode = SMTP_R_OK;
 393       end;
 394
 395       if Result then begin
 396          if FRoutingTarget.Auth then begin
 397             TCP.SendCommand(SMTP_C_AUTH, 'LOGIN');
 398             TCP.ReadResponse(Response);
 399             if Response.GetNumericCode = SMTP_R_AUTH_MESSAGE then begin
 400                StringStream:= TStringStream.Create('');
 401                Base64EncodingStream:= TBase64EncodingStream.Create(StringStream);
 402                Base64EncodingStream.Write(PChar(FRoutingTarget.Username)^, Length(FRoutingTarget.Username));
 403                Base64EncodingStream.Destroy;
 404                TCP.WriteLn(StringStream.DataString);
 405                StringStream.Destroy;
 406                TCP.ReadResponse(Response);
 407                if Response.GetNumericCode = SMTP_R_AUTH_MESSAGE then begin
 408                   StringStream:= TStringStream.Create('');
 409                   Base64EncodingStream:= TBase64EncodingStream.Create(StringStream);
 410                   Base64EncodingStream.Write(PChar(FRoutingTarget.Password)^, Length(FRoutingTarget.Password));
 411                   Base64EncodingStream.Destroy;
 412                   TCP.WriteLn(StringStream.DataString);
 413                   StringStream.Destroy;
 414                   TCP.ReadResponse(Response);
 415                   Authenticated:= Response.GetNumericCode = SMTP_R_AUTH_SUCCESSFUL;
 416                end
 417                else Authenticated:= false;
 418             end
 419             else Authenticated:= false;
 420          end
 421          else Authenticated:= true;
 422
 423          if not Authenticated then AdministerMassFailure(Result);
 424       end
 425       else AdministerMassFailure(Result);
 426
 427    end
 428    else AdministerMassFailure(Result);
 429 end;
 430
 431 function TRelayer.SendEnvelope: boolean;
 432 { Sends the envelope (that is the return-path and the recipient addresses).
 433   The function returns true, if the MAIL command were successful, and the
 434   relay server has accepted at least one of the recipient addresses.
 435   This function returns false if a null reply is read, which is considered
 436   as protocol violation.
 437   This function is aware of the SMTP extension, named PIPELINING. If it's
 438   supported by the server, we send RCPT commands stuffed, without waiting
 439   for a response. After all RCPTs are sent, we check all responses. }
 440 var
 441    i, c: integer; UltimateFail: boolean; Prms: string;
 442
 443    procedure ProcessRCPTResponse;
 444    begin
 445       TCP.ReadResponse(Response);
 446       { If we get an "OK" reply code, we increase the count of successful
 447         recipients. }
 448       if Response.GetNumericCode = SMTP_R_OK then Inc(c)
 449       { Response code 0 is non-existent in the SMTP protocol.
 450         If we receive something we _perceive_ as 0, then it is likely
 451         that something seriously went wrong. MgSMTP shouldn't treat
 452         this condition as permanent. }
 453       else if Response.GetNumericCode = 0 then UltimateFail:= true;
 454       Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
 455    end;
 456
 457 begin
 458    { The MAIL command is considered the beginning of the transaction. }
 459    FTransactionComplete:= false;
 460    UltimateFail:= false;
 461    Response.Clear;
 462    Prms:= 'FROM:<' + Envelope.ReturnPath + '>';
 463
 464    if SMTPExtensions.Size then
 465       Prms:= Prms + ' SIZE=' + IntToStr(EMailProperties.Size);
 466    if SMTPExtensions.EbitMIME and EMailProperties.HasFlag(EF_8BITMIME) then
 467       Prms:= Prms + ' BODY=8BITMIME';
 468
 469    TCP.SendCommand(SMTP_C_MAIL, Prms);
 470    TCP.ReadResponse(Response);
 471    if Response.GetNumericCode = SMTP_R_OK then begin
 472       c:= 0;
 473       for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 474          TCP.SendCommand(SMTP_C_RCPT, 'TO:<' + Envelope.GetRecipient(i).Address + '>');
 475          { If pipelining is not supported, read the responses now. }
 476          if not SMTPExtensions.Pipelining then ProcessRCPTResponse;
 477       end;
 478
 479       { If pipelining is supported, process all responses. }
 480       if SMTPExtensions.Pipelining then
 481          for i:= 0 to Envelope.GetNumberOfRecipients - 1 do
 482             ProcessRCPTResponse;
 483
 484       Result:= (c <> 0) and (not UltimateFail);
 485
 486       { If there are no accepted recipients, and no protocol failure is
 487         discovered, we can't send the DATA command, and practically we
 488         can do nothing more for this transaction. Therefore it is
 489         considered complete by protocol. }
 490       FTransactionComplete:= (c = 0) and (not UltimateFail);
 491
 492       if not Result then begin
 493          { Either way, try to reset SMTP state in case of failure. }
 494          TCP.SendCommand(SMTP_C_RSET);
 495          TCP.ReadResponse(Response);
 496       end;
 497    end
 498    else AdministerMassFailure(Result);
 499 end;
 500
 501 function TRelayer.PrepareSendMessage;
 502 { Prepares mail transmission with the DATA command. }
 503 begin
 504    TCP.SendCommand(SMTP_C_DATA);
 505    TCP.ReadResponse(Response);
 506    Result:= Response.GetNumericCode = SMTP_R_START_MAIL_INPUT;
 507 end;
 508
 509 function TRelayer.DeliverMessagePart(Chunk: TStrings): boolean;
 510 { Sends a chunk of the message. }
 511 var i: integer;
 512 begin
 513    { Check for lines starting with dots. }
 514    for i:= 0 to Chunk.Count - 1 do
 515       if (Length(Chunk.Strings[i]) > 0) and (Chunk.Strings[i][1] = '.') then
 516          Chunk.Strings[i]:= '.' + Chunk.Strings[i];
 517
 518    { Send text. }
 519    Result:= TCP.WriteBuffer(PChar(Chunk.Text), Length(Chunk.Text)) <> -1;
 520 end;
 521
 522 procedure TRelayer.FinishDeliverMessage;
 523 { Finishes the message with a line containing a single dot. }
 524 var i: integer;
 525 begin
 526    TCP.WriteLn('.');
 527    TCP.ReadResponse(Response);
 528
 529    { Mark the transaction complete, if we have a valid response. }
 530    FTransactionComplete:= Response.GetNumericCode <> 0;
 531
 532    for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 533       { Set status code for recipients those were accepted in the envelope stage: }
 534       if Envelope.GetRecipient(i).Data = SMTP_R_OK then
 535          Envelope.SetRecipientData(i, Response.GetNumericCode, Response.ReplyText.Text);
 536    end;
 537 end;
 538
 539 procedure TRelayer.CloseConnection;
 540 begin
 541    TCP.SendCommand(SMTP_C_QUIT);
 542    {TCP.ReadResponse(Response);}
 543    TCP.Free;
 544 end;
 545
 546
 547 function TRelayManager.CreateRelayer(Envelope: TEnvelope; EMailProperties: TEMailProperties): TRelayer;
 548 begin
 549    Result:= TRelayer.Create(RoutingTable, Envelope, EMailProperties);
 550 end;
 551
 552 function TRelayManager.IsOnRelayToList(HostName: string): boolean;
 553 begin
 554    Result:= RelayToList.IndexOf(HostName) <> -1;
 555 end;
 556
 557 function TRelayManager.IsOnNoRelayToList(HostName: string): boolean;
 558 begin
 559    Result:= NoRelayToList.IndexOf(HostName) <> -1;
 560 end;
 561
 562 function TRelayManager.OrganizeEnvelopes(Envelopes: TEnvelopeArray): TEnvelopeArray;
 563 { Organizes the given envelopes for relaying.
 564   This function assumes that input envelopes are containing recipient
 565   addresses orientating to the same site.
 566   If it turns out that e-mails for multiple sites must be actually relayed
 567   through the same relay server, this function merges the envelopes for
 568   those sites; so later, such e-mails will be transmitted though a single
 569   connection.
 570
 571   For example, the configuration file indicates:
 572   - E-mails for "foo.com" must be relayed through "myrelaysmtp".
 573   - E-mails for "bar.com" must be also relayed through "myrelaysmtp".
 574   In this case, the envelopes for "foo.com" and "bar.com" will be merged,
 575   and the e-mail for these sites will be transmitted in one TCP connection. }
 576
 577 var i, j, k: integer; f: boolean; Recipient: TRecipient; OrgHost, TrgHost: string;
 578 begin
 579    SetLength(Result, 0);
 580    for i:= 0 to Length(Envelopes) - 1 do begin
 581       if Envelopes[i].GetNumberOfRecipients > 0 then begin
 582          Recipient:= Envelopes[i].GetRecipient(0);
 583          OrgHost:= EMailHost(Recipient.Address);
 584          TrgHost:= RoutingTable.ReRoute(OrgHost);
 585          if TrgHost = '!' then TrgHost:= OrgHost;
 586          j:= 0; f:= false;
 587          while (j < Length(Result)) and (not f) do begin
 588             f:= Result[j].RelayHost = TrgHost;
 589             Inc(j);
 590          end;
 591          { Note, if (not f) then j holds Length(Result). }
 592          if not f then begin
 593             SetLength(Result, j + 1);
 594             Result[j]:= TEnvelope.Create;
 595             Result[j].ReturnPath:= Envelopes[i].ReturnPath;
 596             Result[j].RelayHost:= TrgHost;
 597          end
 598          else Dec(j); { j must be decremented, because we over-incremented it in the loop. }
 599          with Result[j] do begin
 600             { Add first recipient to the envelope. }
 601             AddRecipient(Recipient);
 602             { Add the remaining recipients. }
 603             for k:= 1 to Envelopes[i].GetNumberOfRecipients - 1 do
 604                AddRecipient(Envelopes[i].GetRecipient(k));
 605          end;
 606       end;
 607    end;
 608 end;
 609
 610
 611 end.