Policies.pas

   1 {
   2    MegaBrutal's SMTP Server (MgSMTP)
   3    Copyright (C) 2010-2014 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: Policies
  21    Responsible for manage rights for hosts and users, it also authenticates
  22    users.
  23 }
  24
  25
  26 {$MODE DELPHI}
  27 unit Policies;
  28
  29 interface
  30 uses SysUtils, Classes, INIFiles, md5, CompareWild, Common, Spool;
  31
  32 const
  33
  34    { Rights can be assigned to connections and users. }
  35    RIGHT_CONNECT      =   1;
  36    RIGHT_STORE        =   2;
  37    RIGHT_RELAY        =   4;
  38
  39    DEFAULT_RIGHTS     = RIGHT_CONNECT;
  40    ALL_RIGHTS         = 255;
  41
  42
  43    { Password types: }
  44    PASSTYPE_PLAIN     =   0;
  45    PASSTYPE_MD5       =   1;
  46    PASSTYPE_INVALID   = 255;
  47
  48    { FCrDNS policies: }
  49    FCRDNS_NAIVE       =   0;
  50    FCRDNS_AWARE       =   1;
  51    FCRDNS_MEAN        =   2;
  52    FCRDNS_STRICT      =   3;
  53
  54
  55 type
  56
  57    TRights = byte;
  58    TPassType = byte;
  59
  60    { TRuleHolder administers the rule table (given in the configuration)
  61      for hosts or users, and it's capable of holding anything else's
  62      rights that may have rights at all. }
  63
  64    TRuleHolder = class(TStringList)
  65       constructor Create(WildcardSupport: boolean);
  66    protected
  67       FWildcardSupport: boolean;
  68       Rights: array of TRights;
  69    public
  70       procedure AddRights(ItemName: string; AssignedRights: TRights);
  71       function GetRightsOf(ItemName: string): TRights;
  72       function GetRightsOfPair(FirstName, SecondName: string): TRights;
  73    end;
  74
  75    { TPolicyObject holds the rights for one single object.
  76      And additionally, it holds the databytes limit for it. }
  77
  78    TPolicyObject = class
  79       constructor Create(Rights: TRights; Databytes: longint);
  80    protected
  81       FRights: TRights;
  82       FDatabytes: longint;
  83       procedure Reset(Rights: TRights; Databytes: longint);
  84    public
  85       procedure Grant(Right: TRights);
  86       procedure Deny(Right: TRights);
  87       function HasRight(Right: TRights): boolean;
  88       function RightsStr: string;
  89       property Databytes: longint read FDatabytes;
  90    end;
  91
  92    { TUserPolicies holds the data assigned for a single user, except
  93      rights. }
  94
  95    TUserPolicies = class(TNamedObject)
  96       constructor Create(Name: string; Config: TINIFile);
  97    protected
  98       FAuth: boolean;
  99       FDatabytes: longint;
 100       FPassType: TPassType;
 101       FPassword: string;
 102    public
 103       function Authenticate(Password: string): boolean;
 104       property Databytes: longint read FDatabytes;
 105    end;
 106
 107    { TPolicyManager is the interface for this unit. It sets up objects
 108      corresponding the configuration, creates policy objects on request,
 109      authenticates users, and so on. }
 110
 111    TPolicyManager = class
 112       constructor Create(Config: TINIFile);
 113       destructor Destroy; override;
 114    protected
 115       FHideVersion, FReqHELO, FHosts, FUsers: boolean;
 116       FMaxAuthAttempts: integer;
 117       FFCrDNSPolicy: byte;
 118       HostRights, UserRights: TRuleHolder;
 119       UserData: array of TUserPolicies;
 120    public
 121       function AuthenticateUser(Username, Password: string; PolicyObject: TPolicyObject): boolean;
 122       function MakePolicyObject(Originator: TIPNamePair): TPolicyObject;
 123       procedure RevalidatePolicyObject(PolicyObject: TPolicyObject; Originator: TIPNamePair; EvaluateHostname, MeanMode: boolean);
 124       property HideVersion: boolean read FHideVersion;
 125       property ReqHELO: boolean read FReqHELO;
 126       property Hosts: boolean read FHosts;
 127       property Users: boolean read FUsers;
 128       property MaxAuthAttempts: integer read FMaxAuthAttempts;
 129       property FCrDNSPolicy: byte read FFCrDNSPolicy;
 130    end;
 131
 132
 133    function RightsToStr(Rights: TRights): string;
 134    function FCrDNSPolicyToStr(FCrDNSPolicy: byte): string;
 135
 136
 137 var
 138
 139    PolicyManager: TPolicyManager;
 140
 141
 142 implementation
 143
 144
 145 function StrToPassType(S: string): TPassType;
 146 begin
 147    S:= UpperCase(S);
 148    if S = 'PLAIN' then     Result:= PASSTYPE_PLAIN
 149    else if S = 'MD5' then  Result:= PASSTYPE_MD5
 150    else                    Result:= PASSTYPE_INVALID;
 151 end;
 152
 153 function StrToRights(S: string): TRights;
 154 var SL: TStringList; i: integer; R: TRights;
 155 begin
 156    S:= UpperCase(S);
 157    SL:= TStringList.Create;
 158    SL.Delimiter:= ',';
 159    SL.DelimitedText:= S;
 160    R:= DEFAULT_RIGHTS;
 161
 162    for i:= 0 to SL.Count - 1 do begin
 163
 164       if SL.Strings[i] = 'ALLOWSTORE' then
 165          R:= R or RIGHT_STORE
 166
 167       else if SL.Strings[i] = 'ALLOWRELAY' then
 168          R:= R or RIGHT_RELAY
 169
 170       else if SL.Strings[i] = 'CONNECT' then
 171          R:= R or RIGHT_CONNECT
 172
 173       else if SL.Strings[i] = 'DENYSTORE' then
 174          R:= R and (ALL_RIGHTS - RIGHT_STORE)
 175
 176       else if SL.Strings[i] = 'DENYRELAY' then
 177          R:= R and (ALL_RIGHTS - RIGHT_RELAY)
 178
 179       else if SL.Strings[i] = 'DISCONNECT' then
 180          R:= R and (ALL_RIGHTS - RIGHT_CONNECT)
 181
 182       else
 183          { !!! TODO: Somehow report error !!! }
 184          ;
 185
 186    end;
 187
 188    SL.Free;
 189    Result:= R;
 190 end;
 191
 192 function RightsToStr(Rights: TRights): string;
 193 var S: string;
 194
 195    procedure AddSep;
 196    begin
 197       if S <> '' then S:= S + ', ';
 198    end;
 199
 200 begin
 201    S:= '';
 202
 203    if (Rights and RIGHT_CONNECT) <> 0 then
 204       S:= 'CONNECT';
 205
 206    if (Rights and RIGHT_STORE) <> 0 then begin
 207       AddSep; S:= S + 'STORE';
 208    end;
 209
 210    if (Rights and RIGHT_RELAY) <> 0 then begin
 211       AddSep; S:= S + 'RELAY';
 212    end;
 213
 214    if S = '' then S:= '<NONE>';
 215    Result:= S;
 216 end;
 217
 218 function FCrDNSPolicyToStr(FCrDNSPolicy: byte): string;
 219 begin
 220    case FCrDNSPolicy of
 221       FCRDNS_NAIVE:  Result:= 'Naive';
 222       FCRDNS_AWARE:  Result:= 'Aware';
 223       FCRDNS_MEAN:   Result:= 'Mean';
 224       FCRDNS_STRICT: Result:= 'Strict';
 225       else           Result:= 'Unknown';
 226    end;
 227 end;
 228
 229
 230 constructor TRuleHolder.Create(WildcardSupport: boolean);
 231 begin
 232    inherited Create;
 233    FWildcardSupport:= WildcardSupport;
 234    SetLength(Rights, 0);
 235 end;
 236
 237
 238 constructor TPolicyObject.Create(Rights: TRights; Databytes: longint);
 239 begin
 240    inherited Create;
 241    Reset(Rights, Databytes);
 242 end;
 243
 244
 245 constructor TUserPolicies.Create(Name: string; Config: TINIFile);
 246 var Section: string;
 247 begin
 248    Section:= 'Policies\Users\' + Name;
 249    inherited Create(Name, Config, Section);
 250    FAuth:=        Config.ReadBool(Section, 'Auth', true);
 251    FDatabytes:=   Config.ReadInteger(Section, 'Databytes', SpoolManager.Databytes);
 252    FPassType:=    StrToPassType(Config.ReadString(Section, 'PassType', 'plain'));
 253    FPassword:=    Config.ReadString(Section, 'Password', '');
 254 end;
 255
 256
 257 constructor TPolicyManager.Create(Config: TINIFile);
 258 var Section, RS, TS: string; i: integer; SL: TStringList;
 259 begin
 260    inherited Create;
 261    SetLength(UserData, 0);
 262    if MainServerConfig.Policies then begin
 263       Section:= 'Policies';
 264       FHideVersion:= Config.ReadBool(Section, 'HideVersion', false);
 265       FHosts:=       Config.ReadBool(Section, 'Hosts', true);
 266       FUsers:=       Config.ReadBool(Section, 'Users', true);
 267       FReqHELO:=     Config.ReadBool(Section, 'ReqHELO', false);
 268
 269       FMaxAuthAttempts:= Config.ReadInteger(Section, 'MaxAuthAttempts', 0);
 270
 271       HostRights:=   TRuleHolder.Create(true);
 272       UserRights:=   TRuleHolder.Create(false);
 273
 274       { Load FCrDNSPolicy. }
 275       TS:= UpperCase(Config.ReadString(Section, 'FCrDNSPolicy', 'AWARE'));
 276       if TS = 'AWARE' then FFCrDNSPolicy:= FCRDNS_AWARE
 277       else if TS = 'MEAN' then FFCrDNSPolicy:= FCRDNS_MEAN
 278       else if TS = 'STRICT' then FFCrDNSPolicy:= FCRDNS_STRICT
 279       else FFCrDNSPolicy:= FCRDNS_NAIVE;
 280
 281       SL:= TStringList.Create;
 282
 283       { Load the rules (rights) for hosts. }
 284       Config.ReadSection(Section + '\Hosts', SL);
 285       for i:= 0 to SL.Count - 1 do begin
 286          RS:= Config.ReadString(Section + '\Hosts', SL.Strings[i], '');
 287          HostRights.AddRights(SL.Strings[i], StrToRights(RS));
 288       end;
 289
 290       SL.Clear;
 291
 292       { Load the rules (rights) and other data for users. }
 293       if FUsers then begin
 294          Config.ReadSection(Section + '\Users', SL);
 295          SetLength(UserData, SL.Count);
 296          for i:= 0 to SL.Count - 1 do begin
 297             RS:= Config.ReadString(Section + '\Users', SL.Strings[i], '');
 298             UserRights.AddRights(SL.Strings[i], StrToRights(RS));
 299             UserData[i]:= TUserPolicies.Create(SL.Strings[i], Config);
 300          end;
 301       end;
 302
 303       { Disable user authentication, if there are no users. }
 304       FUsers:= Length(UserData) <> 0;
 305
 306       SL.Free;
 307    end
 308    else begin
 309       FHosts:= false; FUsers:= false; FReqHELO:= false; FHideVersion:= false;
 310       FMaxAuthAttempts:= 0;
 311       FFCrDNSPolicy:= FCRDNS_NAIVE;
 312    end;
 313 end;
 314
 315 destructor TPolicyManager.Destroy;
 316 var i: integer;
 317 begin
 318    HostRights.Free;
 319    UserRights.Free;
 320    for i:= 0 to Length(UserData) - 1 do
 321       UserData[i].Free;
 322    SetLength(UserData, 0);
 323    inherited Destroy;
 324 end;
 325
 326
 327 procedure TRuleHolder.AddRights(ItemName: string; AssignedRights: TRights);
 328 var i: integer;
 329 begin
 330    i:= Count;
 331    Add(ItemName);
 332    SetLength(Rights, i + 1);
 333    Rights[i]:= AssignedRights;
 334 end;
 335
 336 function TRuleHolder.GetRightsOf(ItemName: string): TRights;
 337 begin
 338    Result:= GetRightsOfPair(ItemName, '');
 339 end;
 340
 341 function TRuleHolder.GetRightsOfPair(FirstName, SecondName: string): TRights;
 342 { GetRightsOfPair takes 2 names, usually a hostname and an IP, and checks
 343   which entry in the rule table matches for any of them, in the correct order.
 344   It only jumps to the next item of the list if neither of the names match
 345   for the actual one.
 346   If there are no rights associated to the names, DEFAULT_RIGHTS will be
 347   returned. }
 348 var i: integer; f: boolean;
 349 begin
 350    i:= 0; f:= false;
 351    while (i < Count) and (not f) do begin
 352       if FWildcardSupport then
 353          f:= WildComp(UpperCase(Strings[i]), UpperCase(FirstName)) or WildComp(UpperCase(Strings[i]), UpperCase(SecondName))
 354       else
 355          f:= (Strings[i] = FirstName) or (Strings[i] = SecondName);
 356       Inc(i);
 357    end;
 358    Dec(i);
 359    if f then Result:= Rights[i] else Result:= DEFAULT_RIGHTS;
 360 end;
 361
 362
 363 procedure TPolicyObject.Reset(Rights: TRights; Databytes: longint);
 364 begin
 365    FRights:= Rights; FDatabytes:= Databytes;
 366 end;
 367
 368 procedure TPolicyObject.Grant(Right: TRights);
 369 begin
 370    FRights:= FRights or Right;
 371 end;
 372
 373 procedure TPolicyObject.Deny(Right: TRights);
 374 begin
 375    FRights:= FRights and (not Right);
 376 end;
 377
 378 function TPolicyObject.HasRight(Right: TRights): boolean;
 379 { If "Right" has more than one right-flags set, the function only returns
 380   TRUE, when the object has all the rights. }
 381 begin
 382    Result:= (FRights and Right) = Right;
 383 end;
 384
 385 function TPolicyObject.RightsStr: string;
 386 begin
 387    Result:= RightsToStr(FRights);
 388 end;
 389
 390
 391 function TUserPolicies.Authenticate(Password: string): boolean;
 392 begin
 393    case FPassType of
 394
 395    PASSTYPE_PLAIN:
 396       Result:= FPassword = Password;
 397
 398    PASSTYPE_MD5:
 399       Result:= FPassword = MD5Print(MD5String(Password));
 400
 401    else
 402       { I can't authenticate anything with an invalid password type. }
 403       Result:= false;
 404
 405    end;
 406
 407 end;
 408
 409
 410 function TPolicyManager.AuthenticateUser(Username, Password: string; PolicyObject: TPolicyObject): boolean;
 411 { Authenticates a user, returns true if successful, and updates PolicyObject
 412   with the new rights acquired. }
 413 var i: integer; f: boolean;
 414 begin
 415    if (MainServerConfig.Policies) and (FUsers) then begin
 416       i:= 0; f:= false;
 417       while (i < Length(UserData)) and (not f) do begin
 418          f:= UserData[i].IsItYourName(Username);
 419          Inc(i);
 420       end;
 421       Dec(i);
 422
 423       if f then begin
 424          if UserData[i].Authenticate(Password) then begin
 425             PolicyObject.Reset(UserRights.GetRightsOf(Username), UserData[i].Databytes);
 426             Result:= true;
 427          end
 428          else Result:= false;
 429       end
 430       else Result:= false;
 431    end
 432    else Result:= false;
 433 end;
 434
 435 function TPolicyManager.MakePolicyObject(Originator: TIPNamePair): TPolicyObject;
 436 { Make a policy object, and assign the rights corresponding to the given
 437   originator. If Policies are disabled by configuration, assign ALL_RIGHTS. }
 438 begin
 439    if MainServerConfig.Policies then begin
 440       Result:= TPolicyObject.Create(
 441                   HostRights.GetRightsOfPair(Originator.Name, Originator.IP),
 442                   SpoolManager.Databytes
 443                );
 444    end
 445    else begin
 446       Result:= TPolicyObject.Create(
 447                   ALL_RIGHTS,
 448                   SpoolManager.Databytes
 449                );
 450    end;
 451 end;
 452
 453 procedure TPolicyManager.RevalidatePolicyObject(PolicyObject: TPolicyObject; Originator: TIPNamePair; EvaluateHostname, MeanMode: boolean);
 454 var RestrictiveMask: TRights;
 455 begin
 456    if MeanMode then RestrictiveMask:= PolicyObject.FRights else RestrictiveMask:= ALL_RIGHTS;
 457    if EvaluateHostname then
 458       PolicyObject.Reset(HostRights.GetRightsOfPair(Originator.Name, Originator.IP) and RestrictiveMask, PolicyObject.Databytes)
 459    else
 460       PolicyObject.Reset(HostRights.GetRightsOf(Originator.IP) and RestrictiveMask, PolicyObject.Databytes);
 461 end;
 462
 463
 464 end.