Mailbox.pas

   1 {
   2    MegaBrutal's SMTP Server (MgSMTP)
   3    Copyright (C) 2010-2015 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: Mailbox
  21    Administers mailboxes. It implements methods to place messages into the
  22    mailbox files.
  23 }
  24
  25
  26 {$MODE DELPHI}
  27
  28 unit Mailbox;
  29
  30 interface
  31 uses SysUtils, SyncObjs, Classes, INIFiles, Common, Log, Spool;
  32
  33 type
  34
  35    PMailbox = ^TMailbox;
  36    TMailbox = class(TNamedObject)
  37       constructor Create(const Name, Domain: string; Config: TINIFile; Slave: boolean; DefaultQuota: longint);
  38       destructor Destroy; override;
  39    protected
  40       FDomain: string;
  41       FQuota, FLockID: longint;
  42       CriticalSection: TCriticalSection;
  43    private
  44       FPlusAliases: boolean;
  45       FRewritePassThru: boolean;
  46       PlusAliasExceptList: TStringList;
  47       RewriteToList: TStringList;
  48       MailboxFile: TStream;
  49       procedure AddTrackHeaders(EMail, Recipient: string; Headers: TStrings);
  50       { class function GetConfigSectionName(const Name, Domain: string): string; }
  51       class function GetMailboxConfig(Config: TINIFile; const Name, Domain, Ident, Default: string): string; overload;
  52       class function GetMailboxConfig(Config: TINIFile; const Name, Domain, Ident: string; Default: boolean): boolean; overload;
  53    public
  54       function IsItYourName(const Name: string): boolean; override;
  55       function GetMailboxAddress: string;
  56       function CheckAlias(const Name: string): boolean;
  57       function CheckQuota(MailSize: longint): boolean; virtual; abstract;
  58       function BeginDeliverMessage(LockID: longint; EMail, Recipient, SpoolID: string; EMailProperties: TEMailProperties; Headers: TStrings): boolean; virtual; abstract;
  59       function DeliverMessagePart(LockID: longint; Message: TStrings): boolean; virtual; abstract;
  60       function FinishDeliverMessage(LockID: longint): boolean; virtual; abstract;
  61       function Lock: longint; virtual; abstract;
  62       function Release(LockID: longint): boolean; virtual; abstract;
  63       function GetRewriteCount: integer;
  64       function GetRewriteToEntry(i: integer): string;
  65       function GetRewriteToListStr: string;
  66       property Domain: string read FDomain;
  67       property Quota: longint read FQuota;
  68       property RewriteCount: integer read GetRewriteCount;
  69       property RewritePassThru: boolean read FRewritePassThru;
  70    end;
  71
  72    TMailbox_mbox = class(TMailbox)
  73    private
  74       procedure FromQuote(var Message: TStrings);
  75       function MakeMailboxFilename: string;
  76    public
  77       function CheckQuota(MailSize: longint): boolean; override;
  78       function BeginDeliverMessage(LockID: longint; EMail, Recipient, SpoolID: string; EMailProperties: TEMailProperties; Headers: TStrings): boolean; override;
  79       function DeliverMessagePart(LockID: longint; Message: TStrings): boolean; override;
  80       function FinishDeliverMessage(LockID: longint): boolean; override;
  81       function Lock: longint; override;
  82       function Release(LockID: longint): boolean; override;
  83    end;
  84
  85    TForwarderMailbox = class(TMailbox)
  86       constructor Create(const Name, Domain: string; Config: TINIFile; Slave: boolean; DefaultQuota: longint; PhysicalMailbox: TMailbox);
  87       destructor Destroy; override;
  88    private
  89       PhysicalMailbox: TMailbox;
  90       ForwardToList: TStringList;
  91       SpoolObject: TSpoolObjectCreator;
  92       OrigSpoolID: string;
  93       FReplyTo: string;
  94       FForwardHeaders, FRemail: boolean;
  95    public
  96       function CheckQuota(MailSize: longint): boolean; override;
  97       function BeginDeliverMessage(LockID: longint; EMail, Recipient, SpoolID: string; EMailProperties: TEMailProperties; Headers: TStrings): boolean; override;
  98       function DeliverMessagePart(LockID: longint; Message: TStrings): boolean; override;
  99       function FinishDeliverMessage(LockID: longint): boolean; override;
 100       function Lock: longint; override;
 101       function Release(LockID: longint): boolean; override;
 102       property ReplyTo: string read FReplyTo;
 103       property ForwardHeaders: boolean read FForwardHeaders;
 104       property Remail: boolean read FRemail;
 105    end;
 106
 107
 108    TBoxes = array of TMailbox;
 109    TDomainBoxes = array of TBoxes;
 110
 111    TMailboxContainer = class(TStringList)
 112    public
 113       destructor Destroy; override;
 114    protected
 115       DomainBoxes: TDomainBoxes;
 116    public
 117       procedure AddMailbox(const Domain: string; Mailbox: TMailbox);
 118       function GetMailbox(const Name, Domain: string): PMailbox;
 119    end;
 120
 121
 122    TMailboxManager = class
 123       constructor Create(Config: TINIFile);
 124       destructor Destroy; override;
 125    private
 126       MailboxContainer: TMailboxContainer;
 127       DefaultQuota: longint;
 128       FDomainSpecific: boolean;
 129       FRewrite, FForward: boolean;
 130    public
 131       property DomainSpecific: boolean read FDomainSpecific;
 132       property Rewrite: boolean read FRewrite;
 133       property Forward: boolean read FForward;
 134       function CheckQuota(const Name, Domain: string; MailSize: longint): boolean;
 135       function GetMailbox(const Name, Domain: string): PMailbox;
 136       function IsLocalAddress(const EMail: string): boolean;
 137       function Verify(const EMail: string): boolean;
 138       function VerifyAlias(const EMail: string): boolean;
 139    end;
 140
 141
 142 var
 143
 144    MailboxManager: TMailboxManager;
 145
 146
 147 implementation
 148
 149 const
 150
 151    { Search attributes: }
 152    SEARCH_ATTR = faAnyFile - faDirectory - faVolumeID - faHidden;
 153
 154
 155 constructor TMailbox.Create(const Name, Domain: string; Config: TINIFile; Slave: boolean; DefaultQuota: longint);
 156 var Section, BaseList: string;
 157 begin
 158    if Length(Domain) = 0 then
 159       Section:= 'Mailbox\' + Name
 160    else
 161       Section:= 'Mailbox\' + Name + '@' + Domain;
 162
 163    inherited Create(Name, Config, Section);
 164    FDomain:= Domain;
 165    FQuota:= Config.ReadInteger(Section, 'Quota', DefaultQuota);
 166    FQuota:= StrToIntDef(GetMailboxConfig(Config, Name, Domain, 'Quota', IntToStr(DefaultQuota)), DefaultQuota);
 167    FLockID:= 0;
 168    CriticalSection:= TCriticalSection.Create;
 169
 170    if (not Slave) then begin
 171       FPlusAliases:= GetMailboxConfig(Config, Name, Domain, 'PlusAliases', true);
 172       if FPlusAliases then begin
 173          PlusAliasExceptList:= TStringList.Create;
 174          PlusAliasExceptList.Delimiter:= ',';
 175          BaseList:= GetMailboxConfig(Config, Name, Domain, 'PlusAliasExcept', '');
 176          if Length(Domain) > 0 then
 177             PlusAliasExceptList.DelimitedText:= BaseList + ',' + Config.ReadString('Mailbox\@' + Domain, 'GlobalPlusAliasExcept', '')
 178          else
 179             PlusAliasExceptList.DelimitedText:= BaseList + ',' + Config.ReadString('Mailbox', 'GlobalPlusAliasExcept', '');
 180
 181      end;
 182    end;
 183
 184    if (not Slave) and Config.ReadBool('Mailbox', 'Rewrite', false) then begin
 185       RewriteToList:= TStringList.Create;
 186       RewriteToList.Delimiter:= ',';
 187       RewriteToList.DelimitedText:= GetMailboxConfig(Config, Name, Domain, 'RewriteTo', '');
 188       FRewritePassThru:= GetMailboxConfig(Config, Name, Domain, 'RewritePassThru', true);
 189    end
 190    else FRewritePassThru:= true;
 191 end;
 192
 193 destructor TMailbox.Destroy;
 194 begin
 195    CriticalSection.Free;
 196 end;
 197
 198 constructor TForwarderMailbox.Create(const Name, Domain: string; Config: TINIFile; Slave: boolean; DefaultQuota: longint; PhysicalMailbox: TMailbox);
 199 begin
 200    inherited Create(Name, Domain, Config, Slave, DefaultQuota);
 201    Self.PhysicalMailbox:= PhysicalMailbox;
 202
 203    FReplyTo:= GetMailboxConfig(Config, Name, Domain, 'ReplyTo', '');
 204    FForwardHeaders:= GetMailboxConfig(Config, Name, Domain, 'ForwardHeaders', true);
 205    FRemail:= GetMailboxConfig(Config, Name, Domain, 'Remail', false);
 206
 207    ForwardToList:= TStringList.Create;
 208    ForwardToList.Delimiter:= ',';
 209    ForwardToList.DelimitedText:= GetMailboxConfig(Config, Name, Domain, 'ForwardTo', '');
 210 end;
 211
 212 destructor TForwarderMailbox.Destroy;
 213 begin
 214    inherited Destroy;
 215    ForwardToList.Free;
 216    if (PhysicalMailbox <> nil) then PhysicalMailbox.Free;
 217 end;
 218
 219 destructor TMailboxContainer.Destroy;
 220 var i, j: integer;
 221 begin
 222    for i:= Length(DomainBoxes) - 1 downto 0 do begin
 223       for j:= Length(DomainBoxes[i]) - 1 downto 0 do begin
 224          DomainBoxes[i][j].Free;
 225       end;
 226    end;
 227    inherited Destroy;
 228 end;
 229
 230 constructor TMailboxManager.Create(Config: TINIFile);
 231 var SearchRec: TSearchRec; i: integer; BoxName, BoxDomain: string;
 232     SlaveMailbox: TMailBox;
 233 begin
 234    inherited Create;
 235    DefaultQuota:=       Config.ReadInteger('Mailbox', 'Quota', 0);
 236    FDomainSpecific:=    Config.ReadBool('Mailbox', 'DomainSpecific', false);
 237    FRewrite:=           Config.ReadBool('Mailbox', 'Rewrite', false);
 238    FForward:=           Config.ReadBool('Mailbox', 'Forward', false);
 239    MailboxContainer:=   TMailboxContainer.Create;
 240    if FindFirst('mail\*', SEARCH_ATTR, SearchRec) = 0 then begin
 241       i:= 0;
 242       repeat
 243          if DomainSpecific then begin
 244             BoxName:= EMailUserName(SearchRec.Name);
 245             BoxDomain:= EMailHost(SearchRec.Name);
 246          end
 247          else begin
 248             BoxName:= SearchRec.Name;
 249             BoxDomain:= '';
 250          end;
 251
 252          { If forwarding requested, set up a forwarder mailbox. }
 253
 254          if Forward and (Length(TMailbox.GetMailboxConfig(Config, BoxName, BoxDomain, 'ForwardTo', '')) > 0) then begin
 255
 256             if TMailbox.GetMailboxConfig(Config, BoxName, BoxDomain, 'StoreLocalCopy', true) then
 257                SlaveMailbox:= TMailbox_mbox.Create(BoxName, BoxDomain, Config, true, DefaultQuota)
 258             else
 259                SlaveMailbox:= nil;
 260
 261             MailboxContainer.AddMailbox(BoxDomain, TForwarderMailbox.Create(BoxName, BoxDomain, Config, false, DefaultQuota, SlaveMailbox));
 262          end
 263          else
 264             MailboxContainer.AddMailbox(BoxDomain, TMailbox_mbox.Create(BoxName, BoxDomain, Config, false, DefaultQuota));
 265
 266          Inc(i);
 267       until FindNext(SearchRec) <> 0;
 268    end;
 269    FindClose(SearchRec);
 270 end;
 271
 272 destructor TMailboxManager.Destroy;
 273 begin
 274    MailboxContainer.Free;
 275    inherited Destroy;
 276 end;
 277
 278
 279 procedure TMailbox.AddTrackHeaders(EMail, Recipient: string; Headers: TStrings);
 280 begin
 281    Headers.Insert(0, 'Return-Path: <' + EMail + '>');
 282    Headers.Insert(0, 'X-Original-To: <' + Recipient + '>');
 283 end;
 284
 285 {class function TMailbox.GetConfigSectionName(const Name, Domain: string): string;
 286 begin
 287    if Length(Domain) = 0 then
 288       Result:= 'Mailbox\' + Name
 289    else
 290       Result:= 'Mailbox\' + Name + '@' + Domain;
 291 end;}
 292
 293 class function TMailbox.GetMailboxConfig(Config: TINIFile; const Name, Domain, Ident, Default: string): string;
 294 begin
 295    if Length(Domain) > 0 then
 296       Result:= Config.ReadString('Mailbox\' + Name + '@' + Domain, Ident,
 297          Config.ReadString('Mailbox\@' + Domain, Ident,
 298          Config.ReadString('Mailbox', Ident, Default)))
 299    else
 300       Result:= Config.ReadString('Mailbox\' + Name, Ident,
 301          Config.ReadString('Mailbox', Ident, Default));
 302 end;
 303
 304 class function TMailbox.GetMailboxConfig(Config: TINIFile; const Name, Domain, Ident: string; Default: boolean): boolean;
 305 begin
 306    if Length(Domain) > 0 then
 307       Result:= Config.ReadBool('Mailbox\' + Name + '@' + Domain, Ident,
 308          Config.ReadBool('Mailbox\@' + Domain, Ident,
 309          Config.ReadBool('Mailbox', Ident, Default)))
 310    else
 311       Result:= Config.ReadBool('Mailbox\' + Name, Ident,
 312          Config.ReadBool('Mailbox', Ident, Default));
 313 end;
 314
 315 function TMailbox.IsItYourName(const Name: string): boolean;
 316 var p: integer;
 317 begin
 318    if FPlusAliases then begin
 319       p:= Pos('+', Name);
 320       if p <> 0 then
 321          Result:= inherited IsItYourName(Copy(Name, 1, p - 1))
 322       else
 323          Result:= inherited IsItYourName(Name);
 324    end
 325    else
 326       Result:= inherited IsItYourName(Name);
 327 end;
 328
 329 function TMailbox.GetMailboxAddress: string;
 330 begin
 331    if Length(Domain) = 0 then
 332       Result:= Name + '@' + MainServerConfig.Name
 333    else
 334       Result:= Name + '@' + Domain;
 335 end;
 336
 337 function TMailbox.CheckAlias(const Name: string): boolean;
 338 var p: integer;
 339 begin
 340    p:= Pos('+', Name);
 341    if p <> 0 then
 342       Result:= PlusAliasExceptList.IndexOf(Copy(Name, p + 1, Length(Name) - p)) = -1
 343    else
 344       Result:= true;
 345 end;
 346
 347 function TMailbox.GetRewriteCount: integer;
 348 begin
 349    Result:= RewriteToList.Count;
 350 end;
 351
 352 function TMailbox.GetRewriteToEntry(i: integer): string;
 353 begin
 354    Result:= RewriteToList.Strings[i];
 355 end;
 356
 357 function TMailbox.GetRewriteToListStr: string;
 358 begin
 359    Result:= RewriteToList.DelimitedText;
 360 end;
 361
 362
 363 procedure TMailbox_mbox.FromQuote(var Message: TStrings);
 364 var i: integer;
 365 begin
 366    for i:= 0 to Message.Count - 1 do
 367       if pos('From ', Message.Strings[i]) = 1 then
 368          Message.Strings[i]:= '>' + Message.Strings[i];
 369 end;
 370
 371 function TMailbox_mbox.MakeMailboxFilename: string;
 372 begin
 373    if Length(Domain) = 0 then
 374       Result:= 'mail\' + Name
 375    else
 376       Result:= 'mail\' + Name + '@' + Domain;
 377 end;
 378
 379 function TMailbox_mbox.CheckQuota(MailSize: longint): boolean;
 380 { Returns FALSE if the given message size would exceed the quota. }
 381 var SearchRec: TSearchRec;
 382 begin
 383    if FindFirst(MakeMailboxFilename, SEARCH_ATTR, SearchRec) = 0 then
 384       Result:= ((SearchRec.Size + MailSize) <= FQuota) or (FQuota = 0)
 385    else
 386       Result:= false;
 387    FindClose(SearchRec);
 388 end;
 389
 390 function TMailbox_mbox.BeginDeliverMessage(LockID: longint; EMail, Recipient, SpoolID: string; EMailProperties: TEMailProperties; Headers: TStrings): boolean;
 391 var NL, Line: string;
 392 begin
 393    if (FLockID <> 0) and (FLockID = LockID) then begin
 394       case DefaultTextLineBreakStyle of
 395          tlbsLF:     NL:= #10;
 396          tlbsCRLF:   NL:= #13#10;
 397          tlbsCR:     NL:= #13;
 398       end;
 399
 400       {FromQuote(Headers);}
 401       AddTrackHeaders(EMail, Recipient, Headers);
 402       Headers.Insert(0, 'Delivered-To: ' + GetMailboxAddress);
 403       try
 404          if Length(EMail) = 0 then EMail:= 'MAILER-DAEMON';
 405          Line:= 'From ' + EMail + ' ' + EMailTimeStamp(Now) + NL;
 406          MailboxFile.WriteBuffer(Pointer(Line)^,Length(Line));
 407          Headers.SaveToStream(MailboxFile);
 408          MailboxFile.WriteBuffer(Pointer(NL)^,Length(NL));
 409          Result:= true;
 410       except
 411          Result:= false;
 412       end;
 413    end
 414    else Result:= false;
 415 end;
 416
 417 function TMailbox_mbox.DeliverMessagePart(LockID: longint; Message: TStrings): boolean;
 418 begin
 419    if (FLockID <> 0) and (FLockID = LockID) then begin
 420       FromQuote(Message);
 421       try
 422          Message.SaveToStream(MailboxFile);
 423          Result:= true;
 424       except
 425          Result:= false;
 426       end;
 427    end
 428    else Result:= false;
 429 end;
 430
 431 function TMailbox_mbox.FinishDeliverMessage(LockID: longint): boolean;
 432 begin
 433    if (FLockID <> 0) and (FLockID = LockID) then begin
 434       try
 435          MailboxFile.WriteBuffer(#13#10, 2);
 436          Result:= true;
 437       except
 438          Result:= false;
 439       end;
 440    end
 441    else Result:= false;
 442 end;
 443
 444 function TMailbox_mbox.Lock: longint;
 445 begin
 446    CriticalSection.Acquire;
 447    if FLockID = 0 then begin
 448       try
 449          MailboxFile:= TFileStream.Create(MakeMailboxFilename, fmOpenReadWrite);
 450          FLockID:= (MailboxFile as TFileStream).Handle;
 451          MailboxFile.Seek(0, soFromEnd);
 452       except
 453          try
 454             FreeAndNil(MailboxFile);
 455          except
 456          end;
 457          FLockID:= 0;
 458       end;
 459       Result:= FLockID;
 460    end
 461    else Result:= 0;
 462    CriticalSection.Release;
 463 end;
 464
 465 function TMailbox_mbox.Release(LockID: longint): boolean;
 466 begin
 467    CriticalSection.Acquire;
 468    if (FLockID <> 0) and (FLockID = LockID) then begin
 469       FreeAndNil(MailboxFile);
 470       FLockID:= 0;
 471    end
 472    else Result:= false;
 473    CriticalSection.Release;
 474 end;
 475
 476
 477 function TForwarderMailbox.CheckQuota(MailSize: longint): boolean;
 478 { Returns FALSE if the given message size would exceed the quota. }
 479 begin
 480    if PhysicalMailbox <> nil then
 481       Result:= PhysicalMailbox.CheckQuota(MailSize)
 482    else
 483       Result:= true;
 484 end;
 485
 486 function TForwarderMailbox.BeginDeliverMessage(LockID: longint; EMail, Recipient, SpoolID: string; EMailProperties: TEMailProperties; Headers: TStrings): boolean;
 487 var i: integer;
 488 begin
 489    if (FLockID <> 0) and (FLockID = LockID) then begin
 490       if PhysicalMailbox = nil then begin
 491          AddTrackHeaders(EMail, Recipient, Headers);
 492          Result:= true;
 493       end
 494       else begin
 495          Result:= PhysicalMailbox.BeginDeliverMessage(LockID, EMail, Recipient, SpoolID, EMailProperties, Headers);
 496       end;
 497
 498       if Result then begin
 499          SpoolObject:= SpoolManager.CreateSpoolObject(TIPNamePair.Create('internal', ''));
 500          //PrepareSpoolObject(EMail, ForwardSpoolObject, Headers);
 501          SpoolObject.Databytes:= 0;
 502
 503          SpoolObject.EMailProperties.Size:=  EMailProperties.Size;
 504          SpoolObject.EMailProperties.Flags:= EMailProperties.Flags;
 505          OrigSpoolID:= SpoolID;
 506
 507          { Forward or remail? Regardless of the settings, DSNs only get forwarded
 508            and never get remailed. (Remailing them could cause a loop.) }
 509          if (not Remail) or (EMail = '') then
 510             SpoolObject.Envelope.ReturnPath:= EMail
 511          else
 512             SpoolObject.Envelope.ReturnPath:= Recipient;
 513
 514          for i:= 0 to ForwardToList.Count - 1 do
 515             SpoolObject.Envelope.AddRecipient(ForwardToList.Strings[i]);
 516
 517          if ForwardHeaders then begin
 518             Headers.Insert(0, 'X-Forwarded-For: ' + Recipient + ' ' + ForwardToList.DelimitedText);
 519             Headers.Insert(0, 'X-Forwarded-To: ' + ForwardToList.DelimitedText);
 520          end;
 521
 522          if ReplyTo <> '' then begin
 523             if ReplyTo = '!' then
 524                Headers.Insert(0, 'Reply-To: <' + Recipient + '>')
 525             else
 526                Headers.Insert(0, 'Reply-To: ' + ReplyTo);
 527          end;
 528
 529          SpoolObject.Open;
 530          for i:= 0 to Headers.Count - 1 do
 531             SpoolObject.DeliverMessagePart(Headers.Strings[i]);
 532
 533          SpoolObject.DeliverMessagePart('');
 534       end;
 535    end
 536    else
 537       Result:= false;
 538 end;
 539
 540 function TForwarderMailbox.DeliverMessagePart(LockID: longint; Message: TStrings): boolean;
 541 var i: integer;
 542 begin
 543    if (FLockID <> 0) and (FLockID = LockID) then begin
 544       if PhysicalMailbox <> nil then
 545          Result:= PhysicalMailbox.DeliverMessagePart(LockID, Message)
 546       else
 547          Result:= true;
 548
 549       for i:= 0 to Message.Count - 1 do
 550          SpoolObject.DeliverMessagePart(Message.Strings[i]);
 551    end
 552    else
 553       Result:= false;
 554 end;
 555
 556 function TForwarderMailbox.FinishDeliverMessage(LockID: longint): boolean;
 557 var action: string;
 558 begin
 559    if (FLockID <> 0) and (FLockID = LockID) then begin
 560       if PhysicalMailbox <> nil then
 561          Result:= PhysicalMailbox.FinishDeliverMessage(LockID)
 562       else
 563          Result:= true;
 564
 565       if not Remail then action:= 'forwarding' else action:= 'remailing';
 566
 567       if SpoolObject.GetErrorCode = SCE_NO_ERROR then begin
 568          Logger.AddLine('Mailbox ' + GetMailboxAddress, 'Message ' + OrigSpoolID + ' has been copied to '
 569             + SpoolObject.Name + ' for ' + action + ' to ' + ForwardToList.DelimitedText);
 570          SpoolObject.Close;
 571       end
 572       else begin
 573          Logger.AddLine('Mailbox ' + GetMailboxAddress, 'Failed to copy message <' + SpoolObject.OriginalMessageID + '> for '
 574             + action + ' to ' + ForwardToList.DelimitedText
 575             + '; Spool error code: ' + IntToStr(SpoolObject.GetErrorCode));
 576          SpoolObject.Discard;
 577       end;
 578       SpoolObject.Free;
 579    end
 580    else
 581       Result:= false;
 582 end;
 583
 584 function TForwarderMailbox.Lock: longint;
 585 { Very-very sensitive method that induced lots of cursing.
 586   Pay a lot of attention when you do any change to it! }
 587 begin
 588    CriticalSection.Acquire;
 589    if FLockID = 0 then begin
 590       if PhysicalMailbox <> nil then begin
 591          FLockID:= PhysicalMailbox.Lock;
 592          Result:= FLockID;
 593       end
 594       else begin
 595          FLockID:= GetCurrentThreadID;
 596          Result:= FLockID;
 597       end;
 598    end
 599    else Result:= 0;
 600    CriticalSection.Release;
 601 end;
 602
 603 function TForwarderMailbox.Release(LockID: longint): boolean;
 604 begin
 605    CriticalSection.Acquire;
 606    if (FLockID <> 0) and (FLockID = LockID) then begin
 607       if PhysicalMailbox <> nil then
 608          Result:= PhysicalMailbox.Release(LockID)
 609       else
 610          Result:= true;
 611    end
 612    else
 613       Result:= false;
 614    if Result then FLockID:= 0;
 615    CriticalSection.Release;
 616 end;
 617
 618
 619 procedure TMailboxContainer.AddMailbox(const Domain: string; Mailbox: TMailbox);
 620 var i, j: integer;
 621 begin
 622    { IndexOf is supposed to be case-insensitive, but it depends on locales.
 623      It's safer to uppercase the string before passing to it.
 624      See: http://62.166.198.202/view.php?id=15489 }
 625    i:= IndexOf(UpperCase(Domain));
 626    if i = -1 then begin
 627       Add(Domain);
 628       i:= Count - 1;
 629       SetLength(DomainBoxes, Count);
 630    end;
 631    j:= Length(DomainBoxes[i]);
 632    SetLength(DomainBoxes[i], j + 1);
 633    DomainBoxes[i][j]:= Mailbox;
 634 end;
 635
 636 function TMailboxContainer.GetMailbox(const Name, Domain: string): PMailbox;
 637 var i, j: integer;
 638 begin
 639    i:= IndexOf(UpperCase(Domain));
 640    if i <> -1 then begin
 641       j:= 0;
 642       while (j < Length(DomainBoxes[i])) and (not(DomainBoxes[i][j].IsItYourName(Name))) do Inc(j);
 643       if (j < Length(DomainBoxes[i])) then Result:= @DomainBoxes[i][j]
 644       else if Domain <> '' then Result:= GetMailbox(Name, '')
 645       else Result:= nil;
 646    end
 647    else if Domain <> '' then Result:= GetMailbox(Name, '')
 648    else Result:= nil;
 649 end;
 650
 651
 652 function TMailboxManager.CheckQuota(const Name, Domain: string; MailSize: longint): boolean;
 653 var Mailbox: PMailbox;
 654 begin
 655    Mailbox:= GetMailbox(Name, Domain);
 656    if Mailbox <> nil then
 657       Result:= Mailbox^.CheckQuota(MailSize)
 658    else
 659       Result:= false;
 660 end;
 661
 662 function TMailboxManager.GetMailbox(const Name, Domain: string): PMailbox;
 663 begin
 664    Result:= MailboxContainer.GetMailbox(Name, Domain);
 665 end;
 666
 667 function TMailboxManager.IsLocalAddress(const EMail: string): boolean;
 668 begin
 669    Result:= MainServerConfig.IsItYourName(EMailHost(EMail));
 670 end;
 671
 672 function TMailboxManager.Verify(const EMail: string): boolean;
 673 begin
 674    Result:= GetMailbox(EMailUserName(EMail), EMailHost(EMail)) <> nil;
 675 end;
 676
 677 function TMailboxManager.VerifyAlias(const EMail: string): boolean;
 678 var Mailbox: PMailbox;
 679 begin
 680    Mailbox:= GetMailbox(EMailUserName(EMail), EMailHost(EMail));
 681    if Mailbox <> nil then
 682       Result:= Mailbox^.CheckAlias(EMailUserName(EMail))
 683    else
 684       Result:= false;
 685 end;
 686
 687
 688 end.