OpenPKG CVS Repository
http://cvs.openpkg.org/
____________________________________________________________________________
Server: cvs.openpkg.org Name: Ralf S. Engelschall
Root: /e/openpkg/cvs Email: [EMAIL PROTECTED]
Module: openpkg-re Date: 04-Jul-2003 19:04:45
Branch: HEAD Handle: 2003070418044400
Added files:
openpkg-re rpmlint.pl
Log:
first cut for a .rpm file lint
Summary:
Revision Changes Path
1.1 +345 -0 openpkg-re/rpmlint.pl
____________________________________________________________________________
patch -p0 <<'@@ .'
Index: openpkg-re/rpmlint.pl
============================================================================
$ cvs diff -u -r0 -r1.1 rpmlint.pl
--- /dev/null 2003-07-04 19:04:45.000000000 +0200
+++ rpmlint.pl 2003-07-04 19:04:45.000000000 +0200
@@ -0,0 +1,345 @@
+#!/bin/sh -- # -*- perl -*-
+eval 'exec perl -S $0 ${1+"$@"}'
+ if $running_under_some_shell;
+##
+## rpmlint -- OpenPKG .rpm File Checker
+## Copyright (c) 2003 The OpenPKG Project <http://www.openpkg.org/>
+## Copyright (c) 2003 Ralf S. Engelschall <[EMAIL PROTECTED]>
+## Copyright (c) 2003 Cable & Wireless <http://www.cw.com/>
+##
+## Permission to use, copy, modify, and distribute this software for
+## any purpose with or without fee is hereby granted, provided that
+## the above copyright notice and this permission notice appear in all
+## copies.
+##
+## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
+## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
+## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+## SUCH DAMAGE.
+##
+
+require 5;
+use Getopt::Long;
+use IO;
+use strict;
+
+# program information
+my $progname = "rpmlint";
+my $progvers = "0.0.1";
+
+# parameters (defaults)
+my $version = 0;
+my $verbose = 0;
+my $help = 0;
+my $check = 'all';
+my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
+my $rpm = 'rpm';
+my $rpm2cpio = 'rpm2cpio';
+
+# exception handling support
+$SIG{__DIE__} = sub {
+ my ($err) = @_;
+ $err =~ s|\s+at\s+.*||s if (not $verbose);
+ print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
+ exit(1);
+};
+
+# command line parsing
+Getopt::Long::Configure("bundling");
+my $result = GetOptions(
+ 'V|version' => \$version,
+ 'v|verbose' => \$verbose,
+ 'h|help' => \$help,
+ 'c|check=s' => \$check,
+ 't|tmpdir=s' => \$tmpdir,
+ 'r|rpm=s' => \$rpm,
+) || die "option parsing failed";
+if ($help) {
+ print "Usage: $progname [options] [RPMFILE ...]\n" .
+ "Available options:\n" .
+ " -v,--verbose enable verbose run-time mode\n" .
+ " -h,--help print out this usage page\n" .
+ " -c,--check=CHECKS select checks to perform (default='all')\n" .
+ " -r,--rpm=FILE filesystem path to RPM program\n" .
+ " -t,--tmpdir=PATH filesystem path to temporary directory\n" .
+ " -V,--version print program version\n" .
+ exit(0);
+}
+if ($version) {
+ print "OpenPKG $progname $progvers\n";
+ exit(0);
+}
+
+# verbose message printing
+sub msg_verbose {
+ my ($msg) = @_;
+ print STDERR "$msg\n" if ($verbose);
+}
+
+# warning message printing
+sub msg_warning {
+ my ($msg) = @_;
+ print STDERR "$progname:WARNING: $msg\n";
+}
+
+# error message printing
+sub msg_error {
+ my ($msg) = @_;
+ print STDERR "$progname:ERROR: $msg\n";
+}
+
+# determine check list
+my @check_list = (qw(
+ layout
+ attrib
+ content
+));
+my @checks = ();
+if ($check eq 'all') {
+ @checks = @check_list;
+}
+else {
+ foreach my $c (split(/,/, $check)) {
+ if (not grep(/^$c$/, @check_list)) {
+ die "invalid check \"$c\"";
+ }
+ push(@checks, $c);
+ }
+}
+
+# global return code
+$main::GRC = 0;
+
+# environment preparation
+system("rm -rf $tmpdir");
+system("mkdir -p $tmpdir");
+
+# iterate over all .spec files
+foreach my $filename (@ARGV) {
+ die "unable to open file \"$filename\" for reading"
+ if (not -f $filename);
+ my $info = &rpm_info($filename, [EMAIL PROTECTED]);
+ foreach my $check (@checks) {
+ eval "\&check_$check(\$filename, \$info);";
+ }
+}
+
+# environment cleanup
+system("rm -rf $tmpdir");
+
+# die gracefully
+exit($main::GRC);
+
+## _________________________________________________________________
+##
+## COMMON SUBROUTINES
+## _________________________________________________________________
+##
+
+sub lint_message {
+ my ($type, $file, $msg) = @_;
+ $file =~ s|^.+?/([^/]+)$|$1|s;
+ printf(STDERR "%s:%s: %s: %s\n", $progname, $type, $file, $msg);
+}
+
+sub lint_warning {
+ my ($file, $msg) = @_;
+ &lint_message("WARNING", $file, $msg);
+ $main::GRC = 1 if ($main::GRC < 1);
+}
+
+sub lint_error {
+ my ($file, $msg) = @_;
+ &lint_message("ERROR", $file, $msg);
+ $main::GRC = 2 if ($main::GRC < 2);
+}
+
+## _________________________________________________________________
+##
+## RPM INFORMATION GATHERING
+## _________________________________________________________________
+##
+
+sub rpm_info {
+ my ($filename, $checks) = @_;
+ my $info = {};
+
+ # query prefix
+ &msg_verbose("++ querying RPM package installation prefix");
+ $info->{prefix} = `$rpm -qp --qf '%{PREFIXES}' $filename`;
+
+ # query file listing
+ &msg_verbose("++ querying RPM package file listing");
+ my @list = `$rpm -qplv $filename`;
+ my @config = `$rpm -qplc $filename`;
+
+ # process file listing
+ $info->{ls} = {};
+ foreach my $entry (@list) {
+ if ($entry =~ m|^\(contains no files\)\s*$|s) {
+ next;
+ }
+ elsif ($entry =~
m|^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\d+)\s+(.{12})\s+(.+)\s*$|s) {
+ my ($perm, $links, $owner, $group, $size, $mtime, $path) = ($1, $2, $3,
$4, $5, $6, $7);
+ my $symlink = "";
+ if ($path =~ m|^(\S+)\s+->\s+(\S+)$|) {
+ ($path, $symlink) = ($1, $2);
+ }
+ $path =~ s|\s+$||s;
+ my $config = 0;
+ if (grep(m|^$path$|, @config)) {
+ $config = 1;
+ }
+ $info->{ls}->{$path} = {
+ 'perm' => $perm,
+ 'links' => $links,
+ 'owner' => $owner,
+ 'group' => $group,
+ 'size' => $size,
+ 'time' => $mtime,
+ 'path' => $path,
+ 'symlink' => $symlink,
+ 'config' => $config,
+ };
+ }
+ else {
+ &lint_error($filename, "invalid file listing entry: \"$entry\"");
+ }
+ }
+
+ # unpacking files
+ if (grep(/^content$/, @checks)) {
+ &msg_verbose("++ unpacking RPM package files");
+ $info->{root} = "$tmpdir/root";
+ system("mkdir -p ".$info->{root});
+ system("$rpm2cpio $filename | (cd ".$info->{root}." && cpio -idmu
2>/dev/null)");
+ }
+
+ return $info;
+}
+
+## _________________________________________________________________
+##
+## CHECK "layout": file path layout
+## _________________________________________________________________
+##
+
+sub check_layout {
+ my ($rpm, $info) = @_;
+
+ # no need to check 'openpkg' package because it
+ # has a hard-coded file list!
+ return if ($rpm =~ m|^openpkg-\d+|);
+
+ # check prefix
+ if ($info->{prefix} !~ m|^/.+$|) {
+ &lint_error($rpm, "invalid installation prefix ".$info->{prefix}.
+ " (expected to match \"^/.+\$\")");
+ return;
+ }
+
+ # check top-level path (all-in-one)
+ my @topdirs = (qw(
+ bin cgi etc include info lib libexec
+ local man pub sbin share usr var
+ ));
+ my $topdirs = "{".join(",", @topdirs)."}";
+ if (not keys(%{$info->{ls}})) {
+ &lint_error($rpm, "invalid empty package (expected at least one file)");
+ return;
+ }
+ foreach my $path (keys(%{$info->{ls}})) {
+ my $ok = 0;
+ foreach my $topdir (@topdirs) {
+ my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
+ if ($path =~ m/^$prefix$/ && $rpm !~ m|^openpkg-\d+|) {
+ &lint_error($rpm, "top-level directory \"$topdir\" provided" .
+ " (expected none except for 'openpkg' package)");
+ }
+ if ($path =~ m/^$prefix/) {
+ $ok = 1;
+ last;
+ }
+ }
+ if (not $ok) {
+ &lint_error($rpm, "invalid top-level directory in path \"$path\"".
+ " (expected one of $topdirs)");
+ }
+ }
+
+ # check for second-level path (all-in-one)
+ my @topdirs_subdir_no = (qw(bin cgi info sbin));
+ my @topdirs_subdir_yes = (qw(etc libexec share var));
+ foreach my $path (keys(%{$info->{ls}})) {
+ foreach my $topdir (@topdirs_subdir_yes) {
+ my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
+ if ($path =~ m/^$prefix\/[^\/]+$/) {
+ if ($info->{ls}->{$path}->{perm} !~ m|^d|) {
+ &lint_error($rpm, "invalid positioned file \"$path\" under
topdir \"$topdir\" (expected directory)");
+ }
+ }
+ }
+ foreach my $topdir (@topdirs_subdir_no) {
+ my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
+ if ($path =~ m/^$prefix\/[^\/]+$/) {
+ if ($info->{ls}->{$path}->{perm} =~ m|^d|) {
+ &lint_error($rpm, "invalid positioned directory \"$path\" under
topdir \"$topdir\" (expected file)");
+ }
+ }
+ }
+ }
+
+ # check "bin" and "sbin" directories
+ foreach my $path (keys(%{$info->{ls}})) {
+ foreach my $topdir (qw(bin sbin)) {
+ my $prefix = quotemeta($info->{prefix} . "/" . $topdir);
+ if ($path =~ m/^$prefix\/(.+)$/) {
+ my $file = $1;
+ if ($file =~ m|^[^/]+\.[^/.]+$|) {
+ &lint_warning($rpm, "strange executable filename \"$path\"
containing an extension (expected no extension)");
+ }
+ my $perm = $info->{ls}->{$path}->{'perm'};
+ if ($perm =~ m|^-| && $perm !~ m|^-([-r][-w][sx]){3}$|) {
+ &lint_error($rpm, "non-executable file \"$path\" under topdir
\"$topdir\" (expected to be executable)");
+ }
+ }
+ }
+ }
+}
+
+## _________________________________________________________________
+##
+## CHECK "attrib": file attributes
+## _________________________________________________________________
+##
+
+sub check_attrib {
+ my ($rpm, $info) = @_;
+
+ # permissions
+ # user/group
+ # size
+ # %config flag
+}
+
+## _________________________________________________________________
+##
+## CHECK "content": file content
+## _________________________________________________________________
+##
+
+sub check_content {
+ my ($rpm, $info) = @_;
+
+ # stripped (file)
+ # syslibs (ldd)
+}
+
@@ .
______________________________________________________________________
The OpenPKG Project www.openpkg.org
CVS Repository Commit List [EMAIL PROTECTED]
