policies.pm 20.3 KB
Newer Older
Nigel Kukard's avatar
Nigel Kukard committed
1
# Policy handling functions
2
# Copyright (C) 2009-2017, AllWorldIT
Nigel Kukard's avatar
Nigel Kukard committed
3
# Copyright (C) 2008, LinuxRulz
Nigel Kukard's avatar
Nigel Kukard committed
4
#
Nigel Kukard's avatar
Nigel Kukard committed
5
6
7
8
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
Nigel Kukard's avatar
Nigel Kukard committed
9
#
Nigel Kukard's avatar
Nigel Kukard committed
10
11
12
13
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
Nigel Kukard's avatar
Nigel Kukard committed
14
#
Nigel Kukard's avatar
Nigel Kukard committed
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.


package cbp::policies;

use strict;
use warnings;

# Exporter stuff
require Exporter;
our (@ISA,@EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
	getPolicy
31
32
	encodePolicyData
	decodePolicyData
Nigel Kukard's avatar
Nigel Kukard committed
33
34
35
);


36
use cbp::logging;
Nigel Kukard's avatar
Nigel Kukard committed
37
38
use awitpt::cache;
use awitpt::db::dblayer;
Nigel Kukard's avatar
Nigel Kukard committed
39
use awitpt::netip;
Nigel Kukard's avatar
Nigel Kukard committed
40
41
use cbp::system;

42
43
use Data::Dumper;

Nigel Kukard's avatar
Nigel Kukard committed
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

# Database handle
my $dbh = undef;

# Our current error message
my $error = "";

# Set current error message
# Args: error_message
sub setError
{
	my $err = shift;
	my ($package,$filename,$line) = caller;
	my (undef,undef,undef,$subroutine) = caller(1);

	# Set error
	$error = "$subroutine($line): $err";
}

# Return current error message
# Args: none
sub Error
{
	my $err = $error;

	# Reset error
	$error = "";

	# Return error
	return $err;
}


77
78
79
# Return a hash of policies matches
# Returns:
# 	Hash - indexed by policy priority, the value is an array of policy ID's
Nigel Kukard's avatar
Nigel Kukard committed
80
81
sub getPolicy
{
82
	my ($server,$sessionData) = @_;
83
	my $log = defined($server->{'config'}{'logging'}{'policies'});
Nigel Kukard's avatar
Nigel Kukard committed
84
85


86
87
	$server->log(LOG_DEBUG,"[POLICIES] Going to resolve session data into policy: ".Dumper($sessionData)) if ($log);

Nigel Kukard's avatar
Nigel Kukard committed
88
	# Start with blank policy list
89
	my $matchedPolicies = { };
Nigel Kukard's avatar
Nigel Kukard committed
90
91


Nigel Kukard's avatar
Nigel Kukard committed
92
93
94
95
	# Grab policy members from database
	my $policyMembers = getPolicyMembers($server,$log);
	if (ref($policyMembers) ne "ARRAY") {
		$server->log(LOG_DEBUG,"[POLICIES] Error while retriving policy members: $policyMembers");
96
97
		# Return blank set
		return $matchedPolicies;
Nigel Kukard's avatar
Nigel Kukard committed
98
99
	}

100
	# Process the Members
Nigel Kukard's avatar
Nigel Kukard committed
101
	foreach my $policyMember (@{$policyMembers}) {
Nigel Kukard's avatar
Nigel Kukard committed
102
		# Make debugging a bit easier
103
		my $debugTxt = sprintf('[PolicyID:%s/MemberID:%s/Priority:%s/Name:%s]',$policyMember->{'PolicyID'},$policyMember->{'ID'},$policyMember->{'Priority'},$policyMember->{'Name'});
Nigel Kukard's avatar
Nigel Kukard committed
104
105
106
107

		#
		# Source Test
		#
Nigel Kukard's avatar
Nigel Kukard committed
108
109
110
111
		my $sourceMatch = 0;

		# No source or "any"
		if (!defined($policyMember->{'Source'}) || lc($policyMember->{'Source'}) eq "any") {
112
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: Source not defined or 'any', explicit match: matched=1") if ($log);
Nigel Kukard's avatar
Nigel Kukard committed
113
114
115
			$sourceMatch = 1;

		} else {
Nigel Kukard's avatar
Nigel Kukard committed
116
			# Split off sources
117
			my @rawSources = split(/,/,$policyMember->{'Source'});
Nigel Kukard's avatar
Nigel Kukard committed
118

119
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: Main policy sources '".join(',',@rawSources)."'") if ($log);
Nigel Kukard's avatar
Nigel Kukard committed
120

121
			# Default to no match
122
			my $history = {};  # Used to track depth & loops
123
124
			foreach my $item (@rawSources) {
				# Process item
125
				my $res = policySourceItemMatches($server,$debugTxt,$history,$item,$sessionData);
126
127
128
129
130
131
132
133
				# Check for error
				if ($res < 0) {
					$server->log(LOG_WARN,"[POLICIES] $debugTxt: Error while processing source item '$item', skipping...");
					$sourceMatch = 0;
					last;
				# Check for success
				} elsif ($res == 1) {
					$sourceMatch = 1;
134
				# Check for failure, 0 and anything else
Nigel Kukard's avatar
Nigel Kukard committed
135
				} else {
136
137
					$sourceMatch = 0;
					last;
Nigel Kukard's avatar
Nigel Kukard committed
138
139
140
				}
			}
		}
Nigel Kukard's avatar
Nigel Kukard committed
141

142
		$server->log(LOG_INFO,"[POLICIES] $debugTxt: Source matching result: matched=$sourceMatch") if($log);
Nigel Kukard's avatar
Nigel Kukard committed
143
144
		# Check if we passed the tests
		next if (!$sourceMatch);
Nigel Kukard's avatar
Nigel Kukard committed
145
146
147
148

		#
		# Destination Test
		#
Nigel Kukard's avatar
Nigel Kukard committed
149
150
151
152
		my $destinationMatch = 0;

		# No destination or "any"
		if (!defined($policyMember->{'Destination'}) || lc($policyMember->{'Destination'}) eq "any") {
153
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: Destination not defined or 'any', explicit match: matched=1") if ($log);
Nigel Kukard's avatar
Nigel Kukard committed
154
			$destinationMatch = 1;
Nigel Kukard's avatar
Nigel Kukard committed
155

Nigel Kukard's avatar
Nigel Kukard committed
156
		} else {
Nigel Kukard's avatar
Nigel Kukard committed
157
			# Split off destinations
158
			my @rawDestinations = split(/,/,$policyMember->{'Destination'});
Nigel Kukard's avatar
Nigel Kukard committed
159

160
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: Main policy destinations '".join(',',@rawDestinations)."'") if ($log);
Nigel Kukard's avatar
Nigel Kukard committed
161
162

			# Parse in group data
163
			my $history = {};  # Used to track depth & loops
164
165
			foreach my $item (@rawDestinations) {
				# Process item
166
				my $res = policyDestinationItemMatches($server,$debugTxt,$history,$item,$sessionData);
167
168
169
170
171
172
173
174
				# Check for error
				if ($res < 0) {
					$server->log(LOG_WARN,"[POLICIES] $debugTxt: Error while processing destination item '$item', skipping...");
					$destinationMatch = 0;
					last;
				# Check for success
				} elsif ($res == 1) {
					$destinationMatch = 1;
175
				# Check for failure, 0 and anything else
Nigel Kukard's avatar
Nigel Kukard committed
176
				} else {
177
178
					$destinationMatch = 0;
					last;
Nigel Kukard's avatar
Nigel Kukard committed
179
180
181
				}
			}
		}
Nigel Kukard's avatar
Nigel Kukard committed
182
183
184
		$server->log(LOG_INFO,"[POLICIES] $debugTxt: Destination matching result: matched=$destinationMatch") if ($log);
		# Check if we passed the tests
		next if (!$destinationMatch);
Nigel Kukard's avatar
Nigel Kukard committed
185

186
		$matchedPolicies->{$policyMember->{'Priority'}}->{$policyMember->{'PolicyID'}} = 1;
187
		last;
Nigel Kukard's avatar
Nigel Kukard committed
188
189
	}

190
191
192
193
194
195
196
	# Work through the list and build our result, which is a priority hash with matches as an array
	foreach my $prio (sort {$a <=> $b} keys %{$matchedPolicies}) {
		my @policies = keys %{$matchedPolicies->{$prio}};

		$server->log(LOG_DEBUG,"[POLICIES] END RESULT: prio=$prio => policy ids: ".join(',',@policies)) if ($log);
		# Change from a hash to an array...
		$matchedPolicies->{$prio} = \@policies;
Nigel Kukard's avatar
Nigel Kukard committed
197
	}
Nigel Kukard's avatar
Nigel Kukard committed
198

199
	return $matchedPolicies;
Nigel Kukard's avatar
Nigel Kukard committed
200
201
202
}


Nigel Kukard's avatar
Nigel Kukard committed
203
204
205
206
207
208
209
210
211
# Return an array of the policy members from the database
# Returns:
#	Array - array of policy members
sub getPolicyMembers
{
	my ($server,$log) = @_;


	# Check cache
212
213
214
215
216
#	my ($cache_res,$cache) = cacheGetComplexKeyPair('Policies','Members');
#	if ($cache_res) {
#		return awitpt::cache::Error();
#	}
#	return $cache if (defined($cache));
Nigel Kukard's avatar
Nigel Kukard committed
217
218
219

	# Grab all the policy members
	my $sth = DBSelect('
Nigel Kukard's avatar
Nigel Kukard committed
220
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
221
			@TP@policies.Name, @TP@policies.Priority, @TP@policies.Disabled AS PolicyDisabled,
Nigel Kukard's avatar
Nigel Kukard committed
222
			@TP@policy_members.ID, @TP@policy_members.PolicyID, @TP@policy_members.Source,
Nigel Kukard's avatar
Nigel Kukard committed
223
224
225
226
227
228
229
			@TP@policy_members.Destination, @TP@policy_members.Disabled AS MemberDisabled
		FROM
			@TP@policies, @TP@policy_members
		WHERE
			@TP@policies.Disabled = 0
			AND @TP@policy_members.Disabled = 0
			AND @TP@policy_members.PolicyID = @TP@policies.ID
230
		ORDER BY @TP@policies.Priority ASC
Nigel Kukard's avatar
Nigel Kukard committed
231
232
	');
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
233
234
		$server->log(LOG_DEBUG,"[POLICIES] Error while selecing policy members from database: ".
				awitpt::db::dblayer::Error());
Nigel Kukard's avatar
Nigel Kukard committed
235
236
237
238
239
		return undef;
	}

	# Loop with results
	my @policyMembers;
240
241
242
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
			qw( Name Priority PolicyDisabled ID PolicyID Source Destination MemberDisabled )
	)) {
Nigel Kukard's avatar
Nigel Kukard committed
243
		# Log what we see
244
		my $debugTxt = sprintf('[PolicyID:%s/MemberID:%s/Priority:%s/Name:%s]',$row->{'PolicyID'},$row->{'ID'},$row->{'Priority'},$row->{'Name'});
245
		if ($row->{'PolicyDisabled'} eq "1") {
246
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: getPolicyMembers - Policy disabled, policy member not returned") if ($log);
247
		} elsif ($row->{'MemberDisabled'} eq "1") {
248
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: getPOlicyMembers - Policy member disabled, policy member not returned") if ($log);
Nigel Kukard's avatar
Nigel Kukard committed
249
		} else {
250
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: getPolicyMembers - Policy member returned") if ($log);
251
			push(@policyMembers, $row);
Nigel Kukard's avatar
Nigel Kukard committed
252
253
		}
	}
Nigel Kukard's avatar
Nigel Kukard committed
254

Nigel Kukard's avatar
Nigel Kukard committed
255
	# Cache this
256
257
258
259
#	$cache_res = cacheStoreComplexKeyPair('Policies','Members',\@policyMembers);
#	if ($cache_res) {
#		return awitpt::cache::Error();
#	}
Nigel Kukard's avatar
Nigel Kukard committed
260
261
262
263
264
265

	return \@policyMembers;
}



Nigel Kukard's avatar
Nigel Kukard committed
266
267
268
269
270
271
272

# Get group members from group name
sub getGroupMembers
{
	my $group = shift;


Nigel Kukard's avatar
Nigel Kukard committed
273
274
275
	# Check cache
	my ($cache_res,$cache) = cacheGetKeyPair('Policies/Groups/Name-to-Members',$group);
	if ($cache_res) {
Nigel Kukard's avatar
Nigel Kukard committed
276
		return awitpt::cache::Error();
Nigel Kukard's avatar
Nigel Kukard committed
277
278
279
280
281
282
	}
	if (defined($cache)) {
		my @groupMembers = split(/,/,$cache);
		return \@groupMembers;
	}

Nigel Kukard's avatar
Nigel Kukard committed
283
	# Grab group members
Nigel Kukard's avatar
Nigel Kukard committed
284
	my $sth = DBSelect('
Nigel Kukard's avatar
Nigel Kukard committed
285
		SELECT
Nigel Kukard's avatar
Nigel Kukard committed
286
			@TP@policy_group_members.Member
Nigel Kukard's avatar
Nigel Kukard committed
287
		FROM
Nigel Kukard's avatar
Nigel Kukard committed
288
			@TP@policy_groups, @TP@policy_group_members
Nigel Kukard's avatar
Nigel Kukard committed
289
		WHERE
Nigel Kukard's avatar
Nigel Kukard committed
290
291
292
293
294
295
296
			@TP@policy_groups.Name = ?
			AND @TP@policy_groups.ID = @TP@policy_group_members.PolicyGroupID
			AND @TP@policy_groups.Disabled = 0
			AND @TP@policy_group_members.Disabled = 0
		',
		$group
	);
Nigel Kukard's avatar
Nigel Kukard committed
297
	if (!$sth) {
Nigel Kukard's avatar
Nigel Kukard committed
298
		return awitpt::db::dblayer::Error();
Nigel Kukard's avatar
Nigel Kukard committed
299
300
	}
	# Pull in groups
301
	my @groupMembers;
302
303
	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw( Member ))) {
		push(@groupMembers,$row->{'Member'});
Nigel Kukard's avatar
Nigel Kukard committed
304
305
	}

Nigel Kukard's avatar
Nigel Kukard committed
306
307
308
	# Cache this
	$cache_res = cacheStoreKeyPair('Policies/Groups/Name-to-Members',$group,join(',',@groupMembers));
	if ($cache_res) {
Nigel Kukard's avatar
Nigel Kukard committed
309
		return awitpt::cache::Error();
Nigel Kukard's avatar
Nigel Kukard committed
310
311
	}

312
	return \@groupMembers;
Nigel Kukard's avatar
Nigel Kukard committed
313
314
315
}


316
317
318
# Check if this source item matches, this function automagically resolves groups aswell
sub policySourceItemMatches
{
319
	my ($server,$debugTxt,$history,$rawItem,$sessionData) = @_;
320
321
322
323
324
325
326
	my $log = defined($server->{'config'}{'logging'}{'policies'});


	# Rip out negate if we have it, and clean the item
	my ($negate,$tmpItem) = ($rawItem =~ /^(!)?(.*)/);
	# See if we match %, if we do its a group
	my ($isGroup,$item) = ($tmpItem =~ /^(%)?(.*)/);
327
328
329
330
331
332
	# IPv6 match components
	my $v6c = '[a-f\d]{1,4}';
	my $v6cg = "(?:$v6c:){0,6}";
	my $v6c1 = "$v6cg?:?:?$v6cg?(?:$v6c)?";
	my $v6m = '(?:\/\d{1,3})';
	my $v6 = "$v6c1$v6m?";
Nigel Kukard's avatar
Nigel Kukard committed
333

334
335
336
	# Check if this is a group
	my $match = 0;
	if ($isGroup) {
337
338
339
340
341
		# Make sure we're not looping
		if (defined($history->{$item})) {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: Source policy group '$item' appears to be used more than once, possible loop, aborting!");
			return -1;
		}
Nigel Kukard's avatar
Nigel Kukard committed
342

343
344
345
346
347
348
349
350
		# We going deeper, record the depth
		$history->{$item} = keys(%{$history});
		# Check if we not tooo deep
		if ($history->{$item} > 5) {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: This source policy is recursing too deep, aborting!");
			return -1;
		}

351
352
353
354
355
356
		# Get group members
		my $groupMembers = getGroupMembers($item);
		if (ref $groupMembers ne "ARRAY") {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: Error '$groupMembers' while retrieving group members for source group '$item'");
			return -1;
		}
357
		$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: Group '$item' has ".@{$groupMembers}." source(s) => ".join(',',@{$groupMembers})) if ($log);
358
359
360
361
		# Check if actually have any
		if (@{$groupMembers} > 0) {
			foreach my $gmember (@{$groupMembers}) {
				# Process this group member
362
				my $res = policySourceItemMatches($server,"$debugTxt=>(group:$item)",$history,$gmember,$sessionData);
363
364
365
				# Check for hard error
				if ($res < 0) {
					return $res;
366
				# Check for match
367
				} elsif ($res) {
368
369
370
371
372
373
374
					$match = 1;
					last;
				}
			}
		} else {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: No group members for source group '$item'");
		}
375
		$server->log(LOG_DEBUG,"[POLICIES] $debugTxt=>(group:$item): Source group result: matched=$match") if ($log);
376
377
378
379
380

	# Normal member
	} else {
		my $res = 0;

381
382
		# Match IPv4 or IPv6
		if (
Nigel Kukard's avatar
Nigel Kukard committed
383
			$item =~ /^(?:\d{1,3})(?:\.(?:\d{1,3})(?:\.(?:\d{1,3})(?:\.(?:\d{1,3}))?)?)?(?:\/(\d{1,2}))?$/ ||
384
			$item =~ /^$v6$/i
385
		) {
Nigel Kukard's avatar
Nigel Kukard committed
386
			# See if we get an object from
387
388
389
			my $matchRange = new awitpt::netip($item);
			if (!defined($matchRange)) {
				$server->log(LOG_WARN,"[POLICIES] $debugTxt: - Resolved source '$item' to a IP/CIDR specification, but its INVALID: ".awitpt::netip::Error());
Robert Anderson's avatar
Robert Anderson committed
390
				return -1;
391
392
393
			}
			# Check if IP is within the range
			$res = $sessionData->{'_ClientAddress'}->is_within($matchRange);
394
395
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: - Resolved source '$item' to a IP/CIDR specification, match = $res") if ($log);

396
397
		# Match peer IPv4 or IPv6 (the server requesting the policy)
		} elsif (
398
			$item =~ /^\[((?:\d{1,3})(?:\.(?:\d{1,3})(?:\.(?:\d{1,3})(?:\.(?:\d{1,3}))?)?)?(?:\/(\d{1,2}))?)\]$/ ||
399
			$item =~ /^\[($v6)\]$/i
400
		) {
401
402
403
			# We don't want the [ and ]
			my $cleanItem = $1;

Nigel Kukard's avatar
Nigel Kukard committed
404
			# See if we get an object from
405
406
407
			my $matchRange = new awitpt::netip($cleanItem);
			if (!defined($matchRange)) {
				$server->log(LOG_WARN,"[POLICIES] $debugTxt: - Resolved source '$item' to a PEER IP/CIDR specification, but its INVALID: ".awitpt::netip::Error());
Robert Anderson's avatar
Robert Anderson committed
408
				return -1;
409
			}
Robert Anderson's avatar
Robert Anderson committed
410
411
412
413
414
415
			if ($server->{'server'}->{'peer_type'} eq "TCP") {
				# Check if IP is within the range
				$res = $sessionData->{'_PeerAddress'}->is_within($matchRange);
				$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: - Resolved source '$item' to a PEER IP/CIDR specification, match = $res") if ($log);
			} else {
				$server->log(LOG_WARN,"[POLICIES] $debugTxt: - Trying to match source '$item' to a PEER IP/CIDR specification when peer type is '".$server->{'server'}->{'peer_type'}."'") if ($log);
Robert Anderson's avatar
Robert Anderson committed
416
				return -1;
Robert Anderson's avatar
Robert Anderson committed
417
			}
418

419

420
421
		# Match SASL user, must be above email addy to match SASL usernames in the same format as email addies
		} elsif ($item =~ /^\$\S+$/) {
422
			$res = saslUsernameMatches($sessionData->{'SASLUsername'},$item);
423
424
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: - Resolved source '$item' to a SASL user specification, match = $res") if ($log);

425
426
427
428
429
		# Match blank email addy
		} elsif ($item eq "@") {
			$res = 1 if ($sessionData->{'Sender'} eq "");
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: - Resolved source '$item' to a email blank address specification, match = $res") if ($log);

430
431
		# Match email addy
		} elsif ($item =~ /^\S*@\S+$/) {
432
			$res = emailAddressMatches($sessionData->{'Sender'},$item);
433
434
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: - Resolved source '$item' to a email address specification, match = $res") if ($log);

435
		# Match domain name (for reverse dns)
436
		} elsif ($item =~ /^\.?(?:[a-z0-9\-_\*]+\.)+[a-z0-9]+$/i) {
437
438
439
			$res = reverseDNSMatches($sessionData->{'ClientReverseName'},$item);
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: - Resolved source '$item' to a reverse dns specification, match = $res") if ($log);

440
441
442
443
		# Not valid
		} else {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: - Source '".$item."' is not a valid specification");
		}
Nigel Kukard's avatar
Nigel Kukard committed
444

445
446
447
448
449
450
451
452
453
454
455
456
457
		$match = 1 if ($res);
	}

	# Check the result, if its undefined or 0, return 0, if its 1 return 1
	# !1 == undef
	return ($negate ? !$match : $match) ? 1 : 0;
}



# Check if this destination item matches, this function automagically resolves groups aswell
sub policyDestinationItemMatches
{
458
	my ($server,$debugTxt,$history,$rawItem,$sessionData) = @_;
459
460
461
462
463
464
465
	my $log = defined($server->{'config'}{'logging'}{'policies'});


	# Rip out negate if we have it, and clean the item
	my ($negate,$tmpItem) = ($rawItem =~ /^(!)?(.*)/);
	# See if we match %, if we do its a group
	my ($isGroup,$item) = ($tmpItem =~ /^(%)?(.*)/);
Nigel Kukard's avatar
Nigel Kukard committed
466

467
468
469
	# Check if this is a group
	my $match = 0;
	if ($isGroup) {
470
471
472
473
474
		# Make sure we're not looping
		if (defined($history->{$item})) {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: Destination policy group '$item' appears to be used more than once, possible loop, aborting!");
			return -1;
		}
Nigel Kukard's avatar
Nigel Kukard committed
475

476
477
478
479
480
481
482
483
		# We going deeper, record the depth
		$history->{$item} = keys(%{$history});
		# Check if we not tooo deep
		if ($history->{$item} > 5) {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: This destination policy is recursing too deep, aborting!");
			return -1;
		}

484
485
486
487
488
489
		# Get group members
		my $groupMembers = getGroupMembers($item);
		if (ref $groupMembers ne "ARRAY") {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: Error '$groupMembers' while retrieving group members for destination group '$item'");
			return -1;
		}
490
		$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: Group '$item' has ".@{$groupMembers}." destination(s) => ".join(',',@{$groupMembers})) if ($log);
491
492
493
494
		# Check if actually have any
		if (@{$groupMembers} > 0) {
			foreach my $gmember (@{$groupMembers}) {
				# Process this group member
495
				my $res = policyDestinationItemMatches($server,"$debugTxt=>(group:$item)",$history,$gmember,$sessionData);
496
497
498
				# Check for hard error
				if ($res < 0) {
					return $res;
499
				# Check for match
500
				} elsif ($res) {
501
502
503
504
505
506
507
					$match = 1;
					last;
				}
			}
		} else {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: No group members for destination group '$item'");
		}
508
		$server->log(LOG_DEBUG,"[POLICIES] $debugTxt=>(group:$item): Destination group result: matched=$match") if ($log);
509
510
511
512
513
514
515

	# Normal member
	} else {
		my $res = 0;

		# Match email addy
		if ($item =~ /^!?\S*@\S+$/) {
516
			$res = emailAddressMatches($sessionData->{'Recipient'},$item);
517
518
519
520
521
			$server->log(LOG_DEBUG,"[POLICIES] $debugTxt: - Resolved destination '$item' to a email address specification, match = $res") if ($log);

		} else {
			$server->log(LOG_WARN,"[POLICIES] $debugTxt: - Destination '$item' is not a valid specification");
		}
Nigel Kukard's avatar
Nigel Kukard committed
522

523
524
525
526
527
528
529
530
531
		$match = 1 if ($res);
	}

	# Check the result, if its undefined or 0, return 0, if its 1 return 1
	# !1 == undef
	return ($negate ? !$match : $match) ? 1 : 0;
}


Nigel Kukard's avatar
Nigel Kukard committed
532
533
534
535
536
537
538

# Check if first arg lies within the scope of second arg email/domain
sub emailAddressMatches
{
	my ($email,$template) = @_;


Nigel Kukard's avatar
Nigel Kukard committed
539
540
541
542
	# Sender may be blank, in the case of <>
	return 0 if ($email eq "");

	my $match = 0;
543

Nigel Kukard's avatar
Nigel Kukard committed
544
	# Strip email addy
545
	my ($email_user,$email_domain) = ($email =~ /^(\S+)@(\S+)$/);
546
	my ($template_user,$template_domain) = ($template =~ /^(\S*)@(\S+)$/);
Nigel Kukard's avatar
Nigel Kukard committed
547

548
549
550
551
552
553
554
555
556
557
558
559
560
561
	# Make sure its all lowercase
	$template_user = lc($template_user);
	$template_domain = lc($template_domain);

	# Replace all .'s with \.'s
	$template_user =~ s/\./\\./g;
	$template_domain =~ s/\./\\./g;

	# Change *'s into a proper regex expression
	$template_user =~ s/\*/\\S*/g;
	$template_domain =~ s/\*/\\S*/g;

	# Check if we have a match
	if ($email_domain =~ /^$template_domain$/) {
562
		if (($email_user =~ /^$template_user$/) || $template_user eq "") {
563
564
			$match = 1;
		}
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	}

	return $match;
}


# Check if first arg lies within the scope of second arg sasl specification
sub saslUsernameMatches
{
	my ($saslUsername,$template) = @_;

	my $match = 0;

	# Decipher template
579
	my ($template_user) = ($template =~ /^\$(\S+)$/);
580

581
582
583
584
585
586
	# If there is no SASL username
	if (!defined($saslUsername) || $saslUsername eq "") {
		# $- is a special case which allows matching against no SASL username
		if ($template_user eq '-') {
			$match = 1;
		}
587
	# Else regex it
588
	} else {
589
590
591
592
593
594
595
596
		# Make sure its all lowercase
		$template_user = lc($template_user);
		# Replace all .'s with \.'s
		$template_user =~ s/\./\\./g;
		# Change *'s into a proper regex expression
		$template_user =~ s/\*/\\S*/g;

		if ($saslUsername =~ /^$template_user$/) {
597
598
			$match = 1;
		}
Nigel Kukard's avatar
Nigel Kukard committed
599
600
601
602
603
604
	}

	return $match;
}


605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
# Check if first arg lies within the scope of second arg reverse dns specification
sub reverseDNSMatches
{
	my ($reverseDNSMatches,$template) = @_;

	my $match = 0;
	my $partial = 0;

	# Check if we have a . at the beginning of the line to match partials
	if ($template =~ /^\./) {
		$partial = 1;
	}

	# Replace all .'s with \.'s
	$template =~ s/\./\\./g;
	# Change *'s into a proper regex expression
	$template =~ s/\*/[a-z0-9\-_\.]*/g;

	# Check for partial match
	if ($partial) {
		if ($reverseDNSMatches =~ /$template$/i) {
			$match = 1;
		}
	# Check for exact match
	} else {
		if ($reverseDNSMatches =~ /^$template$/i) {
			$match = 1;
		}
	}
Nigel Kukard's avatar
Nigel Kukard committed
634

635
636
637
638
	return $match;
}


639
640
641
642
643
# Encode policy data into session recipient data
sub encodePolicyData
{
	my ($email,$policy) = @_;

644
645
	# Generate...    <recipient@domain>#priority=policy_id,policy_id,policy_id;priority2=policy_id2,policy_id2/recipient2@...
	my $ret = "<$email>#";
646
647
648
649
650
651
652
653
654
655
656
657
658
659
	foreach my $priority (keys %{$policy}) {
		$ret .= sprintf('%s=%s;',$priority,join(',',@{$policy->{$priority}}));
	}

	return $ret;
}


# Decode recipient data into policy data
sub decodePolicyData
{
	my $recipientData = shift;


660
661
	my $recipientToPolicy = { };

662
663
664
665
666
	# Build policy str list and recipients list
	foreach my $item (split(/\//,$recipientData)) {
		# Skip over first /
		next if ($item eq "");

667
		my ($email,$rawPolicy) = ($item =~ /<([^>]*)>#(.*)/);
668

Nigel Kukard's avatar
Nigel Kukard committed
669
670
		# Make sure that the recipient data in the DB is not null, ie. it may
		# of been killed by the admin before it updated it
671
672
673
674
675
676
677
		if (defined($email) && defined($rawPolicy)) {
			# Loop with raw policies
			foreach my $policy (split(/;/,$rawPolicy)) {
				# Strip off priority and policy IDs
				my ($prio,$policyIDs) = ( $policy =~ /(\d+)=(.*)/ );
				# Pull off policyID's from string
				foreach my $pid (split(/,/,$policyIDs)) {
678
					$recipientToPolicy->{$email}{$prio}->{$pid} = 1;
679
				}
680
681
682
683
			}
		}
	}

684
685
686
687
688
689
690
691
692
	# Work through the list and build our result, which is a priority hash with matches as an array
	foreach my $email (keys %{$recipientToPolicy}) {
		foreach my $prio (keys %{$recipientToPolicy->{$email}}) {
			my @policies = keys %{$recipientToPolicy->{$email}{$prio}};
			$recipientToPolicy->{$email}{$prio} = \@policies;
		}
	}

	return $recipientToPolicy;
693
694
}

Nigel Kukard's avatar
Nigel Kukard committed
695
696
697

1;
# vim: ts=4