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