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