line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Decision::ACL::Rule; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
|
4
|
2
|
|
|
2
|
|
14
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
60
|
|
5
|
2
|
|
|
2
|
|
11
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
117
|
|
6
|
2
|
|
|
2
|
|
2282
|
use Data::Dumper; |
|
2
|
|
|
|
|
21623
|
|
|
2
|
|
|
|
|
158
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
15
|
use Decision::ACL::Constants qw(:rule); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
294
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
13
|
use constant DEBUG_LEVEL => 0; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
2258
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new |
13
|
|
|
|
|
|
|
{ |
14
|
4
|
|
|
4
|
0
|
222
|
my $parent = shift; |
15
|
4
|
|
|
|
|
7
|
my $args = shift; |
16
|
|
|
|
|
|
|
|
17
|
4
|
50
|
|
|
|
14
|
croak "No arguments to new()" if not defined $args; |
18
|
4
|
50
|
|
|
|
15
|
croak "Arguments to new() is not a hashref" if !UNIVERSAL::isa($args, 'HASH'); |
19
|
4
|
50
|
|
|
|
17
|
croak "No fields specified for new()" if not defined $args->{fields}; |
20
|
4
|
50
|
|
|
|
18
|
croak "Fields argument is not a hashref" if !UNIVERSAL::isa($args->{fields}, 'HASH'); |
21
|
|
|
|
|
|
|
|
22
|
4
|
|
|
|
|
7
|
my $self = {}; |
23
|
4
|
|
|
|
|
10
|
bless $self, $parent; |
24
|
|
|
|
|
|
|
|
25
|
4
|
|
|
|
|
14
|
$self->Now($args->{now}); |
26
|
4
|
|
|
|
|
11
|
$self->Action($args->{action}); |
27
|
4
|
|
|
|
|
13
|
$self->Fields($args->{fields}); |
28
|
|
|
|
|
|
|
|
29
|
4
|
|
|
|
|
11
|
return $self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub Fields |
33
|
|
|
|
|
|
|
{ |
34
|
64
|
|
|
64
|
0
|
91
|
my $self = shift; |
35
|
64
|
|
|
|
|
87
|
my $fields = shift; |
36
|
|
|
|
|
|
|
|
37
|
64
|
100
|
66
|
|
|
253
|
if(defined $fields && (UNIVERSAL::isa($fields, 'HASH'))) |
38
|
|
|
|
|
|
|
{ |
39
|
4
|
|
|
|
|
14
|
foreach my $field (keys %$fields) |
40
|
|
|
|
|
|
|
{ |
41
|
16
|
|
|
|
|
38
|
$self->{_fields}->{$field} = $fields->{$field}; |
42
|
16
|
50
|
|
|
|
52
|
$self->{_fields}->{$field} = uc $fields->{$field} if $fields->{$field} eq 'all'; |
43
|
|
|
|
|
|
|
} |
44
|
4
|
|
|
|
|
11
|
$self->{_fields_loaded} = 1; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
64
|
|
50
|
|
|
273
|
return $self->{_fields} || {}; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub Now |
51
|
|
|
|
|
|
|
{ |
52
|
6
|
|
|
6
|
0
|
9
|
my $self = shift; |
53
|
6
|
|
|
|
|
10
|
my $flag = shift; |
54
|
|
|
|
|
|
|
|
55
|
6
|
100
|
|
|
|
36
|
if(not defined $flag) { return $self->{_now}; } |
|
2
|
|
|
|
|
8
|
|
56
|
4
|
100
|
|
|
|
14
|
if($flag == 1) { $self->{_now} = 1; } |
|
2
|
50
|
|
|
|
6
|
|
57
|
2
|
|
|
|
|
9
|
elsif($flag == 0) { $self->{_now} = 0; } |
58
|
4
|
|
|
|
|
10
|
return $self->{_now}; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub Action |
63
|
|
|
|
|
|
|
{ |
64
|
26
|
|
|
26
|
0
|
38
|
my $self = shift; |
65
|
26
|
|
|
|
|
38
|
my $action = shift; |
66
|
|
|
|
|
|
|
|
67
|
26
|
0
|
33
|
|
|
101
|
if(defined $action && ($action =~ /^ALLOW$/i |
|
|
|
66
|
|
|
|
|
68
|
|
|
|
|
|
|
|| $action =~ /^DENY$/i |
69
|
|
|
|
|
|
|
|| $action =~ /^PERMIT$/i |
70
|
|
|
|
|
|
|
|| $action =~ /^BLOCK$/i)) |
71
|
|
|
|
|
|
|
{ |
72
|
4
|
|
|
|
|
9
|
$self->{_action} = $action; |
73
|
4
|
|
|
|
|
20
|
return $self->{_action}; |
74
|
|
|
|
|
|
|
} |
75
|
22
|
|
|
|
|
89
|
return $self->{_action}; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub Control |
80
|
|
|
|
|
|
|
{ |
81
|
14
|
|
|
14
|
0
|
22
|
my $self = shift; |
82
|
14
|
|
|
|
|
21
|
my $args = shift; |
83
|
|
|
|
|
|
|
|
84
|
14
|
50
|
|
|
|
36
|
croak "Rule parameters not specified" if(!$self->{_fields_loaded}); |
85
|
14
|
50
|
|
|
|
27
|
croak "Rule action is not set" if(!$self->Action()); |
86
|
14
|
50
|
|
|
|
47
|
croak "Nothing to control" if(!$args); |
87
|
14
|
50
|
|
|
|
46
|
croak "Arguments to control() is not a hashref" if !UNIVERSAL::isa($args, 'HASH'); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# Applying our action... |
90
|
|
|
|
|
|
|
# - Check if we are concerned |
91
|
|
|
|
|
|
|
# - If so, apply our action |
92
|
14
|
|
|
|
|
31
|
my $concern_status = $self->Concerned($args); |
93
|
|
|
|
|
|
|
|
94
|
14
|
50
|
|
|
|
50
|
print STDERR "Concerned -> $concern_status\n" if $self->DEBUG_LEVEL(); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#It's ours, apply. |
97
|
14
|
100
|
|
|
|
34
|
if($concern_status != ACL_RULE_UNCONCERNED) |
98
|
|
|
|
|
|
|
{ |
99
|
4
|
50
|
|
|
|
14
|
print STDERR "We are concerned, action is '". $self->Action()."'\n" if $self->DEBUG_LEVEL();; |
100
|
4
|
100
|
66
|
|
|
9
|
return ACL_RULE_ALLOW if($self->Action() =~ /^ALLOW$/i |
101
|
|
|
|
|
|
|
|| $self->Action() =~ /^PERMIT/i); |
102
|
2
|
50
|
33
|
|
|
7
|
return ACL_RULE_DENY if($self->Action() =~ /^DENY$/i |
103
|
|
|
|
|
|
|
|| $self->ACtion() =~ /^BLOCK$/i); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
10
|
|
|
|
|
26
|
return ACL_RULE_UNCONCERNED; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub Concerned |
110
|
|
|
|
|
|
|
{ |
111
|
14
|
|
|
14
|
0
|
19
|
my $self = shift; |
112
|
14
|
|
|
|
|
19
|
my $args = shift; |
113
|
|
|
|
|
|
|
|
114
|
14
|
50
|
|
|
|
599
|
croak "No args to concern with" if (!$args); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
#Foreach field of this rule, check to see if we are concerned. |
117
|
14
|
|
|
|
|
18
|
foreach my $field (keys %{$self->Fields()}) |
|
14
|
|
|
|
|
29
|
|
118
|
|
|
|
|
|
|
{ |
119
|
33
|
|
|
|
|
69
|
my $field_value = $self->Fields()->{$field}; |
120
|
33
|
50
|
|
|
|
110
|
print STDERR "$field control (".$field_value.")->" if $self->DEBUG_LEVEL();; |
121
|
|
|
|
|
|
|
|
122
|
33
|
50
|
100
|
|
|
239
|
return ACL_RULE_UNCONCERNED if( |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
123
|
|
|
|
|
|
|
$field_value ne $args->{$field} |
124
|
|
|
|
|
|
|
&& $field_value |
125
|
|
|
|
|
|
|
&& $field_value ne 'ALL' |
126
|
|
|
|
|
|
|
&& $args->{$field} ne 'ALL' |
127
|
|
|
|
|
|
|
&& $args->{$field}); |
128
|
23
|
50
|
|
|
|
80
|
print STDERR " 1\n" if $self->DEBUG_LEVEL();; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
4
|
|
|
|
|
10
|
return ACL_RULE_CONCERNED; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
666; |