attributes.pm 23.9 KB
Newer Older
1
# Attribute handling functions
2
# Copyright (C) 2007-2016, AllWorldIT
Nigel Kukard's avatar
Nigel Kukard committed
3
#
4 5 6 7
# 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
8
#
9 10 11 12
# 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
13
#
14 15 16 17 18 19 20 21 22 23 24 25 26
# 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.


## @class smradius::attributes
# Attribute functions
package smradius::attributes;

use strict;
use warnings;

# Exporter stuff
Nigel Kukard's avatar
Nigel Kukard committed
27 28
use base qw(Exporter);
our (@EXPORT);
29
@EXPORT = qw(
30
	addAttribute
31
	checkAuthAttribute
32
	checkAcctAttribute
33 34
	setReplyAttribute
	setReplyVAttribute
35
	processConfigAttribute
Nigel Kukard's avatar
Nigel Kukard committed
36

37
	getAttributeValue
38 39 40

	addAttributeConditionalVariable
	processAttributeConditionals
41 42 43
);


44 45
use AWITPT::Util;

46 47 48 49 50
# Check Math::Expression is installed
if (!eval {require Math::Expression; 1;}) {
	print STDERR "You're missing Math::Expression, try 'apt-get install libmath-expression-perl'\n";
	exit 1;
}
51

52
use smradius::logging;
53 54 55
use smradius::util;


56

57
# Attributes we do not handle
Robert Anderson's avatar
Robert Anderson committed
58
my @attributeCheckIgnoreList = (
59 60
	'User-Password'
);
Robert Anderson's avatar
Robert Anderson committed
61 62 63
my @attributeReplyIgnoreList = (
	'User-Password',
	'SMRadius-Capping-Traffic-Limit',
64
	'SMRadius-Capping-Uptime-Limit',
Robert Anderson's avatar
Robert Anderson committed
65
	'SMRadius-Validity-ValidFrom',
66
	'SMRadius-Validity-ValidTo',
67
	'SMRadius-Validity-ValidWindow',
68
	'SMRadius-Username-Transform',
69
	'SMRadius-Evaluate',
70 71
	'SMRadius-Peer-Address',
	'SMRadius-Disable-WebUITopup'
Robert Anderson's avatar
Robert Anderson committed
72 73 74
);
my @attributeVReplyIgnoreList = (
);
75 76


77
## @fn addAttribute($server,$user,$attribute)
78 79 80
# Function to add an attribute to $attributes
#
# @param server Server instance
81 82
# @param nattributes Hashref of normal attributes we already have and/or must add to
# @param vattributes Hashref of vendor attributes we already have and/or must add to
83 84 85
# @param attribute Attribute to add, eg. Those from a database
sub addAttribute
{
86
	my ($server,$user,$attribute) = @_;
87

88 89 90

	# Check we have the name, operator AND value
	if (!defined($attribute->{'Name'}) || !defined($attribute->{'Operator'}) || !defined($attribute->{'Value'})) {
91 92
		$server->log(LOG_DEBUG,"[ATTRIBUTES] Problem adding attribute with name = ".prettyUndef($attribute->{'Name'}).
				", operator = ".prettyUndef($attribute->{'Operator'}).", value = ".prettyUndef($attribute->{'Value'}));
93 94 95
		return;
	}

96 97 98
	# Clean them up a bit
	$attribute->{'Name'} =~ s/\s*(\S+)\s*/$1/;
	$attribute->{'Operator'} =~ s/\s*(\S+)\s*/$1/;
99

Robert Anderson's avatar
Robert Anderson committed
100
	# Grab attribute name, operator and value
101 102 103 104
	my $name = $attribute->{'Name'};
	my $operator = $attribute->{'Operator'};
	my $value = $attribute->{'Value'};
	# Default attribute to add is normal
105
	my $attributes = $user->{'Attributes'};
106 107 108 109 110 111 112 113 114

	# Check where we must add this attribute, maybe to the vendor attributes?
	if ($name =~ /^\[(\d+):(\S+)\]$/) {
		my $vendor = $1; $name = $2;
		# Set vendor
		$attribute->{'Vendor'} = $vendor;
		# Reset attribute name
		$attribute->{'Name'} = $name;
		# Set the attributes to use to the vendor
115
		$attributes = $user->{'VAttributes'};
116
	}
117

Nigel Kukard's avatar
Nigel Kukard committed
118
	# Check if this is an array
119
	if ($operator =~ s/^\|\|//) {
120
		# Check if we've seen this before
121 122
		if (defined($attributes->{$name}->{$operator}) &&
				ref($attributes->{$name}->{$operator}->{'Value'}) eq "ARRAY" ) {
123
			# Then add value to end of array
124
			push(@{$attributes->{$name}->{$operator}->{'Value'}}, $value);
125

Nigel Kukard's avatar
Nigel Kukard committed
126
		# If we have not seen it before, initialize it
127 128
		} else {
			# Assign attribute
129
			$attributes->{$name}->{$operator} = $attribute;
130
			# Override type ... else we must create a custom attribute hash, this is dirty, but faster
131
			$attributes->{$name}->{$operator}->{'Value'} = [ $value ];
132 133 134 135
		}

	# If its not an array, just add it normally
	} else {
136
		$attributes->{$name}->{$operator} = $attribute;
137
	}
138 139

	# Process the item incase its a config attribute
Nigel Kukard's avatar
Nigel Kukard committed
140
	return processConfigAttribute($server,$user,$attribute);
141 142 143 144
}



145
## @fn checkAuthAttribute($server,$packetAttributes,$attribute)
146 147 148
# Function to check an attribute in the authorization stage
#
# @param server Server instance
149
# @param packetAttributes Hashref of attributes provided, eg. Those from the packet
150
# @param attribute Attribute to check, eg. One of the ones from the database
151
sub checkAuthAttribute
152
{
153
	my ($server,$user,$packetAttributes,$attribute) = @_;
154 155


156
	# Check ignore list
Robert Anderson's avatar
Robert Anderson committed
157
	foreach my $ignoredAttr (@attributeCheckIgnoreList) {
158 159 160
		# 2 = IGNORE, so return IGNORE for all ignored items
		return 2 if ($attribute->{'Name'} eq $ignoredAttr);
	}
161

162 163
	# Matched & ok?
	my $matched = 0;
164

165 166 167 168 169 170
	# Figure out our attr values
	my @attrValues;
	if (ref($attribute->{'Value'}) eq "ARRAY") {
		@attrValues = @{$attribute->{'Value'}};
	} else {
		@attrValues = ( $attribute->{'Value'} );
Nigel Kukard's avatar
Nigel Kukard committed
171
	}
172 173 174 175

	# Get packet attribute value
	my $attrVal = $packetAttributes->{$attribute->{'Name'}};

176
	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".prettyUndef($attrVal)." against: '".
177
			$attribute->{'Name'}."' ".$attribute->{'Operator'}." '".join("','",@attrValues)."'");
Nigel Kukard's avatar
Nigel Kukard committed
178

179
	# Loop with all the test attribute values
Nigel Kukard's avatar
Nigel Kukard committed
180
	foreach my $tattrVal (@attrValues) {
181 182 183
		# Sanitize the operator
		my ($operator) = ($attribute->{'Operator'} =~ /^(?:\|\|)?(.*)$/);

184 185 186 187 188 189
		# Operator: ==
		#
		# Use: Attribute == Value
		# As a check item, it matches if the named attribute is present in the request,
		# AND has the given value.
		#
190
		if ($operator eq '==' ) {
191
			# Check for correct value
192
			if (defined($attrVal) && $attrVal eq $tattrVal) {
193 194
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
195

196 197 198 199 200 201 202
		# Operator: >
		#
		# Use: Attribute > Value
		# As a check item, it matches if the request contains an attribute
		# with a value greater than the one given.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
203

204
		} elsif ($operator eq '>') {
205 206 207 208 209 210 211 212
			if (defined($attrVal) && $attrVal =~ /^[0-9]+$/) {
				# Check for correct value
				if ($attrVal > $tattrVal) {
					$matched = 1;
				}
			} else {
				$server->log(LOG_WARN,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' is NOT a number!");
			}
Nigel Kukard's avatar
Nigel Kukard committed
213

214 215 216 217 218 219 220
		# Operator: <
		#
		# Use: Attribute < Value
		# As a check item, it matches if the request contains an attribute
		# with a value less than the one given.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
221

222
		} elsif ($operator eq '<') {
223 224 225 226
			# Check for correct value
			if (defined($attrVal) && $attrVal < $tattrVal) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
227

228 229 230 231 232 233 234
		# Operator: <=
		#
		# Use: Attribute <= Value
		# As a check item, it matches if the request contains an attribute
		# with a value less than, or equal to the one given.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
235

236
		} elsif ($operator eq '<=') {
237 238 239 240
			# Check for correct value
			if (defined($attrVal) && $attrVal <= $tattrVal) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
241

242 243 244 245 246 247 248
		# Operator: >=
		#
		# Use: Attribute >= Value
		# As a check item, it matches if the request contains an attribute
		# with a value greater than, or equal to the one given.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
249

250
		} elsif ($operator eq '>=') {
251 252 253 254
			# Check for correct value
			if (defined($attrVal) && $attrVal >= $tattrVal) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
255

256 257 258 259 260 261 262
		# Operator: =*
		#
		# Use: Attribute =* Value
		# As a check item, it matches if the request contains the named attribute,
		# no matter what the value is.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
263

264
		} elsif ($operator eq '=*') {
265 266 267 268
			# Check for matching value
			if (defined($attrVal)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
269

270 271 272 273 274 275 276
		# Operator !=
		#
		# Use: Attribute != Value
		# As a check item, matches if the given attribute is in the
		# request, AND does not have the given value.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
277

278
		} elsif ($operator eq '!=') {
279
			# Check for correct value
280
			if (!defined($attrVal) || $attrVal ne $tattrVal) {
281 282
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
283

284 285 286 287 288 289 290
		# Operator: !*
		#
		# Use: Attribute !* Value
		# As a check item, matches if the request does not contain the named attribute, no matter
		# what the value is.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
291

292
		} elsif ($operator eq '!*') {
293 294 295 296
			# Skip if value not defined
			if (!defined($attrVal)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
297

298 299 300 301 302 303 304
		# Operator: =~
		#
		# Use: Attribute =~ Value
		# As a check item, matches if the request contains an attribute which matches the given regular expression.
		# This operator may only be applied to string packetAttributes.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
305

306
		} elsif ($operator eq '=~') {
307 308 309 310
			# Check for correct value
			if (defined($attrVal) && $attrVal =~ /$tattrVal/) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
311

312 313 314 315 316 317 318 319
		# Operator: !~
		#
		# Use: Attribute !~ Value
		# As a check item, matches if the request does not match the given regular expression. This Operator may only
		# be applied to string packetAttributes.
		# what the value is.
		#
		# Not allowed as a reply item.
Nigel Kukard's avatar
Nigel Kukard committed
320

321
		} elsif ($operator eq '!~') {
322 323 324 325
			# Check for correct value
			if (defined($attrVal) && !($attrVal =~ /$tattrVal/)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
326

327 328 329 330 331 332 333 334
		# Operator: +=
		#
		# Use: Attribute += Value
		# Always matches as a check item, and adds the current
		# attribute with value to the list of configuration items.
		#
		# As a reply item, it has an itendtical meaning, but the
		# attribute is added to the reply items.
Nigel Kukard's avatar
Nigel Kukard committed
335

336 337 338 339 340 341 342 343
		} elsif ($operator eq '+=') {

			# Check if we're a conditional and process
			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
				$matched = processConditional($server,$user,$attribute,$tattrVal);
			} else {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
344

345 346 347 348
		# FIXME
		# Operator: :=
		#
		# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
349 350
		# Always matches as a check item, and replaces in the configuration items any attribute of the same name.

351
		} elsif ($operator eq ':=') {
352
			# FIXME - Add or replace config items
353
			# FIXME - Add attribute to request
354 355 356 357 358 359 360

			# Check if we're a conditional and process
			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
				$matched = processConditional($server,$user,$attribute,$tattrVal);
			} else {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
361

362 363 364 365 366
		# Attributes that are not defined
		} else {
			# Ignore
			$matched = 2;
			last;
367 368 369
		}
	}

Nigel Kukard's avatar
Nigel Kukard committed
370
	# Some debugging info
371
	if ($matched == 1) {
372
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' matched");
373 374
	} elsif ($matched == 2) {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored");
375 376 377 378 379 380 381 382 383 384
	} else {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' not matched");
	}

	return $matched;
}




385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415
## @fn checkAcctAttribute($server,$packetAttributes,$attribute)
# Function to check an attribute in the accounting stage
#
# @param server Server instance
# @param packetAttributes Hashref of attributes provided, eg. Those from the packet
# @param attribute Attribute to check, eg. One of the ones from the database
sub checkAcctAttribute
{
	my ($server,$user,$packetAttributes,$attribute) = @_;


	# Check ignore list
	foreach my $ignoredAttr (@attributeCheckIgnoreList) {
		# 2 = IGNORE, so return IGNORE for all ignored items
		return 2 if ($attribute->{'Name'} eq $ignoredAttr);
	}

	# Matched & ok?
	my $matched = 0;

	# Figure out our attr values
	my @attrValues;
	if (ref($attribute->{'Value'}) eq "ARRAY") {
		@attrValues = @{$attribute->{'Value'}};
	} else {
		@attrValues = ( $attribute->{'Value'} );
	}

	# Get packet attribute value
	my $attrVal = $packetAttributes->{$attribute->{'Name'}};

416
	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".prettyUndef($attrVal)." against: '".
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481
			$attribute->{'Name'}."' ".$attribute->{'Operator'}." '".join("','",@attrValues)."'");

	# Loop with all the test attribute values
	foreach my $tattrVal (@attrValues) {
		# Sanitize the operator
		my ($operator) = ($attribute->{'Operator'} =~ /^(?:\|\|)?(.*)$/);

		# Operator: +=
		#
		# Use: Attribute += Value
		# Always matches as a check item, and adds the current
		# attribute with value to the list of configuration items.
		#
		# As a reply item, it has an itendtical meaning, but the
		# attribute is added to the reply items.

		if ($operator eq '+=') {

			# Check if we're a conditional and process
			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
				$matched = processConditional($server,$user,$attribute,$tattrVal);
			} else {
				$matched = 1;
			}

		# FIXME
		# Operator: :=
		#
		# Use: Attribute := Value
		# Always matches as a check item, and replaces in the configuration items any attribute of the same name.

		} elsif ($operator eq ':=') {
			# FIXME - Add or replace config items
			# FIXME - Add attribute to request

			# Check if we're a conditional and process
			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
				$matched = processConditional($server,$user,$attribute,$tattrVal);
			} else {
				$matched = 1;
			}

		# Attributes that are not defined
		} else {
			# Ignore
			$matched = 2;
			last;
		}
	}

	# Some debugging info
	if ($matched == 1) {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' matched");
	} elsif ($matched == 2) {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored");
	} else {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' not matched");
	}

	return $matched;
}




482
## @fn setReplyAttribute($server,$attributes,$attribute)
483 484 485
# Function which sees if we must reply with this attribute
#
# @param server Server instance
486
# @param attributes Hashref of reply attributes
487
# @param attribute Attribute to check
488
sub setReplyAttribute
489 490 491
{
	my ($server,$attributes,$attribute) = @_;

Nigel Kukard's avatar
Nigel Kukard committed
492

493
	# Check ignore list
Robert Anderson's avatar
Robert Anderson committed
494
	foreach my $ignoredAttr (@attributeReplyIgnoreList) {
495 496 497
		# 2 = IGNORE, so return IGNORE for all ignored items
		return 2 if ($attribute->{'Name'} eq $ignoredAttr);
	}
498

499 500 501 502 503 504
	# Figure out our attr values
	my @attrValues;
	if (ref($attribute->{'Value'}) eq "ARRAY") {
		@attrValues = @{$attribute->{'Value'}};
	} else {
		@attrValues = ( $attribute->{'Value'} );
Nigel Kukard's avatar
Nigel Kukard committed
505
	}
506 507 508

	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing REPLY attribute: '".
			$attribute->{'Name'}."' ".$attribute->{'Operator'}." '".join("','",@attrValues)."'");
Nigel Kukard's avatar
Nigel Kukard committed
509

510

511 512 513 514 515 516 517 518 519
	# Operator: =
	#
	# Use: Attribute = Value
	# Not allowed as a check item for RADIUS protocol attributes. It is allowed for server
	# configuration attributes (Auth-Type, etc), and sets the value of on attribute,
	# only if there is no other item of the same attribute.
	#
	# As a reply item, it means "add the item to the reply list, but only if there is
	# no other item of the same attribute.
Nigel Kukard's avatar
Nigel Kukard committed
520

521 522 523 524 525 526 527
	if ($attribute->{'Operator'} eq '=') {
		# If item does not exist
		if (!defined($attributes->{$attribute->{'Name'}})) {
			# Then add
			$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}.
					"' no value exists, setting value to '".join("','",@attrValues)."'");
			@{$attributes->{$attribute->{'Name'}}} = @attrValues;
528 529
		}

Nigel Kukard's avatar
Nigel Kukard committed
530

531 532 533
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
534
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
535 536 537
	# If no attribute of that name appears in the request, then this attribute is added.
	#
	# As a reply item, it has an itendtical meaning, but for the reply items, instead of the request items.
Nigel Kukard's avatar
Nigel Kukard committed
538

539 540 541 542 543 544
	} elsif ($attribute->{'Operator'} eq ':=') {
		# Overwrite
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}.
					"' setting attribute value to '".join("','",@attrValues)."'");
		@{$attributes->{$attribute->{'Name'}}} = @attrValues;

Nigel Kukard's avatar
Nigel Kukard committed
545

546 547 548 549 550 551 552 553
	# Operator: +=
	#
	# Use: Attribute += Value
	# Always matches as a check item, and adds the current
	# attribute with value to the list of configuration items.
	#
	# As a reply item, it has an itendtical meaning, but the
	# attribute is added to the reply items.
Nigel Kukard's avatar
Nigel Kukard committed
554

555 556 557 558
	} elsif ($attribute->{'Operator'} eq '+=') {
		# Then add
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}.
				"' appending values '".join("','",@attrValues)."'");
559
		push(@{$attributes->{$attribute->{'Name'}}},@attrValues);
Nigel Kukard's avatar
Nigel Kukard committed
560

561
	# Attributes that are not defined
562
	} else {
Nigel Kukard's avatar
Nigel Kukard committed
563
		# Ignore invalid operator
564
		$server->log(LOG_NOTICE,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored, invalid operator?");
565 566
	}

567
	return;
568 569 570 571 572
}




573 574 575 576 577 578 579 580 581 582
## @fn setReplyVAttribute($server,$attributes,$attribute)
# Function which sees if we must reply with this attribute
#
# @param server Server instance
# @param attributes Hashref of reply attributes
# @param attribute Attribute to check
sub setReplyVAttribute
{
	my ($server,$attributes,$attribute) = @_;

Nigel Kukard's avatar
Nigel Kukard committed
583

584
	# Check ignore list
Robert Anderson's avatar
Robert Anderson committed
585
	foreach my $ignoredAttr (@attributeVReplyIgnoreList) {
586 587 588 589 590 591 592 593 594 595 596 597 598
		# 2 = IGNORE, so return IGNORE for all ignored items
		return 2 if ($attribute->{'Name'} eq $ignoredAttr);
	}

	# Did we find a match
	my $matched = 0;

	# Figure out our attr values
	my @attrValues;
	if (ref($attribute->{'Value'}) eq "ARRAY") {
		@attrValues = @{$attribute->{'Value'}};
	} else {
		@attrValues = ( $attribute->{'Value'} );
Nigel Kukard's avatar
Nigel Kukard committed
599
	}
600 601 602

	$server->log(LOG_DEBUG,"[VATTRIBUTES] Processing REPLY attribute: '".
			$attribute->{'Name'}."' ".$attribute->{'Operator'}." '".join("','",@attrValues)."'");
Nigel Kukard's avatar
Nigel Kukard committed
603

604 605 606 607 608 609 610 611 612 613

	# Operator: =
	#
	# Use: Attribute = Value
	# Not allowed as a check item for RADIUS protocol attributes. It is allowed for server
	# configuration attributes (Auth-Type, etc), and sets the value of on attribute,
	# only if there is no other item of the same attribute.
	#
	# As a reply item, it means "add the item to the reply list, but only if there is
	# no other item of the same attribute.
Nigel Kukard's avatar
Nigel Kukard committed
614

615 616 617 618 619 620 621 622 623
	if ($attribute->{'Operator'} eq '=') {
		# If item does not exist
		if (!defined($attributes->{$attribute->{'Vendor'}}->{$attribute->{'Name'}})) {
			# Then add
			$server->log(LOG_DEBUG,"[VATTRIBUTES] - Attribute '".$attribute->{'Name'}.
					"' no value exists, setting value to '".join("','",@attrValues)."'");
			@{$attributes->{$attribute->{'Vendor'}}->{$attribute->{'Name'}}} = @attrValues;
		}

Nigel Kukard's avatar
Nigel Kukard committed
624

625 626 627
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
628
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
629 630 631
	# If no attribute of that name appears in the request, then this attribute is added.
	#
	# As a reply item, it has an itendtical meaning, but for the reply items, instead of the request items.
Nigel Kukard's avatar
Nigel Kukard committed
632

633 634 635 636 637 638
	} elsif ($attribute->{'Operator'} eq ':=') {
		# Overwrite
		$server->log(LOG_DEBUG,"[VATTRIBUTES] - Attribute '".$attribute->{'Name'}.
					"' setting attribute value to '".join("','",@attrValues)."'");
		@{$attributes->{$attribute->{'Vendor'}}->{$attribute->{'Name'}}} = @attrValues;

Nigel Kukard's avatar
Nigel Kukard committed
639

640 641 642 643 644 645 646 647
	# Operator: +=
	#
	# Use: Attribute += Value
	# Always matches as a check item, and adds the current
	# attribute with value to the list of configuration items.
	#
	# As a reply item, it has an itendtical meaning, but the
	# attribute is added to the reply items.
Nigel Kukard's avatar
Nigel Kukard committed
648

649 650 651 652 653
	} elsif ($attribute->{'Operator'} eq '+=') {
		# Then add
		$server->log(LOG_DEBUG,"[VATTRIBUTES] - Attribute '".$attribute->{'Name'}.
				"' appending values '".join("','",@attrValues)."'");
		push(@{$attributes->{$attribute->{'Vendor'}}->{$attribute->{'Name'}}},@attrValues);
Nigel Kukard's avatar
Nigel Kukard committed
654

655 656 657 658 659 660 661 662 663 664 665 666 667
	# Attributes that are not defined
	} else {
		# Ignore and b0rk out
		$server->log(LOG_NOTICE,"[VATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored, invalid operator?");
		last;
	}

	return;
}




668
## @fn processConfigAttribute($server,$user,$attribute)
669
# Function to process a configuration attribute
670 671 672
#
# @param server Server instance
# @param packetAttributes Hashref of attributes provided, eg. Those from the packet
673 674
# @param attribute Attribute to process, eg. One of the ones from the database
sub processConfigAttribute
675
{
676
	my ($server,$user,$attribute) = @_;
677

678 679
	# Make things easier?
	my $configAttributes = $user->{'ConfigAttributes'};
680

681 682
	# Did we get processed?
	my $processed = 0;
683 684 685 686 687 688 689

	# Figure out our attr values
	my @attrValues;
	if (ref($attribute->{'Value'}) eq "ARRAY") {
		@attrValues = @{$attribute->{'Value'}};
	} else {
		@attrValues = ( $attribute->{'Value'} );
Nigel Kukard's avatar
Nigel Kukard committed
690
	}
691

692 693 694 695 696 697 698 699 700 701 702
	# Operator: +=
	#
	# Use: Attribute += Value
	# Always matches as a check item, and adds the current
	# attribute with value to the list of configuration items.
	#
	# As a reply item, it has an itendtical meaning, but the
	# attribute is added to the reply items.

	if ($attribute->{'Operator'} eq '+=') {
		push(@{$configAttributes->{$attribute->{'Name'}}},@attrValues);
703
		$processed = 1;
704 705 706 707

	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
708
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
709 710 711 712 713 714
	# If no attribute of that name appears in the request, then this attribute is added.
	#
	# As a reply item, it has an itendtical meaning, but for the reply items, instead of the request items.

	} elsif ($attribute->{'Operator'} eq ':=') {
		@{$configAttributes->{$attribute->{'Name'}}} = @attrValues;
715
		$processed = 1;
716

717
	}
718 719 720 721 722 723 724 725

	# If we got procsessed output some debug
	if ($processed) {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] Processed CONFIG attribute: '".$attribute->{'Name'}."' ".
				$attribute->{'Operator'}." '".join("','",@attrValues)."'");
	}

	return $processed;
726
}
727 728


729 730 731 732 733 734 735 736 737 738 739 740
## @fn getAttributeValue($attributes,$attrName)
# Function which will return an attributes value
#
# @param attributes Attribute hash
# @param attrName Attribute name
#
# @return Attribute value
sub getAttributeValue
{
	my ($attributes,$attrName) = @_;

	my $value;
741

742 743 744 745
	# Set the value to the first item in the array
	if (defined($attributes->{$attrName})) {
		($value) = @{$attributes->{$attrName}};
	}
746

747 748
	return $value;
}
749 750


751 752 753 754 755 756 757 758 759 760
## @fn addAttributeConditionalVariable($user,$name,$value)
# Function that adds a conditional variable
#
# @param user User hash
# @param name Variable name
# @param value Variable value
sub addAttributeConditionalVariable
{
	my ($user,$name,$value) = @_;

Nigel Kukard's avatar
Nigel Kukard committed
761

762
	$user->{'AttributeConditionalVariables'}->{$name} = [ $value ];
Nigel Kukard's avatar
Nigel Kukard committed
763 764

	return;
765 766 767 768 769 770 771 772 773 774 775 776 777 778
}


## @fn processConditional($server,$user,$attribute,$attrVal)
# This function processes a attribute conditional
#
# @param server Server hash
# @param user User hash
# @param attribute Attribute hash to process
# @param attrVal Current value we need to process
sub processConditional
{
	my ($server,$user,$attribute,$attrVal) = @_;

779

780 781 782 783 784 785 786 787 788 789 790 791 792 793
	# Split off expression
	my ($condition,$onTrue,$onFalse) = ($attrVal =~ /^([^\?]*)(?:\?\s*((?:\S+)?[^:]*)(?:\s*\:\s*(.*))?)?$/);

	# If there is no condition we cannot really continue?
	if (!defined($condition)) {
		$server->log(LOG_WARN,"[ATTRIBUTES] Conditional '$attrVal' cannot be parsed");
		return 1;
	}

	$server->log(LOG_DEBUG,"[ATTRIBUTES] Conditional parsed ".$attribute->{'Name'}." => if ($condition) then {".
			( $onTrue ? $onTrue : "-undef-")."} else {".( $onFalse ? $onFalse : "-undef-")."}");

	# Create the environment
	my @error;
Nigel Kukard's avatar
Nigel Kukard committed
794
	my $mathEnv = Math::Expression->new(
795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828
			'PrintErrFunc' => sub { @error = @_ },
			'VarHash' => $user->{'AttributeConditionalVariables'}
	);

	# Parse and create math tree
	my $mathTree = $mathEnv->Parse($condition);
	# Check for error
	if (@error) {
		my $errorStr = sprintf($error[0],$error[1]);
		$server->log(LOG_WARN,"[ATTRIBUTES] Conditional '$condition' in '$attrVal' does not parse: $errorStr");
		return 1;
	}

	# Evaluate tree
	my $res = $mathEnv->Eval($mathTree);
	if (!defined($res)) {
		$server->log(LOG_WARN,"[ATTRIBUTES] Conditional '$condition' in '$attrVal' does not evaluate");
		return 1;
	}

	# Check result
	# If we have a onTrue or onFalse we will return "Matched = True"
	# If we don't have an onTrue or onFalse we will return the result of the $condition
	my $attribStr;
	if ($res && defined($onTrue)) {
		$attribStr = $onTrue;
		$res = 1;
	} elsif (!$res && defined($onFalse)) {
		$attribStr = $onFalse;
		$res = 1;
	} elsif (defined($onTrue) || defined($onFalse)) {
		$res = 1;
	}

829 830
	$server->log(LOG_DEBUG,"[ATTRIBUTES] - Evaluated to '$res' returning '".(defined($attribStr) ? $attribStr : "-undef-")."'");

831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852
	# Loop with attributes:
	# We only get here if $res is set to 1 above, if its only a conditional with no onTrue & onFalse
	# Then attribStr will be unef
	if ($res && defined($attribStr)) {
		foreach my $rawAttr (split(/;/,$attribStr)) {
			# Split off attribute string:  name = value
			my ($attrName,$attrVal) = ($rawAttr =~ /^\s*([^=]+)=\s*(.*)/);
			# Build attribute
			my $attribute = {
				'Name' => $attrName,
				'Operator' => ':=',
				'Value' => $attrVal
			};
			# Add attribute
			addAttribute($server,$user,$attribute);
		}
	}

	return $res;
}


Nigel Kukard's avatar
Nigel Kukard committed
853

854 855
1;
# vim: ts=4