attributes.pm 24.4 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',
Robert Anderson's avatar
Robert Anderson committed
84
85
86
);
my @attributeVReplyIgnoreList = (
);
87
88


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

100
101
102

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

108
109
110
	# Clean them up a bit
	$attribute->{'Name'} =~ s/\s*(\S+)\s*/$1/;
	$attribute->{'Operator'} =~ s/\s*(\S+)\s*/$1/;
111

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

	# 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
127
		$attributes = $user->{'VAttributes'};
128
	}
129

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

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

	# If its not an array, just add it normally
	} else {
148
		$attributes->{$name}->{$operator} = $attribute;
149
	}
150
151

	# Process the item incase its a config attribute
Nigel Kukard's avatar
Nigel Kukard committed
152
	return processConfigAttribute($server,$user,$attribute);
153
154
155
156
}



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


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

174
175
	# Matched & ok?
	my $matched = 0;
176

177
178
179
180
181
182
	# 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
183
	}
184
185
186
187

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

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

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

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

208
209
210
211
212
213
214
		# 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
215

216
		} elsif ($operator eq '>') {
217
218
219
220
221
222
223
224
			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
225

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

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

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

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

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

262
		} elsif ($operator eq '>=') {
263
264
265
266
			# Check for correct value
			if (defined($attrVal) && $attrVal >= $tattrVal) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
267

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

276
		} elsif ($operator eq '=*') {
277
278
279
280
			# Check for matching value
			if (defined($attrVal)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
281

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

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

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

304
		} elsif ($operator eq '!*') {
305
306
307
308
			# Skip if value not defined
			if (!defined($attrVal)) {
				$matched = 1;
			}
Nigel Kukard's avatar
Nigel Kukard committed
309

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

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

339
340
341
342
343
344
345
346
		# 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
347

348
349
350
351
352
353
354
355
		} 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
356

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

363
		} elsif ($operator eq ':=') {
364
			# FIXME - Add or replace config items
365
			# FIXME - Add attribute to request
366
367
368
369
370
371
372

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

374
375
376
377
378
		# Attributes that are not defined
		} else {
			# Ignore
			$matched = 2;
			last;
379
380
381
		}
	}

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

	return $matched;
}




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
## @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'}};

428
	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".prettyUndef($attrVal)." against: '".
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
482
483
484
485
486
487
488
489
490
491
492
493
			$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;
}




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

Nigel Kukard's avatar
Nigel Kukard committed
504

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

511
512
513
514
515
516
	# 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
517
	}
518
519
520

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

522

523
524
525
526
527
528
529
530
531
	# 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
532

533
534
535
536
537
538
539
	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;
540
541
		}

Nigel Kukard's avatar
Nigel Kukard committed
542

543
544
545
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
546
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
547
548
549
	# 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
550

551
552
553
554
555
556
	} 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
557

558
559
560
561
562
563
564
565
	# 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
566

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

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

579
	return;
580
581
582
583
584
}




585
586
587
588
589
590
591
592
593
594
## @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
595

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

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

616
617
618
619
620
621
622
623
624
625

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

627
628
629
630
631
632
633
634
635
	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
636

637
638
639
	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
640
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
641
642
643
	# 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
644

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

652
653
654
655
656
657
658
659
	# 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
660

661
662
663
664
665
	} 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
666

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

	return;
}




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

690
691
	# Make things easier?
	my $configAttributes = $user->{'ConfigAttributes'};
692

693
694
	# Did we get processed?
	my $processed = 0;
695
696
697
698
699
700
701

	# 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
702
	}
703

704
705
706
707
708
709
710
711
712
713
714
	# 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);
715
		$processed = 1;
716
717
718
719

	# Operator: :=
	#
	# Use: Attribute := Value
Nigel Kukard's avatar
Nigel Kukard committed
720
	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
721
722
723
724
725
726
	# 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;
727
		$processed = 1;
728

729
	}
730
731
732
733
734
735
736
737

	# 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;
738
}
739
740


741
742
743
744
745
746
747
748
749
750
751
752
## @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;
753

754
755
756
757
	# Set the value to the first item in the array
	if (defined($attributes->{$attrName})) {
		($value) = @{$attributes->{$attrName}};
	}
758

759
760
	return $value;
}
761
762


763
764
765
766
767
768
769
770
771
772
## @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
773

774
	$user->{'AttributeConditionalVariables'}->{$name} = [ $value ];
Nigel Kukard's avatar
Nigel Kukard committed
775
776

	return;
777
778
779
780
781
782
783
784
785
786
787
788
789
790
}


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

791

792
793
794
795
796
797
798
799
800
801
802
803
804
805
	# 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
806
	my $mathEnv = Math::Expression->new(
807
808
809
810
811
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
			'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;
	}

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

843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
	# 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
865

866
867
1;
# vim: ts=4