1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/openpkg/lint-rpm.pl Tue Jul 31 12:23:42 2012 +0200
1.3 @@ -0,0 +1,447 @@
1.4 +##
1.5 +## lint-rpm.pl -- OpenPKG *.rpm File Checker
1.6 +## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
1.7 +##
1.8 +## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
1.9 +## All rights reserved. Licenses which grant limited permission to use,
1.10 +## copy, modify and distribute this software are available from the
1.11 +## OpenPKG GmbH.
1.12 +##
1.13 +## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
1.14 +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
1.15 +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
1.16 +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
1.17 +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1.18 +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1.19 +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
1.20 +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1.21 +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1.22 +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
1.23 +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1.24 +## SUCH DAMAGE.
1.25 +##
1.26 +
1.27 +# Perl run-time requirement
1.28 +require 5;
1.29 +BEGIN {
1.30 + eval "use Getopt::Long; use IO;";
1.31 + if ($@) {
1.32 + print STDERR
1.33 + "lint-rpm: ERROR: This command requires a full-size Perl installation!\n" .
1.34 + "lint-rpm: HINT: Install OpenPKG \"perl\" package to use this command.\n";
1.35 + exit(1);
1.36 + }
1.37 +}
1.38 +
1.39 +# OpenPKG instance prefix
1.40 +my $my_prefix = $ENV{'OPENPKG_PREFIX'};
1.41 +delete $ENV{'OPENPKG_PREFIX'};
1.42 +
1.43 +# program information
1.44 +my $progname = "lint-rpm";
1.45 +my $progvers = "1.0.0";
1.46 +
1.47 +# parameters (defaults)
1.48 +my $version = 0;
1.49 +my $verbose = 0;
1.50 +my $help = 0;
1.51 +my $check = 'all';
1.52 +my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
1.53 +my $rpm = "$my_prefix/bin/openpkg rpm";
1.54 +my $rpm2cpio = "$my_prefix/bin/openpkg rpm2cpio";
1.55 +
1.56 +# exception handling support
1.57 +$SIG{__DIE__} = sub {
1.58 + my ($err) = @_;
1.59 + $err =~ s|\s+at\s+.*||s if (not $verbose);
1.60 + print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
1.61 + exit(1);
1.62 +};
1.63 +
1.64 +# command line parsing
1.65 +Getopt::Long::Configure("bundling");
1.66 +my $result = GetOptions(
1.67 + 'V|version' => \$version,
1.68 + 'v|verbose' => \$verbose,
1.69 + 'h|help' => \$help,
1.70 + 'c|check=s' => \$check,
1.71 + 't|tmpdir=s' => \$tmpdir,
1.72 + 'r|rpm=s' => \$rpm,
1.73 +) || die "option parsing failed";
1.74 +if ($help) {
1.75 + print "Usage: $progname [options] [RPMFILE ...]\n" .
1.76 + "Available options:\n" .
1.77 + " -v,--verbose enable verbose run-time mode\n" .
1.78 + " -h,--help print out this usage page\n" .
1.79 + " -c,--check=CHECKS select checks to perform (default='all')\n" .
1.80 + " -r,--rpm=FILE filesystem path to RPM program\n" .
1.81 + " -t,--tmpdir=PATH filesystem path to temporary directory\n" .
1.82 + " -V,--version print program version\n";
1.83 + exit(0);
1.84 +}
1.85 +if ($version) {
1.86 + print "OpenPKG $progname $progvers\n";
1.87 + exit(0);
1.88 +}
1.89 +
1.90 +# verbose message printing
1.91 +sub msg_verbose {
1.92 + my ($msg) = @_;
1.93 + print STDERR "$msg\n" if ($verbose);
1.94 +}
1.95 +
1.96 +# warning message printing
1.97 +sub msg_warning {
1.98 + my ($msg) = @_;
1.99 + print STDERR "$progname:WARNING: $msg\n";
1.100 +}
1.101 +
1.102 +# error message printing
1.103 +sub msg_error {
1.104 + my ($msg) = @_;
1.105 + print STDERR "$progname:ERROR: $msg\n";
1.106 +}
1.107 +
1.108 +# determine check list
1.109 +my @check_list = (qw(
1.110 + layout
1.111 + attrib
1.112 + content
1.113 +));
1.114 +my @checks = ();
1.115 +if ($check eq 'all') {
1.116 + @checks = @check_list;
1.117 +}
1.118 +else {
1.119 + foreach my $c (split(/,/, $check)) {
1.120 + if (not grep(/^$c$/, @check_list)) {
1.121 + die "invalid check \"$c\"";
1.122 + }
1.123 + push(@checks, $c);
1.124 + }
1.125 +}
1.126 +
1.127 +# global return code
1.128 +$main::GRC = 0;
1.129 +
1.130 +# environment preparation
1.131 +system("rm -rf $tmpdir");
1.132 +system("mkdir -p $tmpdir");
1.133 +
1.134 +# iterate over all .rpm files
1.135 +foreach my $filename (@ARGV) {
1.136 + die "unable to open file \"$filename\" for reading"
1.137 + if (not -f $filename);
1.138 + my $info = &rpm_info($filename, \@checks);
1.139 + foreach my $check (@checks) {
1.140 + eval "\&check_$check(\$filename, \$info);";
1.141 + }
1.142 + &rpm_info_cleanup($filename, \@checks, $info);
1.143 +}
1.144 +
1.145 +# environment cleanup
1.146 +system("rm -rf $tmpdir");
1.147 +
1.148 +# die gracefully
1.149 +exit($main::GRC);
1.150 +
1.151 +## _________________________________________________________________
1.152 +##
1.153 +## COMMON SUBROUTINES
1.154 +## _________________________________________________________________
1.155 +##
1.156 +
1.157 +sub lint_message {
1.158 + my ($type, $file, $msg) = @_;
1.159 + $file =~ s|^.+?/([^/]+)$|$1|s;
1.160 + printf(STDERR "%s:%s: %s: %s\n", $progname, $type, $file, $msg);
1.161 +}
1.162 +
1.163 +sub lint_warning {
1.164 + my ($file, $msg) = @_;
1.165 + &lint_message("WARNING", $file, $msg);
1.166 + $main::GRC = 1 if ($main::GRC < 1);
1.167 +}
1.168 +
1.169 +sub lint_error {
1.170 + my ($file, $msg) = @_;
1.171 + &lint_message("ERROR", $file, $msg);
1.172 + $main::GRC = 2 if ($main::GRC < 2);
1.173 +}
1.174 +
1.175 +## _________________________________________________________________
1.176 +##
1.177 +## RPM INFORMATION GATHERING
1.178 +## _________________________________________________________________
1.179 +##
1.180 +
1.181 +sub rpm_info {
1.182 + my ($filename, $checks) = @_;
1.183 + my $info = {};
1.184 +
1.185 + # query package name
1.186 + &msg_verbose("++ querying RPM package name");
1.187 + $info->{name} = `$rpm -qp --qf '%{NAME}' $filename`;
1.188 +
1.189 + # query prefix
1.190 + &msg_verbose("++ querying RPM package installation prefix");
1.191 + $info->{prefix} = `$rpm -qp --qf '%{PREFIXES}' $filename`;
1.192 +
1.193 + # query file listing
1.194 + &msg_verbose("++ querying RPM package file listing");
1.195 + my @list = `$rpm -qplv $filename`;
1.196 + my @config = `$rpm -qplc $filename`;
1.197 +
1.198 + # process file listing
1.199 + $info->{ls} = {};
1.200 + foreach my $entry (@list) {
1.201 + if ($entry =~ m|^\(contains no files\)\s*$|s) {
1.202 + next;
1.203 + }
1.204 + elsif ($entry =~ m|^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\d+)\s+(.{12})\s+(.+)\s*$|s) {
1.205 + my ($perm, $links, $owner, $group, $size, $mtime, $path) = ($1, $2, $3, $4, $5, $6, $7);
1.206 + my $symlink = "";
1.207 + if ($path =~ m|^(\S+)\s+->\s+(\S+)$|) {
1.208 + ($path, $symlink) = ($1, $2);
1.209 + }
1.210 + $path =~ s|\s+$||s;
1.211 + my $config = 0;
1.212 + if (grep(m|^$path$|, @config)) {
1.213 + $config = 1;
1.214 + }
1.215 + $info->{ls}->{$path} = {
1.216 + 'perm' => $perm,
1.217 + 'links' => $links,
1.218 + 'owner' => $owner,
1.219 + 'group' => $group,
1.220 + 'size' => $size,
1.221 + 'time' => $mtime,
1.222 + 'path' => $path,
1.223 + 'symlink' => $symlink,
1.224 + 'config' => $config,
1.225 + };
1.226 + }
1.227 + else {
1.228 + &lint_error($filename, "invalid file listing entry: \"$entry\"");
1.229 + }
1.230 + }
1.231 +
1.232 + # unpacking files
1.233 + if (grep(/^content$/, @{$checks})) {
1.234 + &msg_verbose("++ unpacking RPM package files");
1.235 + $info->{root} = "$tmpdir/root";
1.236 + system("mkdir -p ".$info->{root});
1.237 + system("$rpm2cpio $filename | (cd ".$info->{root}." && cpio -idmu 2>/dev/null)");
1.238 + }
1.239 +
1.240 + return $info;
1.241 +}
1.242 +
1.243 +sub rpm_info_cleanup {
1.244 + my ($filename, $checks, $info) = @_;
1.245 +
1.246 + if (grep(/^content$/, @{$checks})) {
1.247 + system("rm -rf ".$info->{root}) if ($info->{root} =~ m/^\/.+/ and -d $info->{root});
1.248 + }
1.249 +}
1.250 +
1.251 +## _________________________________________________________________
1.252 +##
1.253 +## CHECK "layout": file path layout
1.254 +## _________________________________________________________________
1.255 +##
1.256 +
1.257 +sub check_layout {
1.258 + my ($rpm, $info) = @_;
1.259 +
1.260 + # no need to check 'openpkg' package because it
1.261 + # has a hard-coded file list!
1.262 + return if ($rpm =~ m|^(.+?/)?openpkg-\d[^/]+$|);
1.263 +
1.264 + # check prefix
1.265 + if ($info->{prefix} !~ m|^/.+$|) {
1.266 + &lint_error($rpm, "invalid installation prefix ".$info->{prefix}.
1.267 + " (expected to match \"^/.+\$\")");
1.268 + return;
1.269 + }
1.270 +
1.271 + # check top-level path (all-in-one)
1.272 + my @topdirs = (qw(
1.273 + bin cgi etc include info lib libexec
1.274 + local man pub sbin share usr var
1.275 + ));
1.276 + my $topdirs = "{".join(",", @topdirs)."}";
1.277 + if (not keys(%{$info->{ls}})) {
1.278 + &lint_error($rpm, "invalid empty package (expected at least one file)");
1.279 + return;
1.280 + }
1.281 + foreach my $path (keys(%{$info->{ls}})) {
1.282 + my $ok = 0;
1.283 + foreach my $topdir (@topdirs) {
1.284 + my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
1.285 + if ($path =~ m/^$prefix$/ && $rpm !~ m|^openpkg-\d+|) {
1.286 + &lint_error($rpm, "top-level directory \"$topdir\" provided" .
1.287 + " (expected none except for 'openpkg' package)");
1.288 + }
1.289 + if ($path =~ m/^$prefix/) {
1.290 + $ok = 1;
1.291 + last;
1.292 + }
1.293 + }
1.294 + if (not $ok) {
1.295 + &lint_error($rpm, "invalid top-level directory in path \"$path\"".
1.296 + " (expected one of $topdirs)");
1.297 + }
1.298 + }
1.299 +
1.300 + # check for second-level path (all-in-one)
1.301 + my @topdirs_subdir_no = (qw(bin cgi info sbin));
1.302 + my @topdirs_subdir_yes = (qw(etc libexec share var));
1.303 + foreach my $path (keys(%{$info->{ls}})) {
1.304 + foreach my $topdir (@topdirs_subdir_yes) {
1.305 + my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
1.306 + if ($path =~ m/^$prefix\/[^\/]+$/) {
1.307 + if ($info->{ls}->{$path}->{perm} !~ m|^d|) {
1.308 + &lint_error($rpm, "invalid positioned file \"$path\" under topdir \"$topdir\" (expected directory)");
1.309 + }
1.310 + }
1.311 + }
1.312 + foreach my $topdir (@topdirs_subdir_no) {
1.313 + my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
1.314 + if ($path =~ m/^$prefix\/[^\/]+$/) {
1.315 + if ($info->{ls}->{$path}->{perm} =~ m|^d|) {
1.316 + &lint_error($rpm, "invalid positioned directory \"$path\" under topdir \"$topdir\" (expected file)");
1.317 + }
1.318 + }
1.319 + }
1.320 + }
1.321 +
1.322 + # check "bin" and "sbin" directories
1.323 + foreach my $path (keys(%{$info->{ls}})) {
1.324 + foreach my $topdir (qw(bin sbin)) {
1.325 + my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
1.326 + if ($path =~ m/^$prefix\/(.+)$/) {
1.327 + my $file = $1;
1.328 + if ($file =~ m|^[^/]+\.[^/.]+$|) {
1.329 + &lint_warning($rpm, "strange executable filename \"$path\" containing an extension (expected no extension)");
1.330 + }
1.331 + my $perm = $info->{ls}->{$path}->{'perm'};
1.332 + if ($perm =~ m|^-| && $perm !~ m|^-[-r][-w][sx][-r][-w][-sx][-r][-w][-tx]$|) {
1.333 + &lint_error($rpm, "non-executable file \"$path\" (with permissions \"$perm\" under topdir \"$topdir\" (expected to be executable)");
1.334 + }
1.335 + }
1.336 + }
1.337 + }
1.338 +
1.339 + # check for symbolic link targets (outside absolute, dangling)
1.340 + foreach my $path (keys(%{$info->{ls}})) {
1.341 + my $symlink = $info->{ls}->{$path}->{'symlink'};
1.342 + if ($symlink ne '') {
1.343 + # check for outside absolute target
1.344 + my $prefix = quotemeta($info->{prefix});
1.345 + if ($symlink =~ m|^/.*| and $symlink !~ m|^$prefix|s) {
1.346 + &lint_warning($rpm, "symbolic link \"$path\" points to absolute path \"$symlink\" outside prefix \"$info->{prefix}\" (expected it to be under prefix only)");
1.347 + }
1.348 + # check for dangling target
1.349 + my $resolved = &resolve($info, $path);
1.350 + sub resolve {
1.351 + my ($info, $path) = @_;
1.352 + if (not defined($info->{ls}->{$path})) {
1.353 + return $path;
1.354 + }
1.355 + my $symlink = $info->{ls}->{$path}->{'symlink'};
1.356 + if ($symlink eq '') {
1.357 + return $path;
1.358 + }
1.359 + else {
1.360 + my $resolved;
1.361 + if ($symlink =~ m|^/|) {
1.362 + $resolved = $symlink;
1.363 + }
1.364 + else {
1.365 + $resolved = $path;
1.366 + $resolved =~ s|/[^/]+$||s;
1.367 + $resolved .= "/" . $symlink;
1.368 + $resolved =~ s|/{2,}|/|sg;
1.369 + $resolved =~ s|/\.(?=/)||sg;
1.370 + $resolved =~ s|/\.$||sg;
1.371 + 1 while ($resolved =~ s|/[^/]+/\.\./|/|s);
1.372 + $resolved =~ s|/[^/]+/\.\.$||s;
1.373 + $resolved =~ s|(.)/$|$1|s;
1.374 + }
1.375 + return &resolve($info, $resolved);
1.376 + }
1.377 + }
1.378 + if (not defined($info->{ls}->{$resolved})) {
1.379 + &lint_error($rpm, "symbolic link \"$path\" points to not existing target path \"$resolved\" (expected existing target path)");
1.380 + }
1.381 + }
1.382 + }
1.383 +}
1.384 +
1.385 +## _________________________________________________________________
1.386 +##
1.387 +## CHECK "attrib": file attributes
1.388 +## _________________________________________________________________
1.389 +##
1.390 +
1.391 +sub check_attrib {
1.392 + my ($rpm, $info) = @_;
1.393 +
1.394 + # check for empty files
1.395 + foreach my $path (keys(%{$info->{ls}})) {
1.396 + if ( $info->{ls}->{$path}->{'size'} == 0
1.397 + and $info->{ls}->{$path}->{'perm'} !~ m|^d|
1.398 + and $path !~ m/^.*\/lib\/perl\/.+\.bs$/
1.399 + and $rpm !~ m/\bopenpkg-[0-9]+/) {
1.400 + &lint_warning($rpm, "empty file \"$path\" found (expected no empty files)");
1.401 + }
1.402 + }
1.403 +
1.404 + # check for %config flagged files
1.405 + my $prefix = quotemeta($info->{'prefix'});
1.406 + my $name = quotemeta($info->{'name'});
1.407 + foreach my $path (keys(%{$info->{ls}})) {
1.408 + my $config = $info->{ls}->{$path}->{'config'};
1.409 + my $path = $info->{ls}->{$path}->{'path'};
1.410 + if ($rpm !~ m/\bopenpkg-[0-9]+/ and $config and $path !~ m/^$prefix\/etc\/($name\d*|fsl)\/.+/) {
1.411 + &lint_warning($rpm, "non-config file \"$path\" flagged as \%config (expected only \"$prefix/etc/$name/*\" files to be \%config files)");
1.412 + }
1.413 + if ($config and $path =~ m/^$prefix\/s?bin\/[^\/]+$/) {
1.414 + &lint_error($rpm, "executable file \"$path\" flagged as \%config");
1.415 + }
1.416 + if ($config and $path =~ m/^$prefix\/etc\/rc\.d\/rc\.$name$/) {
1.417 + &lint_error($rpm, "run-command file \"$path\" flagged as \%config");
1.418 + }
1.419 + }
1.420 +
1.421 + # check for permissions
1.422 + foreach my $path (keys(%{$info->{ls}})) {
1.423 + my $perm = $info->{ls}->{$path}->{'perm'};
1.424 + if ($path =~ m/^$prefix\/(bin|sbin)\/[^\/]+$/) {
1.425 + if ($perm !~ m|^[^d]..[xs]..[xs]..[xt]$|) {
1.426 + &lint_warning($rpm, "executable file \"$path\" has permissions \"$perm\" only (expected it to be executable by everyone)");
1.427 + }
1.428 + }
1.429 + }
1.430 +
1.431 + # TODO: user/group?
1.432 +}
1.433 +
1.434 +## _________________________________________________________________
1.435 +##
1.436 +## CHECK "content": file content
1.437 +## _________________________________________________________________
1.438 +##
1.439 +
1.440 +sub check_content {
1.441 + my ($rpm, $info) = @_;
1.442 +
1.443 + # TODO: stripped (file)
1.444 + # TODO: syslibs (ldd)
1.445 + # TODO: hard-coded paths pointing outside instance
1.446 + # TODO: sanity check for shebang-lines
1.447 + # TODO: contained temporary path
1.448 + # TODO: bad-files: .po
1.449 +}
1.450 +
