| 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__ |