Email服务器

开发平台：
Delphi

MailRouting.pas：源码内容
							unit MailRouting;
(******************************************************************************)
(*                                                                            *)
(* SMTP Mail Routing Utilities                                                *)
(* Part of Hermes SMTP/POP3 Server.                                           *)
(* Copyright(C) 2000 by Alexander J. Fanti, All Rights Reserver Worldwide.    *)
(*                                                                            *)
(* Contains: TSmtpMessageInformation, TListServer, TDeliverMail               *)
(*                                                                            *)
(* Created January 18, 2000 by Alexander J. Fanti.  See License.txt           *)
(*                                                                            *)
(* Depends on: DataU1 (TMailListInformation, routing)                         *)
(*             Main   (Posts a Windows Message to the form to tell it we need *)
(*                     some queue processing)                                 *)
(*             UtilU1 (Address (e-mail) formatting)                           *)
(*                                                                            *)
(* Used by: SmtpServer                                                        *)
(*                                                                            *)
(* Description:                                                               *)
(* TSmtpMessageInformation - An object used to manipulate a message coming in *)
(*                           from an SMTP connection to the Smtp Server.  We  *)
(*                           can manage the forward and reverse paths and     *)
(*                           mail data with it.                               *)
(* TListServer - An object used to examine mail to a list to determine if it  *)
(*               should be distributed to the list, or interpreted as a       *)
(*               command.  All commands are in the mail subject and preceeded *)
(*               by a bang(!).  The command must then follow with any         *)
(*               arguments.  The mail body is ignored.                        *)
(* TDeliverMail - An object used to examine the To Routes of a mail message   *)
(*                and deliver the mail in the following way: 1) convert       *)
(*                alias to user, 2) Check user has forward (if so, rename to) *)
(*                3) If user local, deliver and drop to, 4) if user is list,  *)
(*                send to TListServer for further processing, 5) if user is   *)
(*                non-local, queue for agent processing.                      *)
(*                                                                            *)
(* Revisions: 1/19/2000  AJF  Added TDeliverMail, debugged and commented      *)
(*            2/13/2000  AJF  Added AccessControl data to                     *)
(*                            TSmtpMessageInformation to facilitate Smtp      *)
(*                            Server Access control                           *)
(*                                                                            *)
(******************************************************************************)
interface
uses Windows, Classes, SysUtils, INIFiles,
     DataU1;
type
  TSmtpMessageInformation = class(TObject)
  private
    FReverseRoute : TMessageRouteInformation;
    FForwardRoute : TList;
    FData : TStringList;
    function GetForwardRouteCount : Longint;
    function GetForwardRoute(Index : Longint) : TMessageRouteInformation;
    function GetHeaderElement(Element : String) : String;
    procedure SetHeaderElement(Element, Value : String);
    function GetAddress(MailRoute : String) : String;
    function GetRoute(MailAddress : String) : String;
  public
    // AccCtrl variables are used store information about the sender by the
    // Smtp Server Connection about the transaction as the message comes in
    AccCtrl_ToLocalUser        : Boolean;  // True if RCPT TO is to local domain
                                           // and mailbox (user, alias, list)
    AccCtrl_ToLocalCount       : Longint;  // Count of RCPT TOs that are to a
                                           // local user
    AccCtrl_FromLocalUser      : Boolean;  // MAIL FROM is a local user at a
                                           // local domain
    AccCtrl_FromLocalDomain    : Boolean;  // MAIL FROM is just from local
                                           // domain
    AccCtrl_FromAcceptedDomain : Boolean;  // MAIL FROM is from an Accepted
                                           // domain
    AccCtrl_FromBannedDomain   : Boolean;  // MAIL FROM is from a Banned domain
    AccCtrl_FromBannedMailbox  : Boolean;  // MAIL FROM is from a Banned Mailbox
    AccCtrl_MessgaeSizeInBytes : Longint;  // Size of message
    constructor Create;
    destructor Destroy; Override;
    procedure Initialize;
    procedure InsertReceived;
    procedure AddSelfToReverseRoute;
    procedure Data_AppendLine(Line : String);
    property ReverseRoute : TMessageRouteInformation
             read FReverseRoute write FReverseRoute;
    property ForwardRoute[Index : Longint] : TMessageRouteInformation
             read GetForwardRoute;
    property ForwardRouteCount : Longint read GetForwardRouteCount;
    function AddForwardRoute(Route : String) : Boolean;
    procedure DeleteForwardRoute(Index : Longint);
    procedure ClearForwardRoutes;
    property Data : TStringList read FData;
    function SaveToFile : Boolean; // Header in ###.ini, data in ###.txt
    function LoadFromFile(MailID : String) : Boolean;
    function GetHeader_Subject : String;
    procedure SetHeader_Subject(Subject : String);
    procedure GetHeader_From(var Address : String; var Route : String);
    procedure SetHeader_From(EMailAddress : String);
    procedure GetHeader_To(var Address : String; var Route : String);
    procedure SetHeader_To(EMailAddress : String);
    procedure GetHeader_ReplyTo(var Address : String; var Route : String);
    procedure SetHeader_ReplyTo(EMailAddress : String);
  end;
  // Terminology Definition for this module.
  // Address (ListAddress) refers to a user style email address
  //                       such as username@domain.com
  // Route (ListRoute) refers to a SMTP style email address
  //                   such as <"username"@[IPAddress]|domain.com>
  TListServer_StatusUpdate = procedure(Sender : TObject; Status : String;
                                       Level : Integer) of Object;
  TListServer = class(TObject)
  private
    FListName, FListAddress, FListRoute : String;
    FMailList : TMailListInformation;
    FMessageInfo : TSmtpMessageInformation;
    FSenderAddress, FFromAddress : String;  // email of sender (no <>)
    FFromRoute : String;
    FOnStatusUpdate : TListServer_StatusUpdate; // Event Ptr for StatusUpdate
    procedure StatusUpdate(Status : String; Level : Integer); // Report Status
    procedure ParseSubject(Subject : String; var Command : String;
                           var Parameter : String);
    procedure BuildMessageToUser(MessageType, SenderAddress,
                                 FailureMessage : String;
                                 MagicNumber : Longint;
                                 ExpirationDate : TDateTime);
    procedure AddMessageToArchive;
  public
    constructor Create(ListName, ReversePath : String; Data : TStringList);
    destructor Destroy; Override;
    procedure Process;
    property OnStatusUpdate : TListServer_StatusUpdate    // Fired on Status
             read FOnStatusUpdate write FOnStatusUpdate;  // Update
  end;
  TDeliverMail_StatusUpdate = procedure(Sender : TObject; Status : String;
                                        Level : Integer) of Object;
  TDeliverMail = class(TObject)
  private
    FMessageInfo : TSmtpMessageInformation;
    FOnStatusUpdate : TDeliverMail_StatusUpdate; // Event Ptr for StatusUpdate
    procedure StatusUpdate(Status : String; Level : Integer); // Report Status
    procedure ProcessAlias(var UserName : String; Domain : String);
    procedure DeliverLocally(UserInfo : TPop3UserInformation);
    procedure SendUndeliverableReply(DestinationPath : String);
  public
    constructor Create(MessageInfo : TSmtpMessageInformation);
    destructor Destroy; Override;
    procedure Deliver;
    property OnStatusUpdate : TDeliverMail_StatusUpdate   // Fired on Status
             read FOnStatusUpdate write FOnStatusUpdate;  // Update
  end;
implementation
uses Main, {This is so we can call a "Trigger" of the
            Smtp Agent Queue to get service.}
     UtilU1;
(******************************************************************************)
(*                                                                            *)
(* START Message Information Object                                           *)
(*                                                                            *)
(* This object is used for receiving and manipulating a message.              *)
(* We accept data to it, set the Reverse-Path and add Forward-Paths.          *)
(* We can also iterate throught the Forward-Paths and manipulate them or      *)
(* remove them as we achieve delivery to each one.  Then we save the          *)
(* message, qeueing it for processing with the Smtp Agent.                    *)
(*                                                                            *)
(******************************************************************************)
constructor TSmtpMessageInformation.Create;
begin
  inherited Create;
  FReverseRoute := TMessageRouteInformation.Create(mrte_From);
  FForwardRoute := TList.Create;
  FData := TStringList.Create;
  Initialize;
end;
procedure TSmtpMessageInformation.ClearForwardRoutes;
var
  x : Longint;
  RouteInfo : TMessageRouteInformation;
begin
  for x := FForwardRoute.Count -1 downto 0 do begin
    RouteInfo := FForwardRoute[x];
    FForwardRoute.Delete(x);  // Remove from Forward-Path List
    RouteInfo.Free;           // Drop Forward-Path Object
  end;
end;
destructor TSmtpMessageInformation.Destroy;
begin
  FReverseRoute.Free;  // Drop Reverse-Path Object
  ClearForwardRoutes;  // Drop each Forward-Path Object
  FForwardRoute.Free;  // Drop Forward-Path List
  FData.Free;          // Drop message data
  inherited Destroy;
end;
procedure TSmtpMessageInformation.AddSelfToReverseRoute;
begin
  // if the most recent Host in the Reverse Route isn't one of mine,
  // then I add my ServerName to the start of the Hosts list of the
  // Reverse-Path
  if not INI.Domain_IsThisOneOfMine(FReverseRoute.Hosts[0]) then
    FReverseRoute.Hosts.Insert(0, INI.ServerName);
end;
function TSmtpMessageInformation.GetForwardRouteCount : Longint;
begin
  Result := FForwardRoute.Count;
end;
function TSmtpMessageInformation.GetForwardRoute(Index : Longint)
         : TMessageRouteInformation;
begin
  Result := nil;
  if (Index >= 0) and (Index < FForwardRoute.Count) then
    Result := FForwardRoute[Index];
end;
procedure TSmtpMessageInformation.Initialize;
begin
  ClearForwardRoutes;        // Drop each Forward-Path Object
  FReverseRoute.Initialize;  // Clear the Reverse-Path Object
  FData.Clear;               // Clear the message data
  AccCtrl_ToLocalUser        := False;
  AccCtrl_ToLocalCount       := 0;
  AccCtrl_FromLocalUser      := False;
  AccCtrl_FromLocalDomain    := False;
  AccCtrl_FromAcceptedDomain := False;
  AccCtrl_FromBannedDomain   := False;
  AccCtrl_FromBannedMailbox  := False;
  AccCtrl_MessgaeSizeInBytes := 0;
end;
procedure TSmtpMessageInformation.InsertReceived;
var
  FromHost : String;
begin
  // Here I insert a line into the top of the message data (presumably
  // the message header).  This line contains "Received" information
  // in the format:
  // Received: FROM [host] BY [ServerName] ; DD Mon YY HH:MM:SS Zone
  //
  // This should happen only once for any message, when it's received.
  //
  if FReverseRoute.Hosts.Count > 0 then FromHost := FReverseRoute.Hosts[0]
    else FromHost := FReverseRoute.Domain;
  FData.Insert(0, 'Received: FROM ' + FromHost + ' BY ' + INI.ServerName +
                  ' ; ' + INI.TimeStamp);
end;
procedure TSmtpMessageInformation.Data_AppendLine(Line : String);
begin
  FData.Add(Line);  // Add this line to the end of the message data
end;
function TSmtpMessageInformation.AddForwardRoute(Route : String) : Boolean;
var
  RouteInfo : TMessageRouteInformation;
  x : Longint;
begin
  // Given a string that specifies a route in the Smtp format
  // <@HostA,@[#.#.#.#]:"mailbox"@HostC>
  // Create a Forward-Path route and add it to the List of ForwardPaths
  //
  RouteInfo := TMessageRouteInformation.Create(mrte_To);
  x := RouteInfo.ParseRoute(Route);
  if x = 0 then begin
    // If I successfullt parsed the route...
    // Remove my domain(s) from top of the to route... it's reached me
    while (RouteInfo.Hosts.Count > 0) and
          (INI.Domain_IsThisOneOfMine(RouteInfo.Hosts[0])) do
      RouteInfo.Hosts.Delete(0);
    // Now add this route to the list of Forward Paths
    FForwardRoute.Add(RouteInfo);
    Result := True;
  end else begin
    // I did not successfully parse the route, so I need to free the route
    // object instead of adding it to the list
    RouteInfo.Free;
    Result := False;
  end;
end;
procedure TSmtpMessageInformation.DeleteForwardRoute(Index : Longint);
var
  RouteInfo : TMessageRouteInformation;
begin
  if (Index >= 0) and (Index < FForwardRoute.Count) then begin
    RouteInfo := FForwardRoute[Index];
    FForwardRoute.Delete(Index);  // Remove from Forward-Path List
    RouteInfo.Free;               // Drop Forward-Path Object
  end;
end;
function TSmtpMessageInformation.LoadFromFile(MailID : String) : Boolean;
var
  SL : TStringList;
  x, y : Longint;
  tempStr : String;
  RouteInfo : TMessageRouteInformation;
  Found : Boolean;
begin
  Result := False;
  if FileExists(INI.MailQueuePath + MailID + '.txt') then begin
    Self.Initialize;
    SL := TStringList.Create;
    SL.LoadFromFile(INI.MailQueuePath + MailID + '.txt');
    if SL.Count > 0 then begin
      // Read Reverse Path...
      Found := False;
      x := 0;
      while (x < SL.Count) and (not Found) do begin
        tempStr := Trim(SL[x]);
        if  UpperCase(tempStr) = '[REVERSE PATH]' then begin
          Inc(x);  // Skip the header line...
          // read the From path...
          if x < SL.Count then begin
            tempStr := Trim(SL[x]);
            if UpperCase(Copy(tempStr, 1, 5)) = 'FROM=' then begin
              tempStr := Copy(tempStr, 6, Length(tempStr));
              if tempStr <> '' then FReverseRoute.ParseRoute(tempStr);
            end;
          end;
          Found := True;
        end else Inc(x);
      end;
      // Read Forward Path...
      Found := False;
      x := 0;
      while (x < SL.Count) and (not Found) do begin
        tempStr := Trim(SL[x]);
        if  UpperCase(tempStr) = '[FORWARD PATH]' then begin
          Inc(x);  // Skip the header line...
          // read the To paths...
          if x < SL.Count then begin
            tempStr := Trim(SL[x]);
            while (x < SL.Count) and (Copy(tempStr, 1, 1) <> '[') do begin
              if UpperCase(Copy(tempStr, 1, 3)) = 'TO=' then begin
                tempStr := Copy(tempStr, 4, Length(tempStr));
                if tempStr <> '' then begin
                  RouteInfo := TMessageRouteInformation.Create(mrte_To);
                  y := RouteInfo.ParseRoute(SL[x]);
                  if y = 0 then FForwardRoute.Add(RouteInfo)
                    else RouteInfo.Free;
                end;
              end;
              Inc(x);
              tempStr := Trim(SL[x]);
            end;
          end;
          Found := True;
        end else Inc(x);
      end;
      // We don't need to read the Retry information here...
      // and we don't really... nut I write the code incase it's
      // necessary in the future.  Also note, this object's LoadFromFile
      // and SaveToFile are nearly identicle to it's sister Object
      // SmtpAgentMessageInformation which reads the same info from
      // the same file, but stores it differently for the purposes
      // of the Smtp Agent Object
      // Read Retry Information...
      Found := False;
      x := 0;
      while (x < SL.Count) and (not Found) do begin
        tempStr := Trim(SL[x]);
        if  UpperCase(tempStr) = '[RETRY]' then begin
          Inc(x);  // Skip the header line...
          // read the retry information
          if x < SL.Count then begin
            tempStr := Trim(SL[x]);
            while (x < SL.Count) and (Copy(tempStr, 1, 1) <> '[') do begin
              if UpperCase(Copy(tempStr, 1, 10)) = 'PERFORMED=' then begin
                tempStr := Copy(tempStr, 11, Length(tempStr));
                // := StringToInteger(tempStr, 0);
              end;
              if UpperCase(Copy(tempStr, 1, 10)) = 'REMAINING=' then begin
                tempStr := Copy(tempStr, 11, Length(tempStr));
                // := StringToInteger(tempStr, 0);
              end;
              Inc(x);
              tempStr := Trim(SL[x]);
            end;
          end;
          Found := True;
        end else Inc(x);
      end;
      // Read Mail Data first...
      // We know the [Message] data is the last thing in the file... so...
      Found := False;
      x := 0;
      while (x < SL.Count) and (not Found) do begin
        tempStr := Trim(SL[x]);
        if  UpperCase(tempStr) = '[MESSAGE]' then begin
          Inc(x);  // Skip the header line...
          for y := x to SL.Count -1 do FData.Add(SL[y]);  // Copy data in...
          Found := True;
        end else Inc(x);
      end;
      SL.Free;
      Result := True;
    end;
  end;
end;
function TSmtpMessageInformation.SaveToFile : Boolean;
var
  SL : TStringList;
  FilenameOnly : String;
  x : Longint;
  RouteInfo : TMessageRouteInformation;
begin
  FilenameOnly := GetUniqueFilename(INI.MailQueuePath);
  Result := False;
  SL := TStringList.Create;
  SL.Add('[Reverse Path]');
  SL.Add('From=' + FReverseRoute.BuildRoute);
  SL.Add('');
  SL.Add('[Forward Path]');
  for x := 0 to FForwardRoute.Count -1 do begin
    RouteInfo := FForwardRoute[x];
    SL.Add('To=' + RouteInfo.BuildRoute);
  end;
  SL.Add('');
  SL.Add('[Retry]');
  SL.Add('Performed=' + IntToStr(0));
  SL.Add('Remaining=' + IntToStr(INI.Smtp_Retries));
  SL.Add('');
  // Message data must always be last in file!
  SL.Add('[Message]');
  for x := 0 to FData.Count -1 do SL.Add(FData[x]);
  try
    SL.SaveToFile(INI.MailQueuePath + FilenameOnly + '.txt');
    Result := True;
  except
    on E: Exception do Result := False;
  end;
  SL.Free;
end;
function TSmtpMessageInformation.GetHeaderElement(Element : String) : String;
// Assumes : seperates Element and Value and we don't specify colon
var
  x, Len : Longint;
  Found : Boolean;
begin
  Result := '';
  Len := Length(Element);
  x := 0;
  Found := False;
  // Loop through data until we either 1) find out element,
  //                                   2) run out of data, or
  //                                   3) finish the header
  while (not Found) and (x < FData.Count) and (FData[x] <> '') do begin
    // I'll match an element regardless of case...
    if LowerCase(Copy(Data[x], 1, Len +1)) = LowerCase(Element + ':') then begin
      Result := Trim(Copy(Data[x], Len +2, Length(FData[x])));
      Found := True;
    end else Inc(x);
  end;
end;
procedure TSmtpMessageInformation.SetHeaderElement(Element, Value : String);
// Assumes : seperates Element and Value and we don't specify colon
var
  x, Len : Longint;
  Found : Boolean;
begin
  Len := Length(Element);
  x := 0;
  Found := False;
  // Loop through data until we either 1) find out element,
  //                                   2) run out of data, or
  //                                   3) finish the header
  while (not Found) and (x < FData.Count) and (FData[x] <> '') do begin
    // Should I be case insensitive here?
    if LowerCase(Copy(Data[x], 1, Len +1)) = LowerCase(Element + ':') then begin
      // We found the element and must add the value
      // to the name after the ": "
      FData[x] := Copy(Data[x], 1, Len) + ': ' + Value;
      Found := True;
    end else Inc(x);
  end;
  if not Found then begin
    // we did not find the element.  we must add it to the header
    FData.Insert(x, Element + ': ' + Value);
  end;
end;
function TSmtpMessageInformation.GetHeader_Subject : String;
begin
  Result := GetHeaderElement('Subject');
end;
procedure TSmtpMessageInformation.SetHeader_Subject(Subject : String);
begin
  SetHeaderElement('Subject', Subject);
end;
function TSmtpMessageInformation.GetAddress(MailRoute : String) : String;
var
  Route : TMessageRouteInformation;
begin
  // Format a route or address string as an address
  Result := MailRoute;
  Route := TMessageRouteInformation.Create(mrte_Unknown);
  if Route.ParseRoute(MailRoute) = 0 then
    Result := Route.MailBox + '@' + Route.Domain;
  Route.Free;
end;
function TSmtpMessageInformation.GetRoute(MailAddress : String) : String;
var
  Route : TMessageRouteInformation;
begin
  // Format a route or address string as a route
  Result := MailAddress;
  Route := TMessageRouteInformation.Create(mrte_Unknown);
  if Route.ParseRoute(MailAddress) = 0 then
    Result := Route.BuildRoute;
  Route.Free;
end;
procedure TSmtpMessageInformation.GetHeader_From(var Address : String;
                                                 var Route : String);
var
  tempStr : String;
begin
  tempStr := GetHeaderElement('From');
  Address := GetAddress(tempStr);
  Route := GetRoute(tempStr);
end;
procedure TSmtpMessageInformation.SetHeader_From(EMailAddress : String);
begin
  SetHeaderElement('From', GetRoute(EMailAddress));
end;
procedure TSmtpMessageInformation.GetHeader_To(var Address : String;
                                               var Route : String);
var
  tempStr : String;
begin
  tempStr := GetHeaderElement('To');
  Address := GetAddress(tempStr);
  Route := GetRoute(tempStr);
end;
procedure TSmtpMessageInformation.SetHeader_To(EMailAddress : String);
begin
  SetHeaderElement('To', GetRoute(EMailAddress));
end;
procedure TSmtpMessageInformation.GetHeader_ReplyTo(var Address : String;
                                                    var Route : String);
var
  tempStr : String;
begin
  tempStr := GetHeaderElement('Reply-To');
  Address := GetAddress(tempStr);
  Route := GetRoute(tempStr);
end;
procedure TSmtpMessageInformation.SetHeader_ReplyTo(EMailAddress : String);
begin
  SetHeaderElement('Reply-To', GetRoute(EMailAddress));
end;
(******************************************************************************)
(*                                                                            *)
(*  STOP  Message Information Object                                          *)
(*                                                                            *)
(******************************************************************************)
(******************************************************************************)
(*                                                                            *)
(* START ListServer Object                                                    *)
(*                                                                            *)
(* This object is used to process mail addressed to a local list.  It         *)
(* determines if the mail is a command to the list, and acts on that command, *)
(* generally performing an action to the list (sub, unsub, etc.) and sending  *)
(* notification mail back to the original requestor.                          *)
(* If the mail is not a command, it is assumed to be a message for the list,  *)
(* and is re-addressed for delivery to list members.  It is then delivered    *)
(* locally or queued by the Deliver Mail Object                               *)
(*                                                                            *)
(******************************************************************************)
constructor TListServer.Create(ListName, ReversePath : String;
                               Data : TStringList);
var
  x : Longint;
  Member : PMailListMemberInfoRec;
  Route : TMessageRouteInformation;
begin
  inherited Create;
  // Make copy of message to service.
  // we'll have to change forward paths and data for list members
  FMessageInfo := TSmtpMessageInformation.Create;
  FMessageInfo.ReverseRoute.ParseRoute(ReversePath);
  for x := 0 to Data.Count -1 do FMessageInfo.Data_AppendLine(Data[x]);
  // Get List information (name, address and route)
  FListName := ListName;
  FListAddress := FListName + '@' + INI.ServerName;
  Route := TMessageRouteInformation.Create(mrte_Unknown);
  FListRoute := FListAddress;
  if Route.ParseRoute(FListAddress) = 0 then FListRoute := Route.BuildRoute;
  Route.Free;
  // Open mailing list information
  FMailList := TMailListInformation.Create;
  FMailList.LoadFromFile(FListName);
  // Fill To routes of message with list members addresses
  for x := 0 to FMailList.MemberCount -1 do begin
    Member := FMailList.Members[x];
    if Member.Active then FMessageInfo.AddForwardRoute(Member.EMail);
  end;
  // Aquire Sender address and route from routing information
  FSenderAddress := '';
  FSenderAddress := FMessageInfo.ReverseRoute.Mailbox + '@' +
                    FMessageInfo.ReverseRoute.Domain;
  FFromAddress := '';
  FFromRoute := '';
  FMessageInfo.GetHeader_From(FFromAddress, FFromRoute);
  // Don't call Process here... then we couldn't set statusupdate first
end;
destructor TListServer.Destroy;
begin
  FMessageInfo.Free;
  FMailList.Free;
  inherited Destroy;
end;
procedure TListServer.StatusUpdate(Status : String; Level : Integer);
begin
  if Assigned(FOnStatusUpdate) then OnStatusUpdate(Self, Status, Level);
end;
procedure TListServer.AddMessageToArchive;
var
  F : TextFile;
  x : Longint;
begin
  if (FMailList.ArchiveFile <> '') and (FMessageInfo.Data.Count > 0) then begin
    AssignFile(F, FMailList.ArchiveFile);
    try
      Append(F);
      for x := 0 to FMessageInfo.Data.Count -1 do
        Writeln(F, FMessageInfo.Data[x]);
      Writeln(F, '(------------------)');
    except
      on E: Exception do try
        ReWrite(F);
        for x := 0 to FMessageInfo.Data.Count -1 do
          Writeln(F, FMessageInfo.Data[x]);
        Writeln(F, '(------------------)');
      except
        on E: Exception do begin end;
      end;
    end;
    CloseFile(F);
  end;
end;
procedure TListServer.Process;
var
  x : Longint;
  Command, Parameter : String;
  MailToProcess : Boolean; // True if there is mail that must be routed after
                           // we do our list server thing
  MailForList : Boolean;   // True if the mail we processed here goes to the
                           // list instead of a single list member
  UserAddress : String;    // This is the address to send list server replies.
                           // It's chosen by parameter to command, then from,
                           // then reversepath.
  MagicNumber : Integer;   // A random number that's a subscriber's "ID"
  ExpirationDate : TDateTime;  // Date and time when MagicNumber becomes invalid
  Deleted : Boolean;           // Have we removed a list member?
  Accept : Boolean;
  PendingMember : PMailListPendingMemberInfoRec;
  Member : PMailListMemberInfoRec;
  DeliverMail : TDeliverMail;
  Route : TMessageRouteInformation;
begin
  StatusUpdate('Processing Mail for List', STAT_PROCESSINGEVENT);
  ParseSubject(FMessageInfo.GetHeader_Subject, Command, Parameter);
  if Command <> '' then begin
    MailToProcess := False;
    MailForList := False;
    StatusUpdate('Command: ' + Command + ' (' + Parameter + ')',
                 STAT_PROCESSINGEVENT);
    // All commands require an action to the list, and
    // A message sent back to the sender... UserAddress
    // UserAddress is the following... Parameter (if supplied and is address),
    //                                 From Address, From Route Address.
    UserAddress := Parameter;
    if UserAddress = '' then UserAddress := FFromAddress;
    if UserAddress = '' then UserAddress := FSenderAddress;
    Route := TMessageRouteInformation.Create(mrte_From);
    if Route.ParseRoute(UserAddress) = 0 then begin
      if Command = 'SUBSCRIBE' then begin  // I wanna subscribe
        UserAddress := Parameter;
        if UserAddress = '' then UserAddress := FFromAddress;
        if UserAddress = '' then UserAddress := FSenderAddress;
        if UserAddress <> '' then begin
          if FMailList.LB_AllowPublicSubscription then begin
            // Add to Pending Member List
            MagicNumber := FMailList.PendingMember_NewMagicNumber;
            ExpirationDate := Now + 1;
            FMailList.PendingMemberAdd(ExpirationDate, MagicNumber,
                                       UserAddress);
            if FMailList.SaveToFile(FListName, False) then begin
              StatusUpdate('Accepted, Needs confirmation. ' +
                           'Notification sent.', STAT_PROCESSINGEVENT);
              BuildMessageToUser('Subscribe Success', UserAddress,
                                 'FM', MagicNumber, ExpirationDate);
              MailToProcess := True;
           end else begin
              StatusUpdate('List not accessible at this time. ' +
                           'Notification sent.', STAT_PROCESSINGERROR);
              BuildMessageToUser('Subscribe Failure', UserAddress,
                                 'List temporarily inaccessible',
                                 MagicNumber, ExpirationDate);
              MailToProcess := True;
            end;
          end else begin
            StatusUpdate('List not open to public subscription. ' +
                         'Notification sent.', STAT_PROCESSINGERROR);
            BuildMessageToUser('Subscribe Failure', UserAddress,
                               'List is closed to public subscription',
                               MagicNumber, ExpirationDate);
            MailToProcess := True;
          end;
        end else begin
          StatusUpdate('No EMail address supplied. ' +
                       'Notification cannot be sent.', STAT_PROCESSINGERROR);
        end;
      end;
    end;
    Route.Free;
    if Command = 'CONFIRM SUBSCRIBE' then begin  // they confirm sub
      UserAddress := '';
      if UserAddress = '' then UserAddress := FFromAddress;
      if UserAddress = '' then UserAddress := FSenderAddress;
      if UserAddress <> '' then begin
        try  // read magic number
          MagicNumber := StrToInt(Parameter);
        except
          on E: Exception do MagicNumber := -1;
        end;
        if MagicNumber > -1 then begin
          // Find Pending member by magic number
          PendingMember
          := FMailList.PendingMember_FindByMagicNumber(MagicNumber);
          if PendingMember <> nil then begin
            if PendingMember.ExpirationDate >= Now then begin
              // email match?  do I need to check this?  Should I?
              if LowerCase(PendingMember.EMail) =
                 LowerCase(UserAddress) then begin
                // Add to Members list
                FMailList.MemberAdd(True, False, PendingMember.EMail);
                if FMailList.SaveToFile(FListName, False) then begin
                  FMailList.PendingMemberDelete(PendingMember);
                  FMailList.SaveToFile(FListName, False);
                  // they're now on the list...
                  StatusUpdate('Subscribed. ' + 'Notification sent.',
                               STAT_PROCESSINGEVENT);
                  BuildMessageToUser('Subscribe Confirm Success',
                                     PendingMember.EMail,
                                     'FM', MagicNumber, ExpirationDate);
                  MailToProcess := True;
                end else begin
                  StatusUpdate('List not accessible at this time. ' +
                               'Notification sent.', STAT_PROCESSINGERROR);
                  BuildMessageToUser('Subscribe Confirm Failure',
                                     UserAddress, 'Unable to Subscribe - ' +
                                     'List temporarily inaccessible',
                                     MagicNumber, ExpirationDate);
                  MailToProcess := True;
                end;
              end else begin
                StatusUpdate('The sender''s email address does not match! ' +
                             'Notification sent.', STAT_PROCESSINGERROR);
                BuildMessageToUser('Subscribe Confirm Failure',
                                   UserAddress, 'Your address (' +
                                   UserAddress + ') does ' +
                                   'not match the pending member''s address.',
                                   MagicNumber, ExpirationDate);
                MailToProcess := True;
              end;
            end else begin
              StatusUpdate('Subscriber ID has expired. ' +
                           'Notification sent.', STAT_PROCESSINGERROR);
              BuildMessageToUser('Subscribe Confirm Failure',
                                 UserAddress,
                                 'Your Subscriber ID number has expired',
                                 MagicNumber, ExpirationDate);
              MailToProcess := True;
              // Remove expired entry
              FMailList.PendingMemberDelete(PendingMember);
              FMailList.SaveToFile(FListName, False);
            end;
          end else begin
            StatusUpdate('Subscriber ID not found in pending. ' +
                         'Notification sent.', STAT_PROCESSINGERROR);
            BuildMessageToUser('Subscribe Confirm Failure', UserAddress,
                               'I couldn''t find your Subscriber ID number ('
                               + IntToStr(MagicNumber) + ')',
                               MagicNumber, ExpirationDate);
            MailToProcess := True;
          end;
        end else begin
          StatusUpdate('Subscriber ID missing. ' +
                       'Notification sent.', STAT_PROCESSINGERROR);
          BuildMessageToUser('Subscribe Confirm Failure',
                             UserAddress,
                             'You didn''t supply a subscriber ID number',
                             MagicNumber, ExpirationDate);
          MailToProcess := True;
        end;
      end else begin
        StatusUpdate('No EMail address supplied. ' +
                     'Notification cannot be sent.', STAT_PROCESSINGERROR);
      end;
    end else
    if Command = 'UNSUBSCRIBE' then begin
      // remove me from this list
      UserAddress := ''; // Parameter;  NO Address parameter in unsubscribe...
      if UserAddress = '' then UserAddress := FFromAddress;
      if UserAddress = '' then UserAddress := FSenderAddress;
      if UserAddress <> '' then begin
        Deleted := False;
        for x := FMailList.MemberCount -1 downto 0 do begin
          Member := FMailList.Members[x];
          // Should I be case sensitive here?
          if LowerCase(Member.EMail) = LowerCase(UserAddress) then begin
            FMailList.MemberDelete(x);
            Deleted := True;
          end;
        end;
        if Deleted and FMailList.SaveToFile(FListName, False) then begin
          // Send them the farewell mail
          StatusUpdate('Member removed from list. ' +
                       'Notification sent.', STAT_PROCESSINGEVENT);
          BuildMessageToUser('Unsubscribe Success', UserAddress,
                             'FM', MagicNumber, ExpirationDate);
          MailToProcess := True;
        end else begin
          if not Deleted then begin
            StatusUpdate('Member not deleted. ' +
                         'Notification sent.', STAT_PROCESSINGERROR);
            BuildMessageToUser('Unsubscribe Failure', UserAddress,
                               'Unable to Unsubscribe - ' +
                               'Member not found for delete.',
                               MagicNumber, ExpirationDate);
          end else begin
            StatusUpdate('List not accessible at this time. ' +
                         'Notification sent.', STAT_PROCESSINGERROR);
            BuildMessageToUser('Unsubscribe Failure', UserAddress,
                               'Unable to Unsubscribe - ' +
                               'List temporarily inaccessible',
                               MagicNumber, ExpirationDate);
          end;
          MailToProcess := True;
        end;
      end else begin
        StatusUpdate('No EMail address supplied. ' +
                     'Notification cannot be sent.', STAT_PROCESSINGERROR);
      end;
    end else
    if Command = 'LIST' then begin  // mail me a list of the members of list
      UserAddress := '';
      if UserAddress = '' then UserAddress := FFromAddress;
      if UserAddress = '' then UserAddress := FSenderAddress;
      if UserAddress <> '' then begin
        if FMailList.LB_DoNotReportListMembers then begin
          StatusUpdate('User requested restricted list membership. ' +
                       'Response sent.', STAT_PROCESSINGEVENT);
          BuildMessageToUser('List Failure', UserAddress, 'FM', 0, Now);
          MailToProcess := True;
        end else begin
          StatusUpdate('User requested list membership. ' +
                       'Response sent.', STAT_PROCESSINGEVENT);
          BuildMessageToUser('List Success', UserAddress, 'FM', 0, Now);
          MailToProcess := True;
        end;
      end else begin
        StatusUpdate('No EMail address supplied. ' +
                     'List cannot be sent.', STAT_PROCESSINGERROR);
      end;
    end else
    if Command = 'HELP' then begin  // I want some help!
      UserAddress := '';
      if UserAddress = '' then UserAddress := FFromAddress;
      if UserAddress = '' then UserAddress := FSenderAddress;
      if UserAddress <> '' then begin
        StatusUpdate('User requested "Help". ' +
                     'Response sent.', STAT_PROCESSINGEVENT);
        BuildMessageToUser('Help', UserAddress, 'FM', 0, Now);
        MailToProcess := True;
      end else begin
        StatusUpdate('No EMail address supplied. ' +
                     'Help cannot be sent.', STAT_PROCESSINGERROR);
      end;
    end else
    begin
      // Command unknown... better treat it as a message
      StatusUpdate('List Command unknown... treating as mail to list.',
                   STAT_PROCESSINGERROR);
      MailForList := True;
    end;
  end else MailForList := True;
  if MailForList then begin
    // Can we accept the submission?
    Accept := True;
    UserAddress := '';
    if UserAddress = '' then UserAddress := FFromAddress;
    if UserAddress = '' then UserAddress := FSenderAddress;
    if FMailList.LB_MemberSubmissionOnly then begin
      Accept := False;
      // Is this UserAddress a list member ?
      for x := 0 to FMailList.MemberCount -1 do begin
        Member := FMailList.Members[x];
        if LowerCase(Member.EMail) = LowerCase(UserAddress) then Accept := True;
      end;
    end;
    if Accept then begin
      MailToProcess := False;
      // Edit the Reply-to if "Force replies to the List"
      if FMailList.LB_ForceRepliesToList then begin
        StatusUpdate('Forcing reply to list.', STAT_PROCESSINGEVENT);
        FMessageInfo.SetHeader_ReplyTo(FListRoute);
      end;
      if FMailList.ArchiveFile <> '' then begin
        StatusUpdate('Adding message to List Archive', STAT_PROCESSINGEVENT);
        AddMessageToArchive;
      end;
      // Messages mailed to list members must be returned (on non-deliverable)
      // to somebody in charge of the list... either the list's "MailErrorsTo"
      // or the "listmaster" of the server
      if FMailList.ErrorsMailedTo = '' then
        FMessageInfo.ReverseRoute.ParseRoute('<' + FormatedAddress('listmaster',
                                             INI.ServerName) + '>')
      else
        FMessageInfo.ReverseRoute.ParseRoute('<' + FMailList.ErrorsMailedTo +
                                             '>');
      DeliverMail := TDeliverMail.Create(FMessageInfo);
      DeliverMail.OnStatusUpdate := FOnStatusUpdate;
      DeliverMail.Deliver;
      DeliverMail.Free;
    end else begin
      // we don't allow non-member submission to the list!
      StatusUpdate('User cannot submit to the list. ' +
                   'They are not a member.', STAT_PROCESSINGERROR);
      BuildMessageToUser('Submission Failure', UserAddress, 'FM', 0, Now);
      MailToProcess := True;
    end;
  end;
  if MailToProcess then begin
    DeliverMail := TDeliverMail.Create(FMessageInfo);
    DeliverMail.OnStatusUpdate := FOnStatusUpdate;
    DeliverMail.Deliver;
    DeliverMail.Free;
  end;
  StatusUpdate('Destination Mailing List Processed', STAT_PROCESSINGEVENT);
end;
procedure TListServer.ParseSubject(Subject : String;
                                   var Command : String;
                                   var Parameter : String);
begin
  // We have a subject, we want to make sure it's a valid list command,
  // and if so, break it into it's command and parameter constituents
  Command := '';
  Parameter := '';
  // All commands to a list must start with a bang (!)
  if Copy(Subject, 1, 1) = '!' then begin
    Subject := Copy(Subject, 2, Length(Subject));
    if UpperCase(Copy(Subject, 1, 9)) = 'SUBSCRIBE' then begin
      Command := 'SUBSCRIBE';
      Parameter := Trim(Copy(Subject, 10, Length(Subject)));
    end else
    if UpperCase(Copy(Subject, 1, 17)) = 'CONFIRM SUBSCRIBE' then begin
      Command := 'CONFIRM SUBSCRIBE';
      Parameter := Trim(Copy(Subject, 18, Length(Subject)));
    end else
    if UpperCase(Copy(Subject, 1, 11)) = 'UNSUBSCRIBE' then begin
      Command := 'UNSUBSCRIBE';
      Parameter := Trim(Copy(Subject, 12, Length(Subject)));
    end else
    if UpperCase(Copy(Subject, 1, 6)) = 'REMOVE' then begin
      Command := 'UNSUBSCRIBE';
      Parameter := Trim(Copy(Subject, 7, Length(Subject)));
    end else
    if UpperCase(Copy(Subject, 1, 4)) = 'LIST' then begin
      Command := 'LIST';
      Parameter := Trim(Copy(Subject, 5, Length(Subject)));
    end else
    if UpperCase(Copy(Subject, 1, 4)) = 'HELP' then begin
      Command := 'HELP';
      Parameter := Trim(Copy(Subject, 5, Length(Subject)));
    end else begin
      Command := '';
      Parameter := '';
    end;
  end;
end;
procedure TListServer.BuildMessageToUser(MessageType, SenderAddress,
                                         FailureMessage : String;
                                         MagicNumber : Longint;
                                         ExpirationDate : TDateTime);
var
  x : Longint;
  Route : TMessageRouteInformation;
  SenderRoute : String;  // Routes are <"x"@[y.z]>
  Member : PMailListMemberInfoRec;
begin
  // Generate the Sender's Route from the address
  Route := TMessageRouteInformation.Create(mrte_Unknown);
  SenderRoute := SenderAddress;
  if Route.ParseRoute(SenderAddress) = 0 then SenderRoute := Route.BuildRoute;
  Route.Free;
  // Messages from the listserver don't have a return path.
  // That's so routing failures are not sent back to us here.
  FMessageInfo.ReverseRoute.ParseRoute('<>'); // no return path
  FMessageInfo.ClearForwardRoutes;
  FMessageInfo.AddForwardRoute(SenderRoute);  // send to sender.
  FMessageInfo.Data.Clear;                    // we'll fill in message below
  MessageType := UpperCase(MessageType);
  if MessageType = 'SUBMISSION FAILURE' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Submission Failure');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('The specified list either does not exist at this ');
    FMessageInfo.Data.Add('server, or is not open to public submission.');
  end else
  if MessageType = 'SUBSCRIBE SUCCESS' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Subscription');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('You (' + SenderAddress + ') have been subscribed ' +
                          'to the');
    FMessageInfo.Data.Add('"' + FListName + '" mailing list at ' +
                          INI.ServerName + '.');
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('To really join the list, you must send mail to: ' +
                          FListAddress);
    FMessageInfo.Data.Add('With a subject of: !Confirm Subscribe ' +
                          IntToStr(MagicNumber));
    FMessageInfo.Data.Add('By ' + TimeToStr(ExpirationDate) + ' on ' +
                          DateToStr(ExpirationDate));
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('In other words, to join the list, reply to this');
    FMessageInfo.Data.Add('mail and paste the following line into your e-mail');
    FMessageInfo.Data.Add('subject before you send it:');
    FMessageInfo.Data.Add('!Confirm Subscribe ' + IntToStr(MagicNumber));
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('If you don''t want to subscribe, do nothing.');
  end else
  if MessageType = 'SUBSCRIBE FAILURE' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Subscription');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Your subscription to ' + FListAddress +
                          ' request failed because:');
    FMessageInfo.Data.Add(FailureMessage);
  end else
  if MessageType = 'SUBSCRIBE CONFIRM SUCCESS' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Subscription Successful');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('To remove yourself, reply with a subject of ' +
                          '"!Remove" (no quotes)');
    FMessageInfo.Data.Add('');
    for x := 0 to FMailList.SL_Welcome.Count -1 do
      FMessageInfo.Data.Add(FMailList.SL_Welcome[x]);
  end else
  if MessageType = 'SUBSCRIBE CONFIRM FAILURE' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Subscription');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Your subscription confirmation to ' + FListAddress +
                          ' failed because:');
    FMessageInfo.Data.Add(FailureMessage);
  end else
  if MessageType = 'UNSUBSCRIBE SUCCESS' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Removal Successful');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    for x := 0 to FMailList.SL_Farewell.Count -1 do
      FMessageInfo.Data.Add(FMailList.SL_Farewell[x]);
  end else
  if MessageType = 'UNSUBSCRIBE FAILURE' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Removal');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Your removal from ' + FListAddress +
                          ' failed because:');
    FMessageInfo.Data.Add(FailureMessage);
  end else
  if MessageType = 'LIST SUCCESS' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Membership Listing');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Members of "' + FListName + '" (' +
                          FListAddress +')');
    FMessageInfo.Data.Add('');
    for x := 0 to FMailList.MemberCount -1 do begin
      Member := FMailList.Members[x];
      if (Member.Active) and (not Member.Hidden) then
        FMessageInfo.Data.Add(Member.EMail);
    end;
  end else
  if MessageType = 'LIST FAILURE' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Membership Listing');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Membership of "' + FListName + '" (' +
                          FListAddress +') is restricted.');
  end else
  if MessageType = 'HELP' then begin
    FMessageInfo.Data.Add('Subject: ' + FListName + ' Help');
    FMessageInfo.Data.Add('To: ' + SenderRoute);
    FMessageInfo.Data.Add('From: ' + FListRoute);
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Hermes SMTP/POP3 Server Mail List Help');
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Send list commands in the subject of your email.');
    FMessageInfo.Data.Add('The following commands are valid:');
    FMessageInfo.Data.Add('  Subscribe, Confirm Subscribe,');
    FMessageInfo.Data.Add('  Unsubscribe, Remove, List, Help');
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Command Syntax:');
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('  !Subscribe [Address]');
    FMessageInfo.Data.Add('  !Confirm Subscribe [Number]');
    FMessageInfo.Data.Add('  !Unsubscribe');
    FMessageInfo.Data.Add('  !Remove');
    FMessageInfo.Data.Add('  !List');
    FMessageInfo.Data.Add('  !Help');
    FMessageInfo.Data.Add('');
    FMessageInfo.Data.Add('Replace [Address] with your full e-mail address.');
    FMessageInfo.Data.Add('Replace [Number] with the number you were sent ' +
                          'in the subscription reply.');
    FMessageInfo.Data.Add('');
  end;
end;
(******************************************************************************)
(*                                                                            *)
(* STOP  ListServer Object                                                    *)
(*                                                                            *)
(******************************************************************************)
(******************************************************************************)
(*                                                                            *)
(* START Deliver Mail Object                                                  *)
(*                                                                            *)
(* This object is used to route mail locally.  It's employed by the           *)
(* Smtp Server to determine if mail should be processed as a message to a     *)
(* list, delivered locally, or queued for processing by the Smtp Agent.       *)
(* ALL mail bound for non-local users must be queued and processed by the     *)
(*                                                                            *)
(******************************************************************************)
constructor TDeliverMail.Create(MessageInfo : TSmtpMessageInformation);
begin
  inherited Create;
  // FMessageInfo was created somewhere else and will be freed by whatever
  // created it.  We are using this as a link to that object
  FMessageInfo := MessageInfo;
  // don't call Deliver here... then we couldn't set statusupdate
end;
procedure TDeliverMail.StatusUpdate(Status : String; Level : Integer);
begin
  if Assigned(FOnStatusUpdate) then OnStatusUpdate(Self, Status, Level);
end;
destructor TDeliverMail.Destroy;
begin
  // Do NOT free FMessageInfo... it was not created here, and will be freed
  // by whatever created it!
  inherited Destroy;
end;
procedure TDeliverMail.ProcessAlias(var UserName : String; Domain : String);
// Accepts a user name... determines if it's an alias and returns the real
// user name...
var
  MailBox, AliasID, AliasUser : String;
begin
  // First, try to fine an Alias qualified with a domain...
  Mailbox := UserName + '@' + Domain;
  if INI.Alias_Exists(MailBox) then begin  // The Mailbox is an alias
    UserName := INI.Alias_Find(MailBox);   // The alias is...
    INI.Alias_Parse(UserName, AliasID, AliasUser);  // we seperate it to get
                                                    // the user ID
    UserName := AliasUser;                 // and return the user ID here
    StatusUpdate('Destination (' + Mailbox + ') is Alias for ' + UserName,
                 STAT_PROCESSINGEVENT);
  end else begin
    // If we could not find a fully qualified Alias,
    // then let's look for an unqualified one...
    MailBox := UserName;
    if INI.Alias_Exists(MailBox) then begin  // The Mailbox is an alias
      UserName := INI.Alias_Find(MailBox);   // The alias is...
      INI.Alias_Parse(UserName, AliasID, AliasUser);  // we seperate it to get
                                                      // the user ID
      UserName := AliasUser;                 // and return the user ID here
      StatusUpdate('Destination (' + Mailbox + ') is Alias for ' + UserName,
                   STAT_PROCESSINGEVENT);
    end;
  end;
end;
procedure TDeliverMail.DeliverLocally(UserInfo : TPop3UserInformation);
// Deliver a copy of the message to a local user.
var
  x : Longint;
  SL : TStringList;  // Copy of the mail data for the user (has specail
                     // data individual to each user (return path)
begin
  if Assigned(UserInfo) then begin
    SL := TStringList.Create;
    // Add the Return Route
    StatusUpdate('Adding Return Path to Message Header', STAT_PROCESSINGEVENT);
    SL.Add('Return-Path: ' + FMessageInfo.ReverseRoute.BuildRoute);
    // Add the remaining mail data
    for x := 0 to FMessageInfo.Data.Count -1 do SL.Add(FMessageInfo.Data[x]);
    // Save the mail to the user
    StatusUpdate('Saving Message to User', STAT_PROCESSINGEVENT);
    UserInfo.SaveMail(SL);
    SL.Free;
  end;
end;
procedure TDeliverMail.Deliver;
var
  MailBox : String;
  ToRouteIndex : Longint;                  // The Index to the ToRouteArray
                                           // we are currently trying to deliver
  ToRouteInfo : TMessageRouteInformation;  // The ToRoute we are currently
                                           // trying to deliver to...
  UserInfo : TPop3UserInformation;         // If ToRoute is a local user, we'll
                                           // need to know about them to make
                                           // the delivery
  ListServ : TListServer;                  // If ToRoute proves to be a list,
                                           // we'll need a ListServer object
                                           // for further processing
begin
  StatusUpdate('Processing Destination Route(s)', STAT_PROCESSINGEVENT);
  ToRouteIndex := 0;
  while ToRouteIndex < FMessageInfo.ForwardRouteCount do begin
    ToRouteInfo := FMessageInfo.ForwardRoute[ToRouteIndex];
    // Question, should we short-circuit the routing if we're the
    // Destination host, and there are additional hosts in the forward path ?
    // I'll say yes.  Let's hope this is cool.
    if INI.Domain_IsThisOneOfMine(ToRouteInfo.Domain) then begin
      // This belongs to me, let's see if we can find a user, alias or list
      // for it...
      StatusUpdate('Destination Route is Local', STAT_PROCESSINGEVENT);
      MailBox := ToRouteInfo.Mailbox;
      ProcessAlias(MailBox, ToRouteInfo.Domain);  // if alias, get real user mailbox
      if INI.User_Exists(MailBox) then begin
        StatusUpdate('Destination is User', STAT_PROCESSINGEVENT);
        // We need to deliver the message to the user...
        UserInfo := TPop3UserInformation.Create;
        UserInfo.LoadFromFile(MailBox);
        if UserInfo.ForwardToAddress = '' then begin
          // The local user has no forward... we can deliver to the local user
          DeliverLocally(UserInfo);
          // Remove this To line, it's been successfully processed
          StatusUpdate('Removing Destination Route. Delivered.',
                       STAT_PROCESSINGEVENT);
          FMessageInfo.DeleteForwardRoute(ToRouteIndex);
        end else begin
          // the local user has a forward.
          // we need to process it just like it were the original
          StatusUpdate('Forwarding...', STAT_PROCESSINGEVENT);
          // replace the to route with the new (forward) one
          if ToRouteInfo.ParseRoute(UserInfo.ForwardToAddress) = 0 then begin
            // I'm trying the forward address...
            // Here I re-start delivery process again.
            // I could have made this a function I call, but then I'm
            // affraid of the possibility of recursive calling...
            // for example... user A forwards to B who forwards back to A
            // For that reason, I'll only process one forward here.
            // is it local (domain), is it alias? is it user?
            if INI.Domain_IsThisOneOfMine(ToRouteInfo.Domain) then begin
              StatusUpdate('Destination Route is Local', STAT_PROCESSINGEVENT);
              MailBox := ToRouteInfo.Mailbox;
              ProcessAlias(MailBox, ToRouteInfo.Domain);  // if alias, get real user mailbox
              if INI.User_Exists(MailBox) then begin
                StatusUpdate('Destination is User', STAT_PROCESSINGEVENT);
                // We need to deliver the message to the user...
                UserInfo := TPop3UserInformation.Create;
                // we won't check for forward or mail list...
                // we're not allowing user to forward indefinately or
                // forward to a list.
                DeliverLocally(UserInfo);
                // Remove this To line, it's been successfully processed
                StatusUpdate('Removing Destination Route. Delivered.',
                             STAT_PROCESSINGEVENT);
                FMessageInfo.DeleteForwardRoute(ToRouteIndex);
              end else begin
                StatusUpdate('Destination Route Local, but no user ' +
                             'available... Deleting ' + ToRouteInfo.BuildRoute,
                             STAT_PROCESSINGERROR);
                FMessageInfo.DeleteForwardRoute(ToRouteIndex);
              end;
            end else begin
              StatusUpdate('Destination Route Not Local... ' +
                           'Queueing for Agent...', STAT_PROCESSINGEVENT);
              Inc(ToRouteIndex);
            end;
          end else begin
            // Unable to forward... route is bad... better deliver locally
            StatusUpdate('Unable to understand forward address... ' +
                         'Delivered Locally.', STAT_PROCESSINGERROR);
            DeliverLocally(UserInfo);
            // Remove this To line, it's been successfully processed
            StatusUpdate('Removing Destination Route. Delivered.',
                         STAT_PROCESSINGEVENT);
            FMessageInfo.DeleteForwardRoute(ToRouteIndex);
          end;
        end;
        UserInfo.Free;
      end else
      if INI.List_Exists(ToRouteInfo.Mailbox) then begin
        StatusUpdate('Destination Route is a Mailing List',
                     STAT_PROCESSINGEVENT);
        // It's a mailing list that requires specail processing,
        // including exploding the list and generating messages
        ListServ := TListServer.Create(ToRouteInfo.Mailbox,
                                       FMessageInfo.ReverseRoute.BuildRoute,
                                       FMessageInfo.Data);
        ListServ.OnStatusUpdate := FOnStatusUpdate;
        ListServ.Process;
        ListServ.Free;
        // Remove this To line, it's been successfully processed
        StatusUpdate('Removing Destination Route. Delivered.',
                     STAT_PROCESSINGEVENT);
        FMessageInfo.DeleteForwardRoute(ToRouteIndex);
      end else
      begin
        // This is supposed to be local, but I don't have anywhere to deliver
        // it.  I checked for this in the RCPT, but I must have messed up to
        // get here.
        // I guess I'll have to generate a "Failure Notification" and queue
        // that for Agent processing which will send that back to the sender
        SendUndeliverableReply(ToRouteInfo.BuildRoute);
        StatusUpdate('Destination Route Local, but no user available... ' +
                     'Generating "Undeliverable" Notification',
                     STAT_PROCESSINGERROR);
        FMessageInfo.DeleteForwardRoute(ToRouteIndex);
      end;
    end else begin
      // foreign domain... don't do anything more here
      // The SMTP Agent will try to send this on to the next host...
      // just move on to the next To Route
      StatusUpdate('Destination Route Not Local... queueing for Agent...',
                   STAT_PROCESSINGEVENT);
      Inc(ToRouteIndex);
    end;
  end;
  // Save remaining routing info and message (if there is any)
  if FMessageInfo.ForwardRouteCount > 0 then begin
    FMessageInfo.SaveToFile; // written to FQueuePath as XXX.ini and XXX.txt
    // Notify the Server (Main Form) that we've added
    // a message to the Agent Queue and that it needs attention
    if INI.Agent_ServiceQueueImmediately then Trigger_ServiceSMTPQueue;
    StatusUpdate(IntToStr(FMessageInfo.ForwardRouteCount) +
                 ' Destination Route(s) Queued for Agent Processing',
                 STAT_PROCESSINGEVENT);
  end;
  StatusUpdate('Incoming Mail Processed', STAT_PROCESSINGEVENT);
end;
procedure TDeliverMail.SendUndeliverableReply(DestinationPath : String);
var
  MessageInfo : TSmtpMessageInformation;
  Route : TMessageRouteInformation;
  x : Longint;
begin
  MessageInfo := TSmtpMessageInformation.Create;
  // Set the routes...
  MessageInfo.ReverseRoute.ParseRoute('<>');  // No return for failure notice
  MessageInfo.AddForwardRoute(FMessageInfo.ReverseRoute.BuildRoute);
  // copy the data in...
  MessageInfo.Data_AppendLine('From: Hermes Server ' + INI.ServerName);
  MessageInfo.Data_AppendLine('Subject: Undeliverable Mail');
  MessageInfo.Data_AppendLine('');
  MessageInfo.Data_AppendLine('The following recepients were not reached:');
  MessageInfo.Data_AppendLine('');
  MessageInfo.Data_AppendLine(DestinationPath);
  MessageInfo.Data_AppendLine('');
  MessageInfo.Data_AppendLine('so the following message ' +
                              'could not be delivered.');
  MessageInfo.Data_AppendLine('');
  MessageInfo.Data_AppendLine('');
  for x := 0 to FMessageInfo.Data.Count -1 do
    MessageInfo.Data_AppendLine(FMessageInfo.Data[x]);
  // if the forward route is valid, queue for sending
  if MessageInfo.ForwardRouteCount > 0 then begin
    Route := MessageInfo.ForwardRoute[0];
    if Route.BuildRoute <> '<>' then MessageInfo.SaveToFile;
  end;
  MessageInfo.Free;
end;
(******************************************************************************)
(*                                                                            *)
(* STOP  Deliver Mail Object                                                  *)
(*                                                                            *)
(******************************************************************************)
end.

						