line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright (c) 2011 Raphaƫl Pinson. |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
4
|
|
|
|
|
|
|
# modify it under the terms of the GNU Lesser Public License as |
5
|
|
|
|
|
|
|
# published by the Free Software Foundation; either version 2.1 of |
6
|
|
|
|
|
|
|
# the License, or (at your option) any later version. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# Config-Model is distributed in the hope that it will be useful, |
9
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
10
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11
|
|
|
|
|
|
|
# Lesser Public License for more details. |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# You should have received a copy of the GNU Lesser Public License |
14
|
|
|
|
|
|
|
# along with Config-Model; if not, write to the Free Software |
15
|
|
|
|
|
|
|
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA |
16
|
|
|
|
|
|
|
# 02110-1301 USA |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
package Config::Augeas::Validator; |
19
|
|
|
|
|
|
|
|
20
|
3
|
|
|
3
|
|
42808
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
105
|
|
21
|
3
|
|
|
3
|
|
15
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
83
|
|
22
|
3
|
|
|
3
|
|
22
|
use base qw(Class::Accessor); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
2801
|
|
23
|
3
|
|
|
3
|
|
10047
|
use Config::Augeas qw(get count_match print); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Config::IniFiles; |
25
|
|
|
|
|
|
|
use File::Find; |
26
|
|
|
|
|
|
|
use Term::ANSIColor; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our $VERSION = '1.300'; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# Constants from Augeas' internal.h |
31
|
|
|
|
|
|
|
use constant AUGEAS_META_TREE => "/augeas"; |
32
|
|
|
|
|
|
|
use constant AUGEAS_SPAN_OPTION => AUGEAS_META_TREE."/span"; |
33
|
|
|
|
|
|
|
use constant AUGEAS_ENABLE => "enable"; |
34
|
|
|
|
|
|
|
use constant AUGEAS_DISABLE => "disable"; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Our constants |
37
|
|
|
|
|
|
|
use constant DEFAULT_RULESDIR => "/etc/augeas-validator/rules.d"; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
use constant { |
40
|
|
|
|
|
|
|
CONF_DEFAULT_SECTION => "DEFAULT", |
41
|
|
|
|
|
|
|
CONF_ERR_CODE => "err_code", |
42
|
|
|
|
|
|
|
CONF_WARN_CODE => "warn_code", |
43
|
|
|
|
|
|
|
CONF_LENS => "lens", |
44
|
|
|
|
|
|
|
CONF_PATTERN => "pattern", |
45
|
|
|
|
|
|
|
CONF_EXCLUDE => "exclude", |
46
|
|
|
|
|
|
|
CONF_TAGS => "tags", |
47
|
|
|
|
|
|
|
CONF_LEVEL_ERR => "error", |
48
|
|
|
|
|
|
|
CONF_LEVEL_WARN => "warning", |
49
|
|
|
|
|
|
|
CONF_LEVEL_IGNORE => "ignore", |
50
|
|
|
|
|
|
|
CONF_TYPE_NAME => "name", |
51
|
|
|
|
|
|
|
CONF_TYPE_TYPE => "type", |
52
|
|
|
|
|
|
|
CONF_TYPE_COUNT => "count", |
53
|
|
|
|
|
|
|
CONF_TYPE_EXPR => "expr", |
54
|
|
|
|
|
|
|
CONF_TYPE_VALUE => "value", |
55
|
|
|
|
|
|
|
CONF_TYPE_EXPL => "explanation", |
56
|
|
|
|
|
|
|
CONF_TYPE_LEVEL => "level", |
57
|
|
|
|
|
|
|
}; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Output |
61
|
|
|
|
|
|
|
use constant { |
62
|
|
|
|
|
|
|
COLOR_INFO => "blue bold", |
63
|
|
|
|
|
|
|
COLOR_VERBOSE => "blue bold", |
64
|
|
|
|
|
|
|
COLOR_OK => "green bold", |
65
|
|
|
|
|
|
|
COLOR_ERR => "red bold", |
66
|
|
|
|
|
|
|
COLOR_WARN => "yellow bold", |
67
|
|
|
|
|
|
|
COLOR_DEBUG => "blue", |
68
|
|
|
|
|
|
|
MSG_ERR => "E", |
69
|
|
|
|
|
|
|
MSG_WARN => "W", |
70
|
|
|
|
|
|
|
MSG_INFO => "I", |
71
|
|
|
|
|
|
|
MSG_VERBOSE => "V", |
72
|
|
|
|
|
|
|
MSG_DEBUG => "D", |
73
|
|
|
|
|
|
|
}; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub new { |
77
|
|
|
|
|
|
|
my $class = shift; |
78
|
|
|
|
|
|
|
my %options = @_; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
my $self = __PACKAGE__->SUPER::new(); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
$self->{conffile} = $options{conf}; |
83
|
|
|
|
|
|
|
$self->{rulesdir} = $options{rulesdir}; |
84
|
|
|
|
|
|
|
$self->{rulesdir} ||= DEFAULT_RULESDIR; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
$self->{verbose} = $options{verbose}; |
87
|
|
|
|
|
|
|
$self->{debug} = $options{debug}; |
88
|
|
|
|
|
|
|
$self->{quiet} = $options{quiet}; |
89
|
|
|
|
|
|
|
$self->{verbose} = 1 if $self->{debug}; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
$self->{recurse} = $options{recurse}; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$self->{nofail} = $options{nofail}; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$self->{exclude} = $options{exclude}; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
$self->{tags} = $options{tags}; |
98
|
|
|
|
|
|
|
$self->{tags} ||= []; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# System mode off by default |
101
|
|
|
|
|
|
|
$self->{syswide} = 0; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# Init hourglass |
104
|
|
|
|
|
|
|
$self->{tick} = 0; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
unless ($self->{conffile}) { |
107
|
|
|
|
|
|
|
assert_notempty('rulesdir', $self->{rulesdir}); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
$self->{aug} = Config::Augeas->new( "no_load" => 1, enable_span => 1 ); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Instantiate general error |
113
|
|
|
|
|
|
|
$self->{err} = 0; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
return $self; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub load_conf { |
119
|
|
|
|
|
|
|
my ($self, $conffile) = @_; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
$self->debug_msg("Loading rule file $conffile"); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
$self->{cfg} = new Config::IniFiles( -file => $conffile ); |
124
|
|
|
|
|
|
|
die MSG_ERR.":[$conffile]: Section ".CONF_DEFAULT_SECTION." does not exist.\n" |
125
|
|
|
|
|
|
|
unless $self->{cfg}->SectionExists(CONF_DEFAULT_SECTION); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub init_augeas { |
130
|
|
|
|
|
|
|
my ($self) = @_; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# Initialize Augeas |
133
|
|
|
|
|
|
|
$self->{lens} = $self->{cfg}->val(CONF_DEFAULT_SECTION, CONF_LENS); |
134
|
|
|
|
|
|
|
assert_notempty('lens', $self->{lens}); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
if ($self->{syswide} != 1) { |
137
|
|
|
|
|
|
|
$self->{aug}->rm(AUGEAS_META_TREE."/load/*[label() != \"$self->{lens}\"]"); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub play_one { |
142
|
|
|
|
|
|
|
my ($self, @files) = @_; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Get rules |
145
|
|
|
|
|
|
|
@{$self->{rules}} = grep { !/DEFAULT/ } $self->{cfg}->Sections; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# Get return error code |
148
|
|
|
|
|
|
|
$self->{err_code} = $self->{cfg}->val(CONF_DEFAULT_SECTION, CONF_ERR_CODE) || 1; |
149
|
|
|
|
|
|
|
$self->{warn_code} = $self->{cfg}->val(CONF_DEFAULT_SECTION, CONF_WARN_CODE) || 2; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
$self->init_augeas; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
for my $file (@files) { |
154
|
|
|
|
|
|
|
unless (-e $file) { |
155
|
|
|
|
|
|
|
$self->die_msg("No such file $file"); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
$self->verbose_msg("Parsing file $file"); |
158
|
|
|
|
|
|
|
$self->set_aug_file($file); |
159
|
|
|
|
|
|
|
for my $rule (@{$self->{rules}}) { |
160
|
|
|
|
|
|
|
$self->verbose_msg("Applying rule $rule to $file"); |
161
|
|
|
|
|
|
|
$self->play_rule($rule, $file); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub filter_files { |
167
|
|
|
|
|
|
|
my ($self, $files) = @_; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
my @filtered_files; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
if ($self->{syswide} == 1) { |
172
|
|
|
|
|
|
|
my $lens = $self->{cfg}->val(CONF_DEFAULT_SECTION, CONF_LENS); |
173
|
|
|
|
|
|
|
$self->debug_msg("Finding files for lens $lens"); |
174
|
|
|
|
|
|
|
my $sys_path = AUGEAS_META_TREE."/files//*[lens =~ regexp('@?${lens}(\.lns)?')]/path"; |
175
|
|
|
|
|
|
|
$self->debug_msg($sys_path); |
176
|
|
|
|
|
|
|
for my $f ($self->{aug}->match($sys_path)) { |
177
|
|
|
|
|
|
|
my $p = $self->{aug}->get($f); |
178
|
|
|
|
|
|
|
$p =~ s|^/files||; |
179
|
|
|
|
|
|
|
$self->debug_msg("Found file $p"); |
180
|
|
|
|
|
|
|
push @filtered_files, $p; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} else { |
183
|
|
|
|
|
|
|
my $pattern = $self->{cfg}->val(CONF_DEFAULT_SECTION, CONF_PATTERN); |
184
|
|
|
|
|
|
|
my $exclude = $self->{cfg}->val(CONF_DEFAULT_SECTION, CONF_EXCLUDE); |
185
|
|
|
|
|
|
|
$exclude ||= '^$'; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
foreach my $file (@$files) { |
188
|
|
|
|
|
|
|
push @filtered_files, $file |
189
|
|
|
|
|
|
|
if ($file =~ /^$pattern$/ && $file !~ /^$exclude$/); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
return \@filtered_files; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub tick { |
197
|
|
|
|
|
|
|
my ($self) = @_; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
$self->{tick}++; |
200
|
|
|
|
|
|
|
my $tick = $self->{tick} % 4; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
my $hourglass; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
$hourglass = "|" if ( $tick == 0 ); |
205
|
|
|
|
|
|
|
$hourglass = "/" if ( $tick == 1 ); |
206
|
|
|
|
|
|
|
$hourglass = "-" if ( $tick == 2 ); |
207
|
|
|
|
|
|
|
$hourglass = "\\" if ( $tick == 3 ); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
print colored ($hourglass, COLOR_INFO),"\b"; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub get_all_files { |
213
|
|
|
|
|
|
|
my ($self) = @_; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my @files; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
$self->{aug}->load(); |
218
|
|
|
|
|
|
|
for my $f ($self->{aug}->match(AUGEAS_META_TREE."/files//path[. != '']")) { |
219
|
|
|
|
|
|
|
my $p = $self->{aug}->get($f); |
220
|
|
|
|
|
|
|
$p =~ s|^/files||; |
221
|
|
|
|
|
|
|
push @files, $p; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
return @files; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub play { |
228
|
|
|
|
|
|
|
my ($self, @infiles) = @_; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
my @files; |
231
|
|
|
|
|
|
|
if ($self->{recurse}) { |
232
|
|
|
|
|
|
|
printf "\033[?25l"; # hide cursor |
233
|
|
|
|
|
|
|
print colored ("I: Recursively analyzing directories ", COLOR_INFO) unless $self->{quiet}; |
234
|
|
|
|
|
|
|
find sub { |
235
|
|
|
|
|
|
|
my $exclude = $self->{exclude}; |
236
|
|
|
|
|
|
|
$exclude ||= '^$'; |
237
|
|
|
|
|
|
|
push @files, $File::Find::name |
238
|
|
|
|
|
|
|
if(-e && $File::Find::name !~ /^$exclude$/); |
239
|
|
|
|
|
|
|
$self->tick unless $self->{quiet} |
240
|
|
|
|
|
|
|
}, @infiles; |
241
|
|
|
|
|
|
|
print colored("[done]", COLOR_OK),"\n" unless $self->{quiet}; |
242
|
|
|
|
|
|
|
printf "\033[?25h"; # restore cursor |
243
|
|
|
|
|
|
|
} elsif ($#infiles < 0) { |
244
|
|
|
|
|
|
|
@files = $self->get_all_files(); |
245
|
|
|
|
|
|
|
$self->{syswide} = 1; |
246
|
|
|
|
|
|
|
}else { |
247
|
|
|
|
|
|
|
@files = @infiles; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
if ($self->{conffile}) { |
251
|
|
|
|
|
|
|
$self->load_conf($self->{conffile}); |
252
|
|
|
|
|
|
|
$self->play_one(@files); |
253
|
|
|
|
|
|
|
} else { |
254
|
|
|
|
|
|
|
my @rulesdirs = split(/:/, $self->{rulesdir}); |
255
|
|
|
|
|
|
|
foreach my $rulesdir (@rulesdirs) { |
256
|
|
|
|
|
|
|
opendir (RULESDIR, $rulesdir) |
257
|
|
|
|
|
|
|
or die MSG_ERR.": Could not open rules directory $rulesdir: $!\n"; |
258
|
|
|
|
|
|
|
while (my $conffile = readdir(RULESDIR)) { |
259
|
|
|
|
|
|
|
next unless ($conffile =~ /.*\.ini$/); |
260
|
|
|
|
|
|
|
$self->{conffile} = "$rulesdir/$conffile"; |
261
|
|
|
|
|
|
|
$self->load_conf($self->{conffile}); |
262
|
|
|
|
|
|
|
next unless ($self->{cfg}->val(CONF_DEFAULT_SECTION, CONF_PATTERN)); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my $filtered_files = $self->filter_files(\@files); |
265
|
|
|
|
|
|
|
my $elems = @$filtered_files; |
266
|
|
|
|
|
|
|
next unless ($elems > 0); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
$self->play_one(@$filtered_files); |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
closedir(RULESDIR); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub set_aug_file { |
277
|
|
|
|
|
|
|
my ($self, $file) = @_; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
my $absfile = `readlink -f $file`; |
280
|
|
|
|
|
|
|
chomp($absfile); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $aug = $self->{aug}; |
283
|
|
|
|
|
|
|
my $lens = $self->{lens}; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
if ($self->{syswide} != 1) { |
287
|
|
|
|
|
|
|
$aug->rm("/files"); |
288
|
|
|
|
|
|
|
if ($aug->count_match(AUGEAS_META_TREE."/load/$lens/lens") == 0) { |
289
|
|
|
|
|
|
|
# Lenses with no autoload xfm => bet on lns |
290
|
|
|
|
|
|
|
$aug->set(AUGEAS_META_TREE."/load/$lens/lens", "$lens.lns"); |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
$aug->rm(AUGEAS_META_TREE."/load/$lens/incl"); |
294
|
|
|
|
|
|
|
$aug->set(AUGEAS_META_TREE."/load/$lens/incl", $absfile); |
295
|
|
|
|
|
|
|
$aug->load; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
$aug->defvar('file', "/files$absfile"); |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
my $err_lens_path = AUGEAS_META_TREE."/load/$lens/error"; |
301
|
|
|
|
|
|
|
my $err_lens = $aug->get($err_lens_path); |
302
|
|
|
|
|
|
|
if ($err_lens) { |
303
|
|
|
|
|
|
|
$self->err_msg("Failed to load lens $lens"); |
304
|
|
|
|
|
|
|
$self->err_msg($aug->print($err_lens_path)); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
my $err_path = AUGEAS_META_TREE."/files$absfile/error"; |
308
|
|
|
|
|
|
|
my $err = $aug->get($err_path); |
309
|
|
|
|
|
|
|
if ($err) { |
310
|
|
|
|
|
|
|
my $err_line_path = AUGEAS_META_TREE."/files$absfile/error/line"; |
311
|
|
|
|
|
|
|
my $err_line = $aug->get($err_line_path); |
312
|
|
|
|
|
|
|
my $err_char_path = AUGEAS_META_TREE."/files$absfile/error/char"; |
313
|
|
|
|
|
|
|
my $err_char = $aug->get($err_char_path); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
$self->err_msg("Failed to parse file $file"); |
316
|
|
|
|
|
|
|
my $err_msg = ($err eq "parse_failed") ? |
317
|
|
|
|
|
|
|
"Parsing failed on line $err_line, character $err_char." |
318
|
|
|
|
|
|
|
: $aug->print($err_path); |
319
|
|
|
|
|
|
|
$self->die_msg($err_msg); |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub confname { |
324
|
|
|
|
|
|
|
my ($self) = @_; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
assert_notempty('conffile', $self->{conffile}); |
327
|
|
|
|
|
|
|
my $confname = $self->{conffile}; |
328
|
|
|
|
|
|
|
$confname =~ s|.*/||; |
329
|
|
|
|
|
|
|
return $confname; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub print_msg { |
334
|
|
|
|
|
|
|
my ($self, $msg, $level, $color) = @_; |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
$level ||= MSG_INFO; |
337
|
|
|
|
|
|
|
$color ||= COLOR_INFO; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
my $confname = $self->confname(); |
340
|
|
|
|
|
|
|
print STDERR colored ("$level:[$confname]: $msg", $color),"\n"; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub err_msg { |
344
|
|
|
|
|
|
|
my ($self, $msg) = @_; |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
$self->print_msg($msg, MSG_ERR, COLOR_ERR); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub die_msg { |
350
|
|
|
|
|
|
|
my ($self, $msg) = @_; |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
$self->err_msg($msg); |
353
|
|
|
|
|
|
|
exit(1) unless $self->{nofail}; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub verbose_msg { |
357
|
|
|
|
|
|
|
my ($self, $msg) = @_; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
$self->print_msg($msg, MSG_VERBOSE, COLOR_VERBOSE) if $self->{verbose}; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub debug_msg { |
363
|
|
|
|
|
|
|
my ($self, $msg) = @_; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
$self->print_msg($msg, MSG_DEBUG, COLOR_DEBUG) if $self->{debug}; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub ok_msg { |
369
|
|
|
|
|
|
|
my ($self, $msg) = @_; |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
$self->print_msg($msg, MSG_INFO, COLOR_OK) unless $self->{quiet}; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
sub play_rule { |
376
|
|
|
|
|
|
|
my ($self, $rule, $file) = @_; |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
unless ($self->{cfg}->SectionExists($rule)) { |
379
|
|
|
|
|
|
|
$self->die_msg("Section '$rule' does not exist"); |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
my $name = $self->{cfg}->val($rule, CONF_TYPE_NAME); |
382
|
|
|
|
|
|
|
assert_notempty(CONF_TYPE_NAME, $name); |
383
|
|
|
|
|
|
|
my $type = $self->{cfg}->val($rule, CONF_TYPE_TYPE); |
384
|
|
|
|
|
|
|
assert_notempty(CONF_TYPE_TYPE, $type); |
385
|
|
|
|
|
|
|
my $expr = $self->{cfg}->val($rule, CONF_TYPE_EXPR); |
386
|
|
|
|
|
|
|
assert_notempty(CONF_TYPE_EXPR, $expr); |
387
|
|
|
|
|
|
|
my $value = $self->{cfg}->val($rule, CONF_TYPE_VALUE); |
388
|
|
|
|
|
|
|
assert_notempty(CONF_TYPE_VALUE, $value); |
389
|
|
|
|
|
|
|
my $explanation = $self->{cfg}->val($rule, CONF_TYPE_EXPL); |
390
|
|
|
|
|
|
|
$explanation ||= ''; |
391
|
|
|
|
|
|
|
my $level = $self->{cfg}->val($rule, CONF_TYPE_LEVEL); |
392
|
|
|
|
|
|
|
$level ||= CONF_LEVEL_ERR; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
return if ($level eq CONF_LEVEL_IGNORE); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
my @def_tags = @{$self->{tags}}; |
397
|
|
|
|
|
|
|
my $rule_tags_str = $self->{cfg}->val($rule, CONF_TAGS); |
398
|
|
|
|
|
|
|
$rule_tags_str ||= ''; |
399
|
|
|
|
|
|
|
if ($#def_tags >= 0) { |
400
|
|
|
|
|
|
|
$self->debug_msg("Defined tags for rule: $rule_tags_str"); |
401
|
|
|
|
|
|
|
my @rule_tags = split(',', $rule_tags_str); |
402
|
|
|
|
|
|
|
my $tag_ok = 0; |
403
|
|
|
|
|
|
|
for my $tag (@def_tags) { |
404
|
|
|
|
|
|
|
if (grep(/^$tag$/, @rule_tags)) { |
405
|
|
|
|
|
|
|
$self->debug_msg("Matched tag $tag for rule $rule"); |
406
|
|
|
|
|
|
|
$tag_ok = 1; |
407
|
|
|
|
|
|
|
last; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
unless ($tag_ok) { |
411
|
|
|
|
|
|
|
$self->verbose_msg("Ignoring rule $rule since no tags matched"); |
412
|
|
|
|
|
|
|
return; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
$self->assert($name, $type, $expr, $value, $file, $explanation, $level); |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub print_error { |
421
|
|
|
|
|
|
|
my ($self, $level, $color, $file, $msg, $explanation) = @_; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
$self->print_msg($msg, $level, $color); |
424
|
|
|
|
|
|
|
print STDERR colored (" $explanation.", $color),"\n"; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub line_num { |
429
|
|
|
|
|
|
|
my ($file, $position) = @_; |
430
|
|
|
|
|
|
|
open my $fh, '<', "$file" || die MSG_ERR.": Failed to open file: $!"; |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
my $cur_pos = 0; |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
while (<$fh>) { |
435
|
|
|
|
|
|
|
if ($cur_pos < $position) { |
436
|
|
|
|
|
|
|
$cur_pos += length $_; |
437
|
|
|
|
|
|
|
} else { |
438
|
|
|
|
|
|
|
last; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
return $.; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub assert { |
447
|
|
|
|
|
|
|
my ($self, $name, $type, $expr, $value, $file, $explanation, $level) = @_; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
if ($type eq CONF_TYPE_COUNT) { |
450
|
|
|
|
|
|
|
my $count = $self->{aug}->count_match("$expr"); |
451
|
|
|
|
|
|
|
if ($count != $value) { |
452
|
|
|
|
|
|
|
my $mlevel; |
453
|
|
|
|
|
|
|
my $mcolor; |
454
|
|
|
|
|
|
|
if ($level eq CONF_LEVEL_ERR) { |
455
|
|
|
|
|
|
|
$mlevel = MSG_ERR; |
456
|
|
|
|
|
|
|
$mcolor = COLOR_ERR; |
457
|
|
|
|
|
|
|
$self->{err} = $self->{err_code}; |
458
|
|
|
|
|
|
|
} elsif ($level eq CONF_LEVEL_WARN) { |
459
|
|
|
|
|
|
|
$mlevel = MSG_WARN; |
460
|
|
|
|
|
|
|
$mcolor = COLOR_WARN; |
461
|
|
|
|
|
|
|
$self->{err} = $self->{warn_code}; |
462
|
|
|
|
|
|
|
} else { |
463
|
|
|
|
|
|
|
$self->die_msg("Unknown level $level for assertion '$name'"); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
my $msg = "Assertion '$name' of type $type returned $count for file $file, expected $value."; |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# Print span if value = 0 |
468
|
|
|
|
|
|
|
if ($value == 0) { |
469
|
|
|
|
|
|
|
my @lines; |
470
|
|
|
|
|
|
|
my $got_span = 0; |
471
|
|
|
|
|
|
|
for my $node ($self->{aug}->match("$expr")) { |
472
|
|
|
|
|
|
|
if ($self->{aug}->span($node)->{filename}) { |
473
|
|
|
|
|
|
|
my $span_start = $self->{aug}->span($node)->{span_start}; |
474
|
|
|
|
|
|
|
push @lines, line_num($file, $span_start); |
475
|
|
|
|
|
|
|
$got_span = 1; |
476
|
|
|
|
|
|
|
} else { |
477
|
|
|
|
|
|
|
$self->debug_msg("No span information for node $node"); |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
$msg .= "\n Found $count bad node(s) on line(s): ".join(', ', @lines)."." |
481
|
|
|
|
|
|
|
if $got_span; |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
$self->print_error($mlevel, $mcolor, $file, $msg, $explanation); |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
} else { |
486
|
|
|
|
|
|
|
$self->die_msg("Unknown type '$type'"); |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub assert_notempty { |
492
|
|
|
|
|
|
|
my ($name, $var) = @_; |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
die MSG_ERR.": Variable '$name' should not be empty\n" |
495
|
|
|
|
|
|
|
unless (defined($var)); |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
1; |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
__END__ |