2 MegaBrutal's SMTP Server (MgSMTP)
3 Copyright (C) 2010-2014 MegaBrutal
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.
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.
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/>.
21 Responsible for manage rights for hosts and users, it also authenticates
30 uses SysUtils
, Classes
, INIFiles
, md5
, CompareWild
, Common
, Spool
;
34 { Rights can be assigned to connections and users. }
39 DEFAULT_RIGHTS
= RIGHT_CONNECT
;
46 PASSTYPE_INVALID
= 255;
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. }
64 TRuleHolder
= class(TStringList
)
65 constructor Create(WildcardSupport
: boolean);
67 FWildcardSupport
: boolean;
68 Rights
: array of TRights
;
70 procedure AddRights(ItemName
: string; AssignedRights
: TRights
);
71 function GetRightsOf(ItemName
: string): TRights
;
72 function GetRightsOfPair(FirstName
, SecondName
: string): TRights
;
75 { TPolicyObject holds the rights for one single object.
76 And additionally, it holds the databytes limit for it. }
79 constructor Create(Rights
: TRights
; Databytes
: longint);
83 procedure Reset(Rights
: TRights
; Databytes
: longint);
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
;
92 { TUserPolicies holds the data assigned for a single user, except
95 TUserPolicies
= class(TNamedObject
)
96 constructor Create(Name
: string; Config
: TINIFile
);
100 FPassType
: TPassType
;
103 function Authenticate(Password
: string): boolean;
104 property Databytes
: longint read FDatabytes
;
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. }
111 TPolicyManager
= class
112 constructor Create(Config
: TINIFile
);
113 destructor Destroy
; override;
115 FHideVersion
, FReqHELO
, FHosts
, FUsers
: boolean;
116 FMaxAuthAttempts
: integer;
118 HostRights
, UserRights
: TRuleHolder
;
119 UserData
: array of TUserPolicies
;
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
;
133 function RightsToStr(Rights
: TRights
): string;
134 function FCrDNSPolicyToStr(FCrDNSPolicy
: byte): string;
139 PolicyManager
: TPolicyManager
;
145 function StrToPassType(S
: string): TPassType
;
148 if S
= 'PLAIN' then Result
:= PASSTYPE_PLAIN
149 else if S
= 'MD5' then Result
:= PASSTYPE_MD5
150 else Result
:= PASSTYPE_INVALID
;
153 function StrToRights(S
: string): TRights
;
154 var SL
: TStringList
; i
: integer; R
: TRights
;
157 SL
:= TStringList
.Create
;
159 SL
.DelimitedText
:= S
;
162 for i
:= 0 to SL
.Count
- 1 do begin
164 if SL
.Strings
[i
] = 'ALLOWSTORE' then
167 else if SL
.Strings
[i
] = 'ALLOWRELAY' then
170 else if SL
.Strings
[i
] = 'CONNECT' then
171 R
:= R
or RIGHT_CONNECT
173 else if SL
.Strings
[i
] = 'DENYSTORE' then
174 R
:= R
and (ALL_RIGHTS
- RIGHT_STORE
)
176 else if SL
.Strings
[i
] = 'DENYRELAY' then
177 R
:= R
and (ALL_RIGHTS
- RIGHT_RELAY
)
179 else if SL
.Strings
[i
] = 'DISCONNECT' then
180 R
:= R
and (ALL_RIGHTS
- RIGHT_CONNECT
)
183 { !!! TODO: Somehow report error !!! }
192 function RightsToStr(Rights
: TRights
): string;
197 if S
<> '' then S
:= S
+ ', ';
203 if (Rights
and RIGHT_CONNECT
) <> 0 then
206 if (Rights
and RIGHT_STORE
) <> 0 then begin
207 AddSep
; S
:= S
+ 'STORE';
210 if (Rights
and RIGHT_RELAY
) <> 0 then begin
211 AddSep
; S
:= S
+ 'RELAY';
214 if S
= '' then S
:= '<NONE>';
218 function FCrDNSPolicyToStr(FCrDNSPolicy
: byte): string;
221 FCRDNS_NAIVE
: Result
:= 'Naive';
222 FCRDNS_AWARE
: Result
:= 'Aware';
223 FCRDNS_MEAN
: Result
:= 'Mean';
224 FCRDNS_STRICT
: Result
:= 'Strict';
225 else Result
:= 'Unknown';
230 constructor TRuleHolder
.Create(WildcardSupport
: boolean);
233 FWildcardSupport
:= WildcardSupport
;
234 SetLength(Rights
, 0);
238 constructor TPolicyObject
.Create(Rights
: TRights
; Databytes
: longint);
241 Reset(Rights
, Databytes
);
245 constructor TUserPolicies
.Create(Name
: string; Config
: TINIFile
);
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', '');
257 constructor TPolicyManager
.Create(Config
: TINIFile
);
258 var Section
, RS
, TS
: string; i
: integer; SL
: TStringList
;
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);
269 FMaxAuthAttempts
:= Config
.ReadInteger(Section
, 'MaxAuthAttempts', 0);
271 HostRights
:= TRuleHolder
.Create(true);
272 UserRights
:= TRuleHolder
.Create(false);
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
;
281 SL
:= TStringList
.Create
;
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
));
292 { Load the rules (rights) and other data for users. }
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
);
303 { Disable user authentication, if there are no users. }
304 FUsers
:= Length(UserData
) <> 0;
309 FHosts
:= false; FUsers
:= false; FReqHELO
:= false; FHideVersion
:= false;
310 FMaxAuthAttempts
:= 0;
311 FFCrDNSPolicy
:= FCRDNS_NAIVE
;
315 destructor TPolicyManager
.Destroy
;
320 for i
:= 0 to Length(UserData
) - 1 do
322 SetLength(UserData
, 0);
327 procedure TRuleHolder
.AddRights(ItemName
: string; AssignedRights
: TRights
);
332 SetLength(Rights
, i
+ 1);
333 Rights
[i
]:= AssignedRights
;
336 function TRuleHolder
.GetRightsOf(ItemName
: string): TRights
;
338 Result
:= GetRightsOfPair(ItemName
, '');
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
346 If there are no rights associated to the names, DEFAULT_RIGHTS will be
348 var i
: integer; f
: boolean;
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
))
355 f
:= (Strings
[i
] = FirstName
) or (Strings
[i
] = SecondName
);
359 if f
then Result
:= Rights
[i
] else Result
:= DEFAULT_RIGHTS
;
363 procedure TPolicyObject
.Reset(Rights
: TRights
; Databytes
: longint);
365 FRights
:= Rights
; FDatabytes
:= Databytes
;
368 procedure TPolicyObject
.Grant(Right
: TRights
);
370 FRights
:= FRights
or Right
;
373 procedure TPolicyObject
.Deny(Right
: TRights
);
375 FRights
:= FRights
and (not Right
);
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. }
382 Result
:= (FRights
and Right
) = Right
;
385 function TPolicyObject
.RightsStr
: string;
387 Result
:= RightsToStr(FRights
);
391 function TUserPolicies
.Authenticate(Password
: string): boolean;
396 Result
:= FPassword
= Password
;
399 Result
:= FPassword
= MD5Print(MD5String(Password
));
402 { I can't authenticate anything with an invalid password type. }
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;
415 if (MainServerConfig
.Policies
) and (FUsers
) then begin
417 while (i
< Length(UserData
)) and (not f
) do begin
418 f
:= UserData
[i
].IsItYourName(Username
);
424 if UserData
[i
].Authenticate(Password
) then begin
425 PolicyObject
.Reset(UserRights
.GetRightsOf(Username
), UserData
[i
].Databytes
);
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. }
439 if MainServerConfig
.Policies
then begin
440 Result
:= TPolicyObject
.Create(
441 HostRights
.GetRightsOfPair(Originator
.Name
, Originator
.IP
),
442 SpoolManager
.Databytes
446 Result
:= TPolicyObject
.Create(
448 SpoolManager
.Databytes
453 procedure TPolicyManager
.RevalidatePolicyObject(PolicyObject
: TPolicyObject
; Originator
: TIPNamePair
; EvaluateHostname
, MeanMode
: boolean);
454 var RestrictiveMask
: TRights
;
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
)
460 PolicyObject
.Reset(HostRights
.GetRightsOf(Originator
.IP
) and RestrictiveMask
, PolicyObject
.Databytes
);