attributes.pm 24.6 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
	'SMRadius-Peer-Address',
Nigel Kukard's avatar
Nigel Kukard committed
71 72 73 74 75 76 77 78 79 80 81 82 83
	'SMRadius-Disable-WebUITopup',
	'SMRadius-AutoTopup-Traffic-Enabled',
	'SMRadius-AutoTopup-Traffic-Amount',
	'SMRadius-AutoTopup-Traffic-Limit',
	'SMRadius-AutoTopup-Traffic-Notify',
	'SMRadius-AutoTopup-Traffic-NotifyTemplate',
	'SMRadius-AutoTopup-Traffic-Threshold',
	'SMRadius-AutoTopup-Uptime-Enabled',
	'SMRadius-AutoTopup-Uptime-Amount',
	'SMRadius-AutoTopup-Uptime-Limit',
	'SMRadius-AutoTopup-Uptime-Notify',
	'SMRadius-AutoTopup-Uptime-NotifyTemplate',
	'SMRadius-AutoTopup-Uptime-Threshold',
84 85
	'SMRadius-Config-Filter-Reply-Attribute',
	'SMRadius-Config-Filter-Reply-VAttribute',
86 87
	'SMRadius-FUP-Period',
	'SMRadius-FUP-Traffic-Threshold',
Robert Anderson's avatar
Robert Anderson committed
88 89 90
);
my @attributeVReplyIgnoreList = (
);
91 92


93
## @fn addAttribute($server,$user,$attribute)
94 95 96
# Function to add an attribute to $attributes
#
# @param server Server instance
97 98
# @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
99 100 101
# @param attribute Attribute to add, eg. Those from a database
sub addAttribute
{
102
	my ($server,$user,$attribute) = @_;
103

104 105 106

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

112 113 114
	# Clean them up a bit
	$attribute->{'Name'} =~ s/\s*(\S+)\s*/$1/;
	$attribute->{'Operator'} =~ s/\s*(\S+)\s*/$1/;
115

Robert Anderson's avatar
Robert Anderson committed
116
	# Grab attribute name, operator and value
117 118 119 120
	my $name = $attribute->{'Name'};
	my $operator = $attribute->{'Operator'};
	my $value = $attribute->{'Value'};
	# Default attribute to add is normal
121
	my $attributes = $user->{'Attributes'};
122 123 124 125 126 127 128 129 130

	# 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
131
		$attributes = $user->{'VAttributes'};
132
	}
133

Nigel Kukard's avatar
Nigel Kukard committed
134
	# Check if this is an array
135
	if ($operator =~ s/^\|\|//) {
136
		# Check if we've seen this before
137 138
		if (defined($attributes->{$name}->{$operator}) &&
				ref($attributes->{$name}->{$operator}->{'Value'}) eq "ARRAY" ) {
139
			# Then add value to end of array
140
			push(@{$attributes->{$name}->{$operator}->{'Value'}}, $value);
141

Nigel Kukard's avatar
Nigel Kukard committed
142
		# If we have not seen it before, initialize it
143 144
		} else {
			# Assign attribute
145
			$attributes->{$name}->{$operator} = $attribute;
146
			# Override type ... else we must create a custom attribute hash, this is dirty, but faster
147
			$attributes->{$name}->{$operator}->{'Value'} = [ $value ];
148 149 150 151
		}

	# If its not an array, just add it normally
	} else {
152
		$attributes->{$name}->{$operator} = $attribute;
153
	}
154 155

	# Process the item incase its a config attribute
Nigel Kukard's avatar
Nigel Kukard committed
156
	return processConfigAttribute($server,$user,$attribute);
157 158 159 160
}



161
## @fn checkAuthAttribute($server,$packetAttributes,$attribute)
162 163 164
# Function to check an attribute in the authorization stage
#
# @param server Server instance
165
# @param packetAttributes Hashref of attributes provided, eg. Those from the packet
166
# @param attribute Attribute to check, eg. One of the ones from the database
167
sub checkAuthAttribute
168
{
169
	my ($server,$user,$packetAttributes,$attribute) = @_;
170 171


172
	# Check ignore list
Robert Anderson's avatar
Robert Anderson committed
173
	foreach my $ignoredAttr (@attributeCheckIgnoreList) {
174 175 176
		# 2 = IGNORE, so return IGNORE for all ignored items
		return 2 if ($attribute->{'Name'} eq $ignoredAttr);
	}
177

178 179
	# Matched & ok?
	my $matched = 0;
180

181 182 183 184 185 186
	# 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
187
	}
188 189 190 191

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

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

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

200 201 202 203 204 205
		# Operator: ==
		#
		# Use: Attribute == Value
		# As a check item, it matches if the named attribute is present in the request,
		# AND has the given value.
		#
206
		if ($operator eq '==' ) {
207
			# Check for correct value
208
			if (defined($attrVal) && $attrVal eq $tattrVal) {
209 210
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
211

212 213 214 215 216 217 218
		# 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
219

220
		} elsif ($operator eq '>') {
221 222 223 224 225 226 227 228
			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
229

230 231 232 233 234 235 236
		# 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
237

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

244 245 246 247 248 249 250
		# 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
251

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

258 259 260 261 262 263 264
		# 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
265

266
		} elsif ($operator eq '>=') {
267 268 269 270
			# Check for correct value
			if (defined($attrVal) && $attrVal >= $tattrVal) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
271

272 273 274 275 276 277 278
		# 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
279

280
		} elsif ($operator eq '=*') {
281 282 283 284
			# Check for matching value
			if (defined($attrVal)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
285

286 287 288 289 290 291 292
		# 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
293

294
		} elsif ($operator eq '!=') {
295
			# Check for correct value
296
			if (!defined($attrVal) || $attrVal ne $tattrVal) {
297 298
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
299

300 301 302 303 304 305 306
		# 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
307

308
		} elsif ($operator eq '!*') {
309 310 311 312
			# Skip if value not defined
			if (!defined($attrVal)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
313

314 315 316 317 318 319 320
		# 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
321

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

328 329 330 331 332 333 334 335
		# 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
336

337
		} elsif ($operator eq '!~') {
338 339 340 341
			# Check for correct value
			if (defined($attrVal) && !($attrVal =~ /$tattrVal/)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
342

343 344 345 346 347 348
		# Operator: +=
		#
		# Use: Attribute += Value
		# Always matches as a check item, and adds the current
		# attribute with value to the list of configuration items.
		#
Nigel Kukard's avatar
Nigel Kukard committed
349
		# As a reply item, it has an idendtical meaning, but the
350
		# attribute is added to the reply items.
Nigel Kukard's avatar
Nigel Kukard committed
351

352 353 354 355 356 357 358 359
		} 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
360

361 362 363 364
		# FIXME
		# Operator: :=
		#
		# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
365 366
		# Always matches as a check item, and replaces in the configuration items any attribute of the same name.

367
		} elsif ($operator eq ':=') {
368
			# FIXME - Add or replace config items
369
			# FIXME - Add attribute to request
370 371 372 373 374 375 376

			# 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
377

378 379 380 381 382
		# Attributes that are not defined
		} else {
			# Ignore
			$matched = 2;
			last;
383 384 385
		}
	}

Nigel Kukard's avatar
Nigel Kukard committed
386
	# Some debugging info
387
	if ($matched == 1) {
388
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' matched");
389 390
	} elsif ($matched == 2) {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored");
391 392 393 394 395 396 397 398 399 400
	} else {
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' not matched");
	}

	return $matched;
}




401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431
## @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'}};

432
	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".prettyUndef($attrVal)." against: '".
433 434 435 436 437 438 439 440 441 442 443 444 445
			$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.
		#
Nigel Kukard's avatar
Nigel Kukard committed
446
		# As a reply item, it has an idendtical meaning, but the
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 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497
		# 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;
}




498
## @fn setReplyAttribute($server,$attributes,$attribute)
499 500 501
# Function which sees if we must reply with this attribute
#
# @param server Server instance
502
# @param attributes Hashref of reply attributes
503
# @param attribute Attribute to check
504
sub setReplyAttribute
505 506 507
{
	my ($server,$attributes,$attribute) = @_;

Nigel Kukard's avatar
Nigel Kukard committed
508

509
	# Check ignore list
Robert Anderson's avatar
Robert Anderson committed
510
	foreach my $ignoredAttr (@attributeReplyIgnoreList) {
511 512 513
		# 2 = IGNORE, so return IGNORE for all ignored items
		return 2 if ($attribute->{'Name'} eq $ignoredAttr);
	}
514

515 516 517 518 519 520
	# 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
521
	}
522 523 524

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

526

527 528 529 530 531 532 533 534 535
	# 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
536

537 538 539 540 541 542 543
	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;
544 545
		}

Nigel Kukard's avatar
Nigel Kukard committed
546

547 548 549
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
550
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
551 552
	# If no attribute of that name appears in the request, then this attribute is added.
	#
Nigel Kukard's avatar
Nigel Kukard committed
553
	# As a reply item, it has an idendtical meaning, but for the reply items, instead of the request items.
Nigel Kukard's avatar
Nigel Kukard committed
554

555 556 557 558 559 560
	} 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
561

562 563 564 565 566 567
	# Operator: +=
	#
	# Use: Attribute += Value
	# Always matches as a check item, and adds the current
	# attribute with value to the list of configuration items.
	#
Nigel Kukard's avatar
Nigel Kukard committed
568
	# As a reply item, it has an idendtical meaning, but the
569
	# attribute is added to the reply items.
Nigel Kukard's avatar
Nigel Kukard committed
570

571 572 573 574
	} elsif ($attribute->{'Operator'} eq '+=') {
		# Then add
		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}.
				"' appending values '".join("','",@attrValues)."'");
575
		push(@{$attributes->{$attribute->{'Name'}}},@attrValues);
Nigel Kukard's avatar
Nigel Kukard committed
576

577
	# Attributes that are not defined
578
	} else {
Nigel Kukard's avatar
Nigel Kukard committed
579
		# Ignore invalid operator
580
		$server->log(LOG_NOTICE,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored, invalid operator?");
581 582
	}

583
	return;
584 585 586 587 588
}




589 590 591 592 593 594 595 596 597 598
## @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
599

600
	# Check ignore list
Robert Anderson's avatar
Robert Anderson committed
601
	foreach my $ignoredAttr (@attributeVReplyIgnoreList) {
602 603 604 605 606 607 608 609 610 611 612 613 614
		# 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
615
	}
616

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

620 621 622 623 624 625 626 627 628 629

	# 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
630

631 632 633 634 635 636 637 638 639
	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
640

641 642 643
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
644
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
645 646
	# If no attribute of that name appears in the request, then this attribute is added.
	#
Nigel Kukard's avatar
Nigel Kukard committed
647
	# As a reply item, it has an idendtical meaning, but for the reply items, instead of the request items.
Nigel Kukard's avatar
Nigel Kukard committed
648

649 650 651 652 653 654
	} 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
655

656 657 658 659 660 661
	# Operator: +=
	#
	# Use: Attribute += Value
	# Always matches as a check item, and adds the current
	# attribute with value to the list of configuration items.
	#
Nigel Kukard's avatar
Nigel Kukard committed
662
	# As a reply item, it has an idendtical meaning, but the
663
	# attribute is added to the reply items.
Nigel Kukard's avatar
Nigel Kukard committed
664

665 666 667 668 669
	} 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
670

671 672 673 674 675 676 677 678 679 680 681 682 683
	# Attributes that are not defined
	} else {
		# Ignore and b0rk out
		$server->log(LOG_NOTICE,"[VATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored, invalid operator?");
		last;
	}

	return;
}




684
## @fn processConfigAttribute($server,$user,$attribute)
685
# Function to process a configuration attribute
686 687 688
#
# @param server Server instance
# @param packetAttributes Hashref of attributes provided, eg. Those from the packet
689 690
# @param attribute Attribute to process, eg. One of the ones from the database
sub processConfigAttribute
691
{
692
	my ($server,$user,$attribute) = @_;
693

694 695
	# Make things easier?
	my $configAttributes = $user->{'ConfigAttributes'};
696

697 698
	# Did we get processed?
	my $processed = 0;
699 700 701 702 703 704 705

	# 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
706
	}
707

708 709 710 711 712 713
	# Operator: +=
	#
	# Use: Attribute += Value
	# Always matches as a check item, and adds the current
	# attribute with value to the list of configuration items.
	#
Nigel Kukard's avatar
Nigel Kukard committed
714
	# As a reply item, it has an idendtical meaning, but the
715 716 717 718
	# attribute is added to the reply items.

	if ($attribute->{'Operator'} eq '+=') {
		push(@{$configAttributes->{$attribute->{'Name'}}},@attrValues);
719
		$processed = 1;
720 721 722 723

	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
724
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
725 726
	# If no attribute of that name appears in the request, then this attribute is added.
	#
Nigel Kukard's avatar
Nigel Kukard committed
727
	# As a reply item, it has an idendtical meaning, but for the reply items, instead of the request items.
728 729 730

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

733
	}
734 735 736 737 738 739 740 741

	# 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;
742
}
743 744


745 746 747 748 749 750 751 752 753 754 755 756
## @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;
757

758 759 760 761
	# Set the value to the first item in the array
	if (defined($attributes->{$attrName})) {
		($value) = @{$attributes->{$attrName}};
	}
762

763 764
	return $value;
}
765 766


767 768 769 770 771 772 773 774 775 776
## @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
777

778
	$user->{'AttributeConditionalVariables'}->{$name} = [ $value ];
Nigel Kukard's avatar
Nigel Kukard committed
779 780

	return;
781 782 783 784 785 786 787 788 789 790 791 792 793 794
}


## @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) = @_;

795

796
	# Split off expression
797 798
	# NK: This probably needs a bit of work
	my ($condition,$onTrue,$onFalse) = ($attrVal =~ /^([^\?]*)(?:\?\s*((?:\S+)?[^:]*)(?:\:\s*(.*))?)?$/);
799 800 801 802 803 804 805 806 807 808 809 810

	# 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
811
	my $mathEnv = Math::Expression->new(
812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845
			'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;
	}

846 847 848 849
	# Sanitize the output
	$attribStr =~ s/^\s*//;
	$attribStr =~ s/\s*$//;

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

852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873
	# 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
874

875 876
1;
# vim: ts=4