openpkg/lint-rpm.pl@c10fb90893b9
openpkg/lint-rpm.pl
Thu, 04 Oct 2012 20:30:05 +0200
- author
- Michael Schloh von Bennewitz <michael@schloh.com>
- date
- Thu, 04 Oct 2012 20:30:05 +0200
- changeset 715
- c10fb90893b9
- permissions
- -rw-r--r--
Correct out of date build configuration, porting to Solaris 11 network
link infrastructure and new libpcap logic. This additionally allows for
device drivers in subdirectories of /dev. Correct packaged nmap
personalities and signatures to work out of the box. Finally, hack
arpd logic to properly close sockets and quit on TERM by repeating
signaling in the run command script. Sadly, all this fails to correct
the run time behaviour of honeyd which fails to bind to the IP layer.
1 ##
2 ## lint-rpm.pl -- OpenPKG *.rpm File Checker
3 ## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
4 ##
5 ## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
6 ## All rights reserved. Licenses which grant limited permission to use,
7 ## copy, modify and distribute this software are available from the
8 ## OpenPKG GmbH.
9 ##
10 ## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
11 ## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
12 ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
13 ## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
14 ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
15 ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
16 ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
17 ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
18 ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
19 ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
20 ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
21 ## SUCH DAMAGE.
22 ##
24 # Perl run-time requirement
25 require 5;
26 BEGIN {
27 eval "use Getopt::Long; use IO;";
28 if ($@) {
29 print STDERR
30 "lint-rpm: ERROR: This command requires a full-size Perl installation!\n" .
31 "lint-rpm: HINT: Install OpenPKG \"perl\" package to use this command.\n";
32 exit(1);
33 }
34 }
36 # OpenPKG instance prefix
37 my $my_prefix = $ENV{'OPENPKG_PREFIX'};
38 delete $ENV{'OPENPKG_PREFIX'};
40 # program information
41 my $progname = "lint-rpm";
42 my $progvers = "1.0.0";
44 # parameters (defaults)
45 my $version = 0;
46 my $verbose = 0;
47 my $help = 0;
48 my $check = 'all';
49 my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
50 my $rpm = "$my_prefix/bin/openpkg rpm";
51 my $rpm2cpio = "$my_prefix/bin/openpkg rpm2cpio";
53 # exception handling support
54 $SIG{__DIE__} = sub {
55 my ($err) = @_;
56 $err =~ s|\s+at\s+.*||s if (not $verbose);
57 print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
58 exit(1);
59 };
61 # command line parsing
62 Getopt::Long::Configure("bundling");
63 my $result = GetOptions(
64 'V|version' => \$version,
65 'v|verbose' => \$verbose,
66 'h|help' => \$help,
67 'c|check=s' => \$check,
68 't|tmpdir=s' => \$tmpdir,
69 'r|rpm=s' => \$rpm,
70 ) || die "option parsing failed";
71 if ($help) {
72 print "Usage: $progname [options] [RPMFILE ...]\n" .
73 "Available options:\n" .
74 " -v,--verbose enable verbose run-time mode\n" .
75 " -h,--help print out this usage page\n" .
76 " -c,--check=CHECKS select checks to perform (default='all')\n" .
77 " -r,--rpm=FILE filesystem path to RPM program\n" .
78 " -t,--tmpdir=PATH filesystem path to temporary directory\n" .
79 " -V,--version print program version\n";
80 exit(0);
81 }
82 if ($version) {
83 print "OpenPKG $progname $progvers\n";
84 exit(0);
85 }
87 # verbose message printing
88 sub msg_verbose {
89 my ($msg) = @_;
90 print STDERR "$msg\n" if ($verbose);
91 }
93 # warning message printing
94 sub msg_warning {
95 my ($msg) = @_;
96 print STDERR "$progname:WARNING: $msg\n";
97 }
99 # error message printing
100 sub msg_error {
101 my ($msg) = @_;
102 print STDERR "$progname:ERROR: $msg\n";
103 }
105 # determine check list
106 my @check_list = (qw(
107 layout
108 attrib
109 content
110 ));
111 my @checks = ();
112 if ($check eq 'all') {
113 @checks = @check_list;
114 }
115 else {
116 foreach my $c (split(/,/, $check)) {
117 if (not grep(/^$c$/, @check_list)) {
118 die "invalid check \"$c\"";
119 }
120 push(@checks, $c);
121 }
122 }
124 # global return code
125 $main::GRC = 0;
127 # environment preparation
128 system("rm -rf $tmpdir");
129 system("mkdir -p $tmpdir");
131 # iterate over all .rpm files
132 foreach my $filename (@ARGV) {
133 die "unable to open file \"$filename\" for reading"
134 if (not -f $filename);
135 my $info = &rpm_info($filename, \@checks);
136 foreach my $check (@checks) {
137 eval "\&check_$check(\$filename, \$info);";
138 }
139 &rpm_info_cleanup($filename, \@checks, $info);
140 }
142 # environment cleanup
143 system("rm -rf $tmpdir");
145 # die gracefully
146 exit($main::GRC);
148 ## _________________________________________________________________
149 ##
150 ## COMMON SUBROUTINES
151 ## _________________________________________________________________
152 ##
154 sub lint_message {
155 my ($type, $file, $msg) = @_;
156 $file =~ s|^.+?/([^/]+)$|$1|s;
157 printf(STDERR "%s:%s: %s: %s\n", $progname, $type, $file, $msg);
158 }
160 sub lint_warning {
161 my ($file, $msg) = @_;
162 &lint_message("WARNING", $file, $msg);
163 $main::GRC = 1 if ($main::GRC < 1);
164 }
166 sub lint_error {
167 my ($file, $msg) = @_;
168 &lint_message("ERROR", $file, $msg);
169 $main::GRC = 2 if ($main::GRC < 2);
170 }
172 ## _________________________________________________________________
173 ##
174 ## RPM INFORMATION GATHERING
175 ## _________________________________________________________________
176 ##
178 sub rpm_info {
179 my ($filename, $checks) = @_;
180 my $info = {};
182 # query package name
183 &msg_verbose("++ querying RPM package name");
184 $info->{name} = `$rpm -qp --qf '%{NAME}' $filename`;
186 # query prefix
187 &msg_verbose("++ querying RPM package installation prefix");
188 $info->{prefix} = `$rpm -qp --qf '%{PREFIXES}' $filename`;
190 # query file listing
191 &msg_verbose("++ querying RPM package file listing");
192 my @list = `$rpm -qplv $filename`;
193 my @config = `$rpm -qplc $filename`;
195 # process file listing
196 $info->{ls} = {};
197 foreach my $entry (@list) {
198 if ($entry =~ m|^\(contains no files\)\s*$|s) {
199 next;
200 }
201 elsif ($entry =~ m|^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\d+)\s+(.{12})\s+(.+)\s*$|s) {
202 my ($perm, $links, $owner, $group, $size, $mtime, $path) = ($1, $2, $3, $4, $5, $6, $7);
203 my $symlink = "";
204 if ($path =~ m|^(\S+)\s+->\s+(\S+)$|) {
205 ($path, $symlink) = ($1, $2);
206 }
207 $path =~ s|\s+$||s;
208 my $config = 0;
209 if (grep(m|^$path$|, @config)) {
210 $config = 1;
211 }
212 $info->{ls}->{$path} = {
213 'perm' => $perm,
214 'links' => $links,
215 'owner' => $owner,
216 'group' => $group,
217 'size' => $size,
218 'time' => $mtime,
219 'path' => $path,
220 'symlink' => $symlink,
221 'config' => $config,
222 };
223 }
224 else {
225 &lint_error($filename, "invalid file listing entry: \"$entry\"");
226 }
227 }
229 # unpacking files
230 if (grep(/^content$/, @{$checks})) {
231 &msg_verbose("++ unpacking RPM package files");
232 $info->{root} = "$tmpdir/root";
233 system("mkdir -p ".$info->{root});
234 system("$rpm2cpio $filename | (cd ".$info->{root}." && cpio -idmu 2>/dev/null)");
235 }
237 return $info;
238 }
240 sub rpm_info_cleanup {
241 my ($filename, $checks, $info) = @_;
243 if (grep(/^content$/, @{$checks})) {
244 system("rm -rf ".$info->{root}) if ($info->{root} =~ m/^\/.+/ and -d $info->{root});
245 }
246 }
248 ## _________________________________________________________________
249 ##
250 ## CHECK "layout": file path layout
251 ## _________________________________________________________________
252 ##
254 sub check_layout {
255 my ($rpm, $info) = @_;
257 # no need to check 'openpkg' package because it
258 # has a hard-coded file list!
259 return if ($rpm =~ m|^(.+?/)?openpkg-\d[^/]+$|);
261 # check prefix
262 if ($info->{prefix} !~ m|^/.+$|) {
263 &lint_error($rpm, "invalid installation prefix ".$info->{prefix}.
264 " (expected to match \"^/.+\$\")");
265 return;
266 }
268 # check top-level path (all-in-one)
269 my @topdirs = (qw(
270 bin cgi etc include info lib libexec
271 local man pub sbin share usr var
272 ));
273 my $topdirs = "{".join(",", @topdirs)."}";
274 if (not keys(%{$info->{ls}})) {
275 &lint_error($rpm, "invalid empty package (expected at least one file)");
276 return;
277 }
278 foreach my $path (keys(%{$info->{ls}})) {
279 my $ok = 0;
280 foreach my $topdir (@topdirs) {
281 my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
282 if ($path =~ m/^$prefix$/ && $rpm !~ m|^openpkg-\d+|) {
283 &lint_error($rpm, "top-level directory \"$topdir\" provided" .
284 " (expected none except for 'openpkg' package)");
285 }
286 if ($path =~ m/^$prefix/) {
287 $ok = 1;
288 last;
289 }
290 }
291 if (not $ok) {
292 &lint_error($rpm, "invalid top-level directory in path \"$path\"".
293 " (expected one of $topdirs)");
294 }
295 }
297 # check for second-level path (all-in-one)
298 my @topdirs_subdir_no = (qw(bin cgi info sbin));
299 my @topdirs_subdir_yes = (qw(etc libexec share var));
300 foreach my $path (keys(%{$info->{ls}})) {
301 foreach my $topdir (@topdirs_subdir_yes) {
302 my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
303 if ($path =~ m/^$prefix\/[^\/]+$/) {
304 if ($info->{ls}->{$path}->{perm} !~ m|^d|) {
305 &lint_error($rpm, "invalid positioned file \"$path\" under topdir \"$topdir\" (expected directory)");
306 }
307 }
308 }
309 foreach my $topdir (@topdirs_subdir_no) {
310 my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
311 if ($path =~ m/^$prefix\/[^\/]+$/) {
312 if ($info->{ls}->{$path}->{perm} =~ m|^d|) {
313 &lint_error($rpm, "invalid positioned directory \"$path\" under topdir \"$topdir\" (expected file)");
314 }
315 }
316 }
317 }
319 # check "bin" and "sbin" directories
320 foreach my $path (keys(%{$info->{ls}})) {
321 foreach my $topdir (qw(bin sbin)) {
322 my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
323 if ($path =~ m/^$prefix\/(.+)$/) {
324 my $file = $1;
325 if ($file =~ m|^[^/]+\.[^/.]+$|) {
326 &lint_warning($rpm, "strange executable filename \"$path\" containing an extension (expected no extension)");
327 }
328 my $perm = $info->{ls}->{$path}->{'perm'};
329 if ($perm =~ m|^-| && $perm !~ m|^-[-r][-w][sx][-r][-w][-sx][-r][-w][-tx]$|) {
330 &lint_error($rpm, "non-executable file \"$path\" (with permissions \"$perm\" under topdir \"$topdir\" (expected to be executable)");
331 }
332 }
333 }
334 }
336 # check for symbolic link targets (outside absolute, dangling)
337 foreach my $path (keys(%{$info->{ls}})) {
338 my $symlink = $info->{ls}->{$path}->{'symlink'};
339 if ($symlink ne '') {
340 # check for outside absolute target
341 my $prefix = quotemeta($info->{prefix});
342 if ($symlink =~ m|^/.*| and $symlink !~ m|^$prefix|s) {
343 &lint_warning($rpm, "symbolic link \"$path\" points to absolute path \"$symlink\" outside prefix \"$info->{prefix}\" (expected it to be under prefix only)");
344 }
345 # check for dangling target
346 my $resolved = &resolve($info, $path);
347 sub resolve {
348 my ($info, $path) = @_;
349 if (not defined($info->{ls}->{$path})) {
350 return $path;
351 }
352 my $symlink = $info->{ls}->{$path}->{'symlink'};
353 if ($symlink eq '') {
354 return $path;
355 }
356 else {
357 my $resolved;
358 if ($symlink =~ m|^/|) {
359 $resolved = $symlink;
360 }
361 else {
362 $resolved = $path;
363 $resolved =~ s|/[^/]+$||s;
364 $resolved .= "/" . $symlink;
365 $resolved =~ s|/{2,}|/|sg;
366 $resolved =~ s|/\.(?=/)||sg;
367 $resolved =~ s|/\.$||sg;
368 1 while ($resolved =~ s|/[^/]+/\.\./|/|s);
369 $resolved =~ s|/[^/]+/\.\.$||s;
370 $resolved =~ s|(.)/$|$1|s;
371 }
372 return &resolve($info, $resolved);
373 }
374 }
375 if (not defined($info->{ls}->{$resolved})) {
376 &lint_error($rpm, "symbolic link \"$path\" points to not existing target path \"$resolved\" (expected existing target path)");
377 }
378 }
379 }
380 }
382 ## _________________________________________________________________
383 ##
384 ## CHECK "attrib": file attributes
385 ## _________________________________________________________________
386 ##
388 sub check_attrib {
389 my ($rpm, $info) = @_;
391 # check for empty files
392 foreach my $path (keys(%{$info->{ls}})) {
393 if ( $info->{ls}->{$path}->{'size'} == 0
394 and $info->{ls}->{$path}->{'perm'} !~ m|^d|
395 and $path !~ m/^.*\/lib\/perl\/.+\.bs$/
396 and $rpm !~ m/\bopenpkg-[0-9]+/) {
397 &lint_warning($rpm, "empty file \"$path\" found (expected no empty files)");
398 }
399 }
401 # check for %config flagged files
402 my $prefix = quotemeta($info->{'prefix'});
403 my $name = quotemeta($info->{'name'});
404 foreach my $path (keys(%{$info->{ls}})) {
405 my $config = $info->{ls}->{$path}->{'config'};
406 my $path = $info->{ls}->{$path}->{'path'};
407 if ($rpm !~ m/\bopenpkg-[0-9]+/ and $config and $path !~ m/^$prefix\/etc\/($name\d*|fsl)\/.+/) {
408 &lint_warning($rpm, "non-config file \"$path\" flagged as \%config (expected only \"$prefix/etc/$name/*\" files to be \%config files)");
409 }
410 if ($config and $path =~ m/^$prefix\/s?bin\/[^\/]+$/) {
411 &lint_error($rpm, "executable file \"$path\" flagged as \%config");
412 }
413 if ($config and $path =~ m/^$prefix\/etc\/rc\.d\/rc\.$name$/) {
414 &lint_error($rpm, "run-command file \"$path\" flagged as \%config");
415 }
416 }
418 # check for permissions
419 foreach my $path (keys(%{$info->{ls}})) {
420 my $perm = $info->{ls}->{$path}->{'perm'};
421 if ($path =~ m/^$prefix\/(bin|sbin)\/[^\/]+$/) {
422 if ($perm !~ m|^[^d]..[xs]..[xs]..[xt]$|) {
423 &lint_warning($rpm, "executable file \"$path\" has permissions \"$perm\" only (expected it to be executable by everyone)");
424 }
425 }
426 }
428 # TODO: user/group?
429 }
431 ## _________________________________________________________________
432 ##
433 ## CHECK "content": file content
434 ## _________________________________________________________________
435 ##
437 sub check_content {
438 my ($rpm, $info) = @_;
440 # TODO: stripped (file)
441 # TODO: syslibs (ldd)
442 # TODO: hard-coded paths pointing outside instance
443 # TODO: sanity check for shebang-lines
444 # TODO: contained temporary path
445 # TODO: bad-files: .po
446 }
