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 46 47 48
# 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;
}
49

50
use smradius::logging;
51 52 53 54
use smradius::util;


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


74
## @fn addAttribute($server,$user,$attribute)
75 76 77
# Function to add an attribute to $attributes
#
# @param server Server instance
78 79
# @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
80 81 82
# @param attribute Attribute to add, eg. Those from a database
sub addAttribute
{
83
	my ($server,$user,$attribute) = @_;
84

85 86 87 88 89 90 91 92

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

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

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

	# 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
112
		$attributes = $user->{'VAttributes'};
113
	}
114

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

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

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

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



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


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

159 160
	# Matched & ok?
	my $matched = 0;
161

162 163 164 165 166 167
	# 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
168
	}
169 170 171 172 173 174

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

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

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

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

193 194 195 196 197 198 199
		# 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
200

201
		} elsif ($operator eq '>') {
202 203 204 205 206 207 208 209
			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
210

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

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

225 226 227 228 229 230 231
		# 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
232

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

239 240 241 242 243 244 245
		# 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
246

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

253 254 255 256 257 258 259
		# 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
260

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

267 268 269 270 271 272 273
		# 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
274

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

281 282 283 284 285 286 287
		# 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
288

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

295 296 297 298 299 300 301
		# 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
302

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

309 310 311 312 313 314 315 316
		# 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
317

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

324 325 326 327 328 329 330 331
		# 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
332

333 334 335 336 337 338 339 340
		} 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
341

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

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

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

359 360 361 362 363
		# Attributes that are not defined
		} else {
			# Ignore
			$matched = 2;
			last;
364 365 366
		}
	}

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

	return $matched;
}




382 383 384 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 416 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
## @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'}};

	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".niceUndef($attrVal)." against: '".
			$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;
}




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

Nigel Kukard's avatar
Nigel Kukard committed
489

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

496 497 498 499 500 501
	# 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
502
	}
503 504 505

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

507

508 509 510 511 512 513 514 515 516
	# 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
517

518 519 520 521 522 523 524
	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;
525 526
		}

Nigel Kukard's avatar
Nigel Kukard committed
527

528 529 530
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
531
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
532 533 534
	# 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
535

536 537 538 539 540 541
	} 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
542

543 544 545 546 547 548 549 550
	# 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
551

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

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

564
	return;
565 566 567 568 569
}




570 571 572 573 574 575 576 577 578 579
## @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
580

581
	# Check ignore list
Robert Anderson's avatar
Robert Anderson committed
582
	foreach my $ignoredAttr (@attributeVReplyIgnoreList) {
583 584 585 586 587 588 589 590 591 592 593 594 595
		# 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
596
	}
597 598 599

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

601 602 603 604 605 606 607 608 609 610

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

612 613 614 615 616 617 618 619 620
	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
621

622 623 624
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
625
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
626 627 628
	# 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
629

630 631 632 633 634 635
	} 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
636

637 638 639 640 641 642 643 644
	# 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
645

646 647 648 649 650
	} 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
651

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

	return;
}




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

675 676
	# Make things easier?
	my $configAttributes = $user->{'ConfigAttributes'};
677

678 679
	# Did we get processed?
	my $processed = 0;
680 681 682 683 684 685 686

	# 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
687
	}
688

689 690 691 692 693 694 695 696 697 698 699
	# 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);
700
		$processed = 1;
701 702 703 704

	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
705
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
706 707 708 709 710 711
	# 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;
712
		$processed = 1;
713

714
	}
715 716 717 718 719 720 721 722

	# 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;
723
}
724 725


726 727 728 729 730 731 732 733 734 735 736 737
## @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;
738

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

744 745
	return $value;
}
746 747


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

759
	$user->{'AttributeConditionalVariables'}->{$name} = [ $value ];
Nigel Kukard's avatar
Nigel Kukard committed
760 761

	return;
762 763 764 765 766 767 768 769 770 771 772 773 774 775
}


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

776

777 778 779 780 781 782 783 784 785 786 787 788 789 790
	# 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
791
	my $mathEnv = Math::Expression->new(
792 793 794 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
			'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;
	}

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

828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849
	# 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
850

851 852
1;
# vim: ts=4