Common.pas

   1 {
   2    Copyright (C) 2010-2015 MegaBrutal
   3
   4    This unit is free software: you can redistribute it and/or modify
   5    it under the terms of the GNU Lesser General Public License as published by
   6    the Free Software Foundation, either version 3 of the License, or
   7    (at your option) any later version.
   8
   9    This unit is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12    GNU Lesser General Public License for more details.
  13
  14    You should have received a copy of the GNU Lesser General Public License
  15    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16 }
  17
  18 {
  19    Unit: Common
  20    It holds some common definitions for MgSMTP, and some helper functions.
  21 }
  22
  23
  24 {$MODE DELPHI}
  25
  26 unit Common;
  27
  28 interface
  29 uses Windows, SysUtils, DateUtils, Classes, INIFiles;
  30
  31 type
  32
  33    TStringArray = array of string;
  34    TUnixTimeStamp = longint;
  35
  36
  37    TArgument = record
  38       Option, Value: string;
  39    end;
  40
  41
  42    TArgumentParser = class
  43       constructor Create(RawArguments: array of string; AllowedPrefixes: array of string);
  44       destructor Destroy; override;
  45    private
  46       Arguments: array of TArgument;
  47       procedure ParseArgument(Arg: string; const AllowedPrefixes: array of string);
  48    public
  49       function GetArgument(ID: integer): TArgument;
  50       function IsPresent(ArgumentName: string): boolean;
  51       function GetValue(ArgumentName: string; DefValue: string = ''): string;
  52       function ValidateArguments(ValidArguments: array of string): integer;
  53    end;
  54
  55
  56    TNamedObject = class
  57       constructor Create(const Name: string; Config: TINIFile; const Section: string);
  58    private
  59       FName: string;
  60       FAliases: TStrings;
  61    public
  62       property Name: string read FName;
  63       property Aliases: TStrings read FAliases;
  64       function IsItYourName(const Name: string): boolean; virtual;
  65    end;
  66
  67
  68    TMainServerConfig = class(TNamedObject)
  69       constructor Create(Config: TINIFile);
  70    private
  71       FPolicies, FMailbox, FRelay, FLog: boolean;
  72       FDatabytes: longint;
  73       {FTimeCorrection: integer;}
  74       FTimeOffset: integer;
  75       FTimeOffsetStr: string;
  76       FListenPorts: TStrings;
  77    public
  78       function GetVersionStr: string;
  79       property ListenPorts: TStrings read FListenPorts;
  80       property Databytes: longint read FDatabytes;
  81       {property TimeCorrection: integer read FTimeCorrection;}
  82       property TimeOffset: integer read FTimeOffset;
  83       property TimeOffsetStr: string read FTimeOffsetStr;
  84       property Policies: boolean read FPolicies;
  85       property Mailbox: boolean read FMailbox;
  86       property Relay: boolean read FRelay;
  87       property Log: boolean read FLog;
  88       property VersionStr: string read GetVersionStr;
  89    end;
  90
  91
  92    TEMailFlags = word;
  93
  94    TEMailProperties = class
  95       constructor Create;
  96    protected
  97       FSize: longint;
  98       FFlags: TEMailFlags;
  99    public
 100       procedure SetSize(Value: longint);
 101       procedure WriteFlags(Value: TEMailFlags);
 102       procedure SetFlag(Flag: TEMailFlags);
 103       function HasFlag(Flag: TEMailFlags): boolean;
 104       property Size: longint read FSize write SetSize;
 105       property Flags: TEMailFlags read FFlags write WriteFlags;
 106    end;
 107
 108
 109    TRecipient = record
 110       Address, RMsg: string;
 111       Data: integer;
 112    end;
 113
 114
 115    TIPNamePair = class
 116       constructor Create(const Name, IP: string);
 117    protected
 118       FName, FIP: string;
 119    public
 120       property Name: string read FName;
 121       property IP: string read FIP;
 122       function Copy: TIPNamePair;
 123    end;
 124
 125
 126    TEnvelope = class
 127       constructor Create;
 128       destructor Destroy; override;
 129    private
 130       FReturnPath, FRelayHost: string;
 131       FReturnPathSpecified: boolean;
 132       FRecipients: array of TRecipient;
 133    public
 134       function GetNumberOfRecipients: integer;
 135       function GetRecipient(Index: integer): TRecipient;
 136       function IsComplete: boolean;
 137       procedure AddRecipient(Address: string; Data: integer = 0; RMsg: string = ''); overload;
 138       procedure AddRecipient(Recipient: TRecipient); overload;
 139       procedure SetReturnPath(Address: string);
 140       procedure SetRecipientData(Index, Data: integer; RMsg: string = '');
 141       procedure SetRelayHost(HostName: string);
 142       property ReturnPath: string read FReturnPath write SetReturnPath;
 143       property RelayHost: string read FRelayHost write SetRelayHost;
 144    end;
 145
 146
 147    TEnvelopeArray = array of TEnvelope;
 148
 149
 150    function EMailUserName(EMail: string): string;
 151    function EMailHost(EMail: string): string;
 152    function CleanEMailAddress(EMail: string): string;
 153    function IsValidEMailAddress(EMail: string): boolean;
 154    function EMailTimeStamp(DateTime: TDateTime): string;
 155    function EMailTimeStampCorrected(DateTime: TDateTime): string;
 156    function StatusToStr(Status: integer): string;
 157    procedure AssignDeliveryStatusToSMTPCodes(Envelope: TEnvelope);
 158
 159    function CleanEOLN(S: string): string;
 160    function GenerateRandomString(Length: integer): string;
 161    function GetAlphabetStr: string;
 162    function GetServiceCodeStr(Ctrl: dword): string;
 163    function GetWinMajorVersion: longword;
 164    function IsPrintableString(S: string): boolean;
 165    function UnixTimeStamp(DateTime: TDateTime): TUnixTimeStamp;
 166    function CmdlineToStringArray: TStringArray;
 167    procedure SplitParameters(S: string; var FirstPrm, Remainder: string; Separator: char = #32);
 168
 169    function ReadLineFromStream(Stream: TStream): string;
 170    function WriteLineToStream(Stream: TStream; Line: string): boolean;
 171
 172
 173 const
 174
 175    { MgSMTP version: }
 176    VERSION_STR       = '0.9t';
 177
 178    { Architecture: }
 179 {$IFDEF CPU64}
 180    PLATFORM_BITS     =  64;
 181 {$ELSE}
 182 {$IFDEF CPU32}
 183    PLATFORM_BITS     =  32;
 184 {$ENDIF}
 185 {$ENDIF}
 186
 187    { Delivery statuses: }
 188    DS_DELIVERED      = 1 shl 10;
 189    DS_DELAYED        = 1 shl 11;
 190    DS_PERMANENT      = 1 shl 12;
 191    DS_INTERNALFAIL   = 1 shl 13;
 192    DS_CONNECTIONFAIL = 1 shl 14;
 193    DS_UNEXPECTEDFAIL = 1 shl 15;
 194    DS_SMTPFAIL       = 1 shl 16;
 195    DS_SMTPREPLYMASK  = $000003FF;
 196    DS_ALLFLAGS       = $FFFFFFFF;
 197
 198    { E-mail property flags: }
 199    EF_8BITMIME       =   1;
 200
 201    DayNames: array[1..7] of shortstring = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
 202    MonthNames: array[1..12] of shortstring = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
 203       'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
 204
 205    { Support for PRESHUTDOWN is not yet present in the Free Pascal library,
 206      therefore I define the necessary constants here. It's a temporary
 207      solution, I hope I won't need it for the next release of FPC. }
 208    SERVICE_ACCEPT_PRESHUTDOWN  = $00000100;
 209    SERVICE_CONTROL_PRESHUTDOWN = $0000000F;
 210
 211
 212 var
 213
 214    MainServerConfig: TMainServerConfig;
 215
 216
 217 implementation
 218
 219
 220 { Unit-private functions/prodecures: }
 221
 222 function InStringArray(const S: string; const SA: array of string): boolean;
 223 var i: integer;
 224 begin
 225    i:= 0;
 226    while (i < Length(SA)) and (SA[i] <> S) do Inc(i);
 227    Result:= i < Length(SA);
 228 end;
 229
 230 function MakeTimeOffsetStr(TimeOffset: integer): string;
 231 var CorrS: string; CorrI: integer;
 232 begin
 233    CorrI:= TimeOffset;
 234    CorrS:= IntToStr(Abs(CorrI));
 235    while Length(CorrS) < 4 do CorrS:= '0' + CorrS;
 236    if CorrI >= 0 then CorrS:= '+' + CorrS else CorrS:= '-' + CorrS;
 237    Result:= CorrS;
 238 end;
 239
 240
 241 { Unit-public functions/procedures: }
 242
 243 function EMailUserName(EMail: string): string;
 244 var p: integer;
 245 begin
 246    p:= Length(EMail);
 247    while (p > 0) and (EMail[p] <> '@') do Dec(p);
 248    if p <> 0 then begin
 249       Result:= Copy(EMail, 1, p - 1);
 250    end
 251    else Result:= EMail;
 252 end;
 253
 254 function EMailHost(EMail: string): string;
 255 var p: integer;
 256 begin
 257    p:= Length(EMail);
 258    while (p > 0) and (EMail[p] <> '@') do Dec(p);
 259    if (p <> 0) and (p < Length(EMail)) then begin
 260       Result:= Copy(EMail, p + 1, Length(EMail) - p);
 261    end
 262    else Result:= '';
 263 end;
 264
 265 function CleanEMailAddress(EMail: string): string;
 266 var po, pc, p: integer;
 267 begin
 268    po:= Pos('<', EMail);
 269    pc:= Pos('>', EMail);
 270    if (po <> 0) and (pc <> 0) and (po < pc) then begin
 271       Result:= Copy(EMail, po + 1, pc - po - 1);
 272       p:= Pos(':', Result);
 273       if p <> 0 then
 274          Result:= Copy(Result, p + 1, Length(Result) - p);
 275    end
 276    else
 277       Result:= EMail;
 278 end;
 279
 280 function IsValidEMailAddress(EMail: string): boolean;
 281 begin
 282    { !!! TODO: Implement more strict checking later !!! }
 283    Result:= Pos('@', EMail) <> 0;
 284 end;
 285
 286 function EMailTimeStamp(DateTime: TDateTime): string;
 287 var Year, Month, Day: word;
 288 begin
 289    DecodeDate(DateTime, Year, Month, Day);
 290    Result:= DayNames[DayOfWeek(DateTime)] + ' ' + MonthNames[Month] + ' '
 291       + FormatDateTime('dd hh:nn:ss', DateTime) + ' ' + IntToStr(Year);
 292 end;
 293
 294 function EMailTimeStampCorrected(DateTime: TDateTime): string;
 295 begin
 296    Result:= EMailTimeStamp(DateTime) + ' ' + MainServerConfig.TimeOffsetStr;
 297 end;
 298
 299 function StatusToStr(Status: integer): string;
 300 { Returns the delivery status code in human-readable format. }
 301 begin
 302    Result:= IntToStr(Status and (DS_ALLFLAGS - DS_SMTPREPLYMASK - DS_SMTPFAIL))
 303       + '+' + IntToStr(Status and DS_SMTPREPLYMASK);
 304 end;
 305
 306 procedure AssignDeliveryStatusToSMTPCodes(Envelope: TEnvelope);
 307 var i, code, cond, status: integer; Recipient: TRecipient;
 308 begin
 309    for i:= 0 to Envelope.GetNumberOfRecipients - 1 do begin
 310       Recipient:= Envelope.GetRecipient(i);
 311       code:= Recipient.Data and DS_SMTPREPLYMASK;
 312       cond:= code div 100;
 313       case cond of
 314          0: status:= DS_DELAYED or DS_UNEXPECTEDFAIL;
 315          2: status:= DS_DELIVERED;
 316          4: status:= DS_DELAYED;
 317          5: status:= DS_PERMANENT;
 318          else status:= DS_PERMANENT or DS_UNEXPECTEDFAIL;
 319       end;
 320       if code <> 0 then status:= status or DS_SMTPFAIL;
 321       Envelope.SetRecipientData(i, code or status, Recipient.RMsg);
 322    end;
 323 end;
 324
 325
 326 function CleanEOLN(S: string): string;
 327 begin
 328    while (Length(S) <> 0) and (S[Length(S)] in [#13, #10]) do Delete(S, Length(S), 1);
 329    Result:= S;
 330 end;
 331
 332 function GenerateRandomString(Length: integer): string;
 333 var What, Chrn, i: integer; Value: string;
 334 begin
 335    Value:= '';
 336    for i:= 1 to Length do begin
 337      What:= Random(3);
 338      case What of
 339      0: begin Chrn:= Random(10)+48; Value:= Value + Chr(Chrn); end;
 340      1: begin Chrn:= Random(26)+65; Value:= Value + Chr(Chrn); end;
 341      2: begin Chrn:= Random(26)+97; Value:= Value + Chr(Chrn); end;
 342      end;
 343    end;
 344    Result:= Value;
 345 end;
 346
 347 function GetAlphabetStr: string;
 348 var i: byte;
 349 begin
 350    Result:= '';
 351    for i:= Ord('0') to Ord('9') do Result:= Result + Chr(i);
 352    for i:= Ord('A') to Ord('Z') do Result:= Result + Chr(i);
 353 end;
 354
 355 function GetServiceCodeStr(Ctrl: dword): string;
 356 begin
 357    case Ctrl of
 358    SERVICE_CONTROL_STOP:         Result:= 'STOP';
 359    SERVICE_CONTROL_SHUTDOWN:     Result:= 'SHUTDOWN';
 360    SERVICE_CONTROL_PRESHUTDOWN:  Result:= 'PRESHUTDOWN';
 361    else                          Result:= IntToStr(Ctrl);
 362    end;
 363 end;
 364
 365 function GetWinMajorVersion: longword;
 366 var OSVersionInfo: TOSVersionInfo;
 367 begin
 368    { Get OS version info. }
 369    OSVersionInfo.dwOSVersionInfoSize:= SizeOf(TOSVersionInfo);
 370    GetVersionEx(OSVersionInfo);
 371    Result:= OSVersionInfo.dwMajorVersion;
 372 end;
 373
 374 function IsPrintableString(S: string): boolean;
 375 { Check if string contains only printable ASCII characters. }
 376 var i: integer;
 377 begin
 378    i:= 1;
 379    Result:= true;
 380    while Result and (i <= Length(S)) do begin
 381       Result:= (Ord(S[i]) > 31) and (Ord(S[i]) < 127);
 382       Inc(i);
 383    end;
 384 end;
 385
 386 procedure SplitParameters(S: string; var FirstPrm, Remainder: string; Separator: char = #32);
 387 var i: integer;
 388 begin
 389    i:= pos(Separator, S);
 390    if i > 0 then begin
 391       FirstPrm:= Copy(S, 1, i - 1);
 392       Remainder:= Copy(S, i + 1, Length(S) - i);
 393    end
 394    else begin
 395       FirstPrm:= S;
 396       Remainder:= '';
 397    end;
 398 end;
 399
 400 function CmdlineToStringArray: TStringArray;
 401 var i: integer;
 402 begin
 403    SetLength(Result, ParamCount);
 404    for i:= 1 to ParamCount do
 405       Result[i-1]:= ParamStr(i);
 406 end;
 407
 408 function UnixTimeStamp(DateTime: TDateTime): TUnixTimeStamp;
 409 begin
 410    {Result:= Trunc((DateTime - EncodeDate(1970, 1 ,1)) * 24 * 60 * 60);}
 411    Result:= DateTimeToUnix(DateTime);
 412 end;
 413
 414
 415 function ReadLineFromStream(Stream: TStream): string;
 416 var S: string; B: char;
 417 begin
 418    S:= '';
 419    try
 420       repeat
 421          B:= Char(Stream.ReadByte);
 422          if not (B in [#10, #13]) then S:= S + B;
 423       until (B = #10);
 424    finally
 425       Result:= S;
 426    end;
 427 end;
 428
 429 function WriteLineToStream(Stream: TStream; Line: string): boolean;
 430 const EOLN = #13#10;
 431 begin
 432    Result:= true;
 433    Line:= Line + EOLN;
 434    try
 435       Stream.WriteBuffer(PChar(Line)^, Length(Line));
 436    except
 437       Result:= false;
 438    end;
 439 end;
 440
 441
 442 { Object constructors/destructors: }
 443
 444 constructor TArgumentParser.Create(RawArguments: array of string; AllowedPrefixes: array of string);
 445 var i: integer;
 446 begin
 447    for i:= 0 to Length(RawArguments) - 1 do
 448       ParseArgument(RawArguments[i], AllowedPrefixes);
 449 end;
 450
 451 destructor TArgumentParser.Destroy;
 452 begin
 453    SetLength(Arguments, 0);
 454 end;
 455
 456 constructor TNamedObject.Create(const Name: string; Config: TINIFile; const Section: string);
 457 begin
 458    inherited Create;
 459    FName:= Name;
 460    FAliases:= TStringList.Create;
 461    FAliases.Delimiter:= ',';
 462    FAliases.DelimitedText:= FName + ',' + Config.ReadString(Section, 'Alias', '');
 463 end;
 464
 465 constructor TMainServerConfig.Create(Config: TINIFile);
 466 begin
 467    inherited Create(Config.ReadString('Server', 'Name', ''), Config, 'Server');
 468    FListenPorts:= TStringList.Create;
 469    FListenPorts.Delimiter:= ',';
 470    FListenPorts.DelimitedText:= Config.ReadString('Server', 'ListenPort', '25');
 471
 472    FDatabytes:=      Config.ReadInteger('Server', 'Databytes', 1024 * 1024 * 1024);
 473    {FTimeCorrection:= Config.ReadInteger('Server', 'TimeCorrection', 0);}
 474    FTimeOffset:=     Config.ReadInteger('Server', 'TimeOffset', Config.ReadInteger('Server', 'TimeCorrection', 0) * 100);
 475    FTimeOffsetStr:=  MakeTimeOffsetStr(FTimeOffset);
 476
 477    FPolicies:=  Config.ReadBool('Server', 'Policies',  false);
 478    FMailbox:=   Config.ReadBool('Server', 'Mailbox',   false);
 479    FRelay:=     Config.ReadBool('Server', 'Relay',     false);
 480    FLog:=       Config.ReadBool('Server', 'Log',       false);
 481 end;
 482
 483 constructor TEMailProperties.Create;
 484 begin
 485    inherited Create;
 486    SetSize(0);
 487    WriteFlags(0);
 488 end;
 489
 490 constructor TIPNamePair.Create(const Name, IP: string);
 491 begin
 492    FName:= Name;
 493    FIP:= IP;
 494 end;
 495
 496 constructor TEnvelope.Create;
 497 begin
 498    inherited Create;
 499    FReturnPath:= '';
 500    FReturnPathSpecified:= false;
 501    FRelayHost:= '';
 502    SetLength(FRecipients, 0);
 503 end;
 504
 505 destructor TEnvelope.Destroy;
 506 begin
 507    SetLength(FRecipients, 0);
 508    inherited Destroy;
 509 end;
 510
 511
 512 { Object methods: }
 513
 514 procedure TArgumentParser.ParseArgument(Arg: string; const AllowedPrefixes: array of string);
 515 var i, n: integer; found: boolean;
 516 begin
 517    { Strip prefix if present. }
 518    i:= 0; found:= false;
 519    while ((i < Length(AllowedPrefixes)) and (not found)) do begin
 520       if pos(AllowedPrefixes[i], Arg) = 1 then
 521       begin
 522          Delete(Arg, 1, Length(AllowedPrefixes[i]));
 523          found:= true;
 524       end;
 525       Inc(i);
 526    end;
 527
 528    n:= Length(Arguments);
 529    SetLength(Arguments, n + 1);
 530    SplitParameters(Arg, Arguments[n].Option, Arguments[n].Value, '=');
 531    { To be case-insensitive: }
 532    Arguments[n].Option:= UpCase(Arguments[n].Option);
 533 end;
 534
 535 function TArgumentParser.GetArgument(ID: integer): TArgument;
 536 begin
 537    { No index checking... you'd better use it return value of ValidateArguments. }
 538    Result:= Arguments[ID];
 539 end;
 540
 541 function TArgumentParser.IsPresent(ArgumentName: string): boolean;
 542 var i: integer;
 543 begin
 544    i:= 0;
 545    while (i < Length(Arguments)) and (Arguments[i].Option <> UpCase(ArgumentName)) do
 546       Inc(i);
 547    Result:= i < Length(Arguments);
 548 end;
 549
 550 function TArgumentParser.GetValue(ArgumentName: string; DefValue: string = ''): string;
 551 var i: integer;
 552 begin
 553    i:= 0;
 554    while (i < Length(Arguments)) and (Arguments[i].Option <> UpCase(ArgumentName)) do
 555       Inc(i);
 556
 557    if i < Length(Arguments) then begin
 558       if Arguments[i].Value <> '' then
 559          Result:= Arguments[i].Value
 560       else
 561          Result:= DefValue;
 562    end
 563    else
 564       Result:= DefValue;
 565 end;
 566
 567 function TArgumentParser.ValidateArguments(ValidArguments: array of string): integer;
 568 { Returns -1 if all arguments are valid. Otherwise, returns the ID of the first
 569   invalid parameter. }
 570 var i: integer;
 571 begin
 572    i:= 0;
 573    while (i < Length(Arguments)) and InStringArray(Arguments[i].Option, ValidArguments) do
 574       Inc(i);
 575
 576    if i >= Length(Arguments) then
 577       Result:= -1
 578    else
 579       Result:= i;
 580 end;
 581
 582
 583 function TNamedObject.IsItYourName(const Name: string): boolean;
 584 begin
 585    Result:= FAliases.IndexOf(Name) <> -1;
 586 end;
 587
 588
 589 function TMainServerConfig.GetVersionStr: string;
 590 begin
 591    Result:= VERSION_STR;
 592 end;
 593
 594
 595 function TIPNamePair.Copy: TIPNamePair;
 596 begin
 597    Result:= TIPNamePair.Create(Name, IP);
 598 end;
 599
 600
 601 procedure TEMailProperties.SetSize(Value: longint);
 602 begin
 603    FSize:= Value;
 604 end;
 605
 606 procedure TEMailProperties.WriteFlags(Value: TEMailFlags);
 607 begin
 608    FFlags:= Value;
 609 end;
 610
 611 procedure TEMailProperties.SetFlag(Flag: TEMailFlags);
 612 begin
 613    FFlags:= FFlags or Flag;
 614 end;
 615
 616 function TEMailProperties.HasFlag(Flag: TEMailFlags): boolean;
 617 begin
 618    Result:= (FFlags and Flag) = Flag;
 619 end;
 620
 621
 622 function TEnvelope.GetNumberOfRecipients: integer;
 623 begin
 624    Result:= Length(FRecipients);
 625 end;
 626
 627 function TEnvelope.GetRecipient(Index: integer): TRecipient;
 628 begin
 629    Result:= FRecipients[Index];
 630 end;
 631
 632 function TEnvelope.IsComplete: boolean;
 633 begin
 634    Result:= FReturnPathSpecified and (Length(FRecipients) > 0);
 635 end;
 636
 637 procedure TEnvelope.AddRecipient(Address: string; Data: integer = 0; RMsg: string = '');
 638 var i: integer;
 639 begin
 640    i:= Length(FRecipients);
 641    SetLength(FRecipients, i + 1);
 642    FRecipients[i].Address:= Address;
 643    FRecipients[i].RMsg:= RMsg;
 644    FRecipients[i].Data:= Data;
 645 end;
 646
 647 procedure TEnvelope.AddRecipient(Recipient: TRecipient);
 648 var i: integer;
 649 begin
 650    i:= Length(FRecipients);
 651    SetLength(FRecipients, i + 1);
 652    FRecipients[i]:= Recipient;
 653 end;
 654
 655 procedure TEnvelope.SetRecipientData(Index, Data: integer; RMsg: string = '');
 656 begin
 657    FRecipients[Index].RMsg:= RMsg;
 658    FRecipients[Index].Data:= Data;
 659 end;
 660
 661 procedure TEnvelope.SetReturnPath(Address: string);
 662 begin
 663    FReturnPath:= Address;
 664    FReturnPathSpecified:= true;
 665 end;
 666
 667 procedure TEnvelope.SetRelayHost(HostName: string);
 668 begin
 669    FRelayHost:= HostName;
 670 end;
 671
 672
 673 end.