[SCM] Debian package checker branch, master, updated. 2.5.13-41-g5ac5f5d
The following commit has been merged in the master branch:
commit 5ac5f5dc1d14f5a538445e1705b967d26afaa531
Author: Niels Thykier <niels@thykier.net>
Date: Sun Jun 23 13:17:01 2013 +0200
L::C::Package: Have sorted_*index return L::Path objects
Have sorted_index (etc.) return a list of L::Path objects instead of
just strings. With this patch:
for my $file ($info->sorted_index) {
my $path = $info->index($file);
...
}
Can be reduced to:
for my $path ($info->sorted_index) {
...
}
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/checks/apache2.pm b/checks/apache2.pm
index fd6d3ab..2eddad5 100644
--- a/checks/apache2.pm
+++ b/checks/apache2.pm
@@ -42,11 +42,9 @@ sub run {
if ($type eq 'binary') {
foreach my $file ($info->sorted_index) {
- next if $file eq '';
- my $index_info = $info->index ($file);
# File is probably not relevant to us, ignore it
- next if $index_info->is_dir;
+ next if $file->is_dir;
next if $file !~ m#^(?:usr/lib/apache2/modules/|etc/apache2/)#;
diff --git a/checks/binaries.pm b/checks/binaries.pm
index 08b1cca..a94cdfd 100644
--- a/checks/binaries.pm
+++ b/checks/binaries.pm
@@ -218,15 +218,11 @@ tag 'package-name-doesnt-match-sonames', "@sonames"
if @sonames && !$match_found;
my %directories;
-foreach ($info->sorted_index) {
- next unless length $_;
- # create copy, don't modify the index
- my $path = $_;
-
- my $index_info = $info->index ($path);
- next unless $index_info->is_dir || $index_info->is_symlink;
- $path =~ s,/\z,,;
- $directories{"/$path"}++;
+for my $file ($info->sorted_index) {
+ my $name = $file->name;
+ next unless $file->is_dir || $file->is_symlink;
+ $name =~ s,/\z,,;
+ $directories{"/$name"}++;
}
# process all files in package
@@ -408,7 +404,7 @@ foreach my $file ($info->sorted_index) {
for $lib (@{$objdump->{NEEDED}}) {
if ($lib =~ /^libc\.so\.(\d+.*)/) {
$needs_libc = "libc$1";
- $needs_libc_file = $file unless $needs_libc_file;
+ $needs_libc_file = $file->name unless $needs_libc_file;
$needs_libc_count++;
$no_libc = 0;
}
diff --git a/checks/changelog-file.pm b/checks/changelog-file.pm
index 96d2e46..32504b3 100644
--- a/checks/changelog-file.pm
+++ b/checks/changelog-file.pm
@@ -55,13 +55,12 @@ return 0 if $info->index ("usr/share/doc/$pkg") and
# Modify the file_info by following symbolic links.
for my $file ($info->sorted_index) {
next unless $file =~ m/doc/o;
- my $path = $info->index ($file);
$file_info{$file} = $info->file_info ($file);
- if ($path->is_symlink) {
+ if ($file->is_symlink) {
# A symlink; use its target info if available.
- my $target = $path->link_normalized;
+ my $target = $file->link_normalized;
my $tinfo = $info->file_info ($target);
$file_info{$file} = $tinfo if defined $tinfo;
}
@@ -69,9 +68,8 @@ for my $file ($info->sorted_index) {
# Read package contents.... Capitalization errors are dealt with later.
foreach ($info->sorted_index) {
- next unless length $_;
- # we are only interested in files or symlinks in /usr/(share/)?doc/$pkg
+ # we are only interested in files or symlinks in /usr/share/doc/$pkg
if (m,usr/share/doc/$ppkg/([^/\s]+), ) {
my $file = $1;
my $file1 = "usr/share/doc/$pkg/$file";
diff --git a/checks/conffiles.pm b/checks/conffiles.pm
index 45e45b3..965f256 100644
--- a/checks/conffiles.pm
+++ b/checks/conffiles.pm
@@ -84,11 +84,10 @@ if (-f $cf) {
# Read package contents...
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index($file);
- if (not $index_info->is_file and exists $conffiles{$file}) {
+ if (not $file->is_file and exists $conffiles{$file}) {
tag 'conffile-has-bad-file-type', $file;
}
- next unless $file =~ m{^ etc/ }xsm and $index_info->is_file;
+ next unless $file =~ m{^ etc/ }xsm and $file->is_file;
# If there is a /etc/foo, it must be a conffile (with a few exceptions).
if (not exists($conffiles{$file})
diff --git a/checks/control-files.pm b/checks/control-files.pm
index 90ede4b..3118747 100644
--- a/checks/control-files.pm
+++ b/checks/control-files.pm
@@ -42,8 +42,6 @@ my $ctrl_alt = $type eq 'udeb' ? $DEB_PERMISSIONS : $UDEB_PERMISSIONS;
# process control-index file
foreach my $file ($info->sorted_control_index) {
- next unless $file;
- my $cindex_info = $info->control_index ($file);
my $owner;
my $operm;
my $experm;
@@ -52,7 +50,7 @@ foreach my $file ($info->sorted_control_index) {
# dir, but that /should/ the "empty file" case in the beginning of
# the loop) In any event, allow directories just in case - the
# check here is mostly to catch symlinks (and "devices" etc.)
- if (not ($cindex_info->is_regular_file or $cindex_info->is_dir)) {
+ if (not ($file->is_regular_file or $file->is_dir)) {
tag 'control-file-is-not-a-file', $file;
# Doing further checks is probably not going to yield anything
# remotely useful.
@@ -73,7 +71,7 @@ foreach my $file ($info->sorted_control_index) {
$experm = $ctrl->value($file);
# I'm not sure about the udeb case
- if ($type ne 'udeb' and $cindex_info->size == 0) {
+ if ($type ne 'udeb' and $file->size == 0) {
tag 'control-file-is-empty', $file;
}
@@ -82,7 +80,7 @@ foreach my $file ($info->sorted_control_index) {
# this file isn't installed on the systems anyways)
next if $file eq 'control';
- $operm = $cindex_info->operm;
+ $operm = $file->operm;
# correct permissions?
unless ($operm == $experm) {
@@ -90,7 +88,7 @@ foreach my $file ($info->sorted_control_index) {
sprintf('%s %04o != %04o', $file, $operm, $experm);
}
- $owner = $cindex_info->owner . '/' . $cindex_info->group;
+ $owner = $file->owner . '/' . $file->group;
# correct owner?
unless ($owner eq 'root/root') {
diff --git a/checks/fields.pm b/checks/fields.pm
index 47687d4..df6eb63 100644
--- a/checks/fields.pm
+++ b/checks/fields.pm
@@ -583,7 +583,7 @@ my $metapackage = 0;
if ($type eq 'binary') {
$metapackage = 1;
for my $file ($info->sorted_index) {
- next if $info->index ($file)->is_dir;
+ next if $file->is_dir;
next if $file =~ m%^usr/share/doc/%;
next if $file =~ m%^usr/share/lintian/overrides/%;
next if $file =~ m%^usr/share/cdd/%;
diff --git a/checks/files.pm b/checks/files.pm
index b7ebdd7..e9e4d98 100644
--- a/checks/files.pm
+++ b/checks/files.pm
@@ -243,18 +243,17 @@ if (!$is_dummy) {
# Read package contents...
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index ($file);
- my $owner = $index_info->owner . '/' . $index_info->group;
- my $operm = $index_info->operm;
- my $link = $index_info->link;
+ my $owner = $file->owner . '/' . $file->group;
+ my $operm = $file->operm;
+ my $link = $file->link;
$arch_dep_files = 1 if $file !~ m,^usr/share/,o && $file ne 'usr/';
- if (!is_string_utf8_encoded($file)) {
+ if (!is_string_utf8_encoded($file->name)) {
tag 'file-name-is-not-valid-UTF-8', $file;
}
- if ($index_info->is_hardlink) {
+ if ($file->is_hardlink) {
my $link_target_dir = $link;
$link_target_dir =~ s,[^/]*$,,;
@@ -271,16 +270,16 @@ foreach my $file ($info->sorted_index) {
or $file !~ m,^\Q$link_target_dir\E[^/]*$,;
}
- my ($year) = ($index_info->date =~ /^(\d{4})/);
+ my ($year) = ($file->date =~ /^(\d{4})/);
if ( $year <= 1975 ) { # value from dak CVS: Dinstall::PastCutOffYear
- tag 'package-contains-ancient-file', "$file " . $index_info->{date};
+ tag 'package-contains-ancient-file', $file, $file->date;
}
- if (!($index_info->uid < 100 || $index_info->uid == 65_534
- || ($index_info->uid >= 60_000 && $index_info->uid < 65_000))
- || !($index_info->gid < 100 || $index_info->gid == 65_534
- || ($index_info->gid >= 60_000 && $index_info->gid < 65_000))) {
- tag 'wrong-file-owner-uid-or-gid', $file, $index_info->uid . '/' . $index_info->gid;
+ if (!($file->uid < 100 || $file->uid == 65_534
+ || ($file->uid >= 60_000 && $file->uid < 65_000))
+ || !($file->gid < 100 || $file->gid == 65_534
+ || ($file->gid >= 60_000 && $file->gid < 65_000))) {
+ tag 'wrong-file-owner-uid-or-gid', $file, $file->uid . '/' . $file->gid;
}
# *.devhelp and *.devhelp2 files must be accessible from a directory in
@@ -314,7 +313,7 @@ foreach my $file ($info->sorted_index) {
tag 'bad-permissions-for-etc-cron.d-script', sprintf('%s %04o != 0644',$file,$operm);
}
# ---------------- /etc/emacs.*
- elsif ($file =~ m,^etc/emacs.*/\S, and $index_info->is_file
+ elsif ($file =~ m,^etc/emacs.*/\S, and $file->is_file
and $operm != 0644) {
tag 'bad-permissions-for-etc-emacs-script', sprintf('%s %04o != 0644',$file,$operm);
}
@@ -326,7 +325,7 @@ foreach my $file ($info->sorted_index) {
elsif ($file =~ m,^etc/init\.d/\S,
and $file !~ m,^etc/init\.d/(?:README|skeleton)$,
and $operm != 0755
- and $index_info->is_file) {
+ and $file->is_file) {
tag 'non-standard-file-permissions-for-etc-init.d-script',
sprintf('%s %04o != 0755',$file,$operm);
}
@@ -335,7 +334,7 @@ foreach my $file ($info->sorted_index) {
tag 'package-modifies-ld.so-search-path', $file;
}
#----------------- /etc/modprobe.d
- elsif ($file =~ m,^etc/modprobe\.d/(.+)$, and $1 !~ m,\.conf$, and not $index_info->is_dir) {
+ elsif ($file =~ m,^etc/modprobe\.d/(.+)$, and $1 !~ m,\.conf$, and not $file->is_dir) {
tag 'non-conf-file-in-modprobe.d', $file;
}
#---------------- /etc/opt
@@ -348,8 +347,8 @@ foreach my $file ($info->sorted_index) {
}
#----------------- /etc/php5/conf.d
elsif ($file =~ m,^etc/php5/conf.d/.+\.ini$,) {
- if ($index_info->is_file) {
- open(my $fd, '<', $info->unpacked($index_info));
+ if ($file->is_file) {
+ open(my $fd, '<', $info->unpacked($file));
while (<$fd>) {
next unless (m/^\s*#/);
tag 'obsolete-comments-style-in-php-ini', $file;
@@ -385,12 +384,12 @@ foreach my $file ($info->sorted_index) {
}
# file directly in /usr/share/doc ?
- if ($index_info->is_file and $file =~ m,^usr/share/doc/[^/]+$,) {
+ if ($file->is_file and $file =~ m,^usr/share/doc/[^/]+$,) {
tag 'file-directly-in-usr-share-doc', $file;
}
# executable in /usr/share/doc ?
- if ($index_info->is_file and
+ if ($file->is_file and
$file !~ m,^usr/share/doc/(?:[^/]+/)?examples/, and
($operm & 0111)) {
if ($script{$file}) {
@@ -401,7 +400,7 @@ foreach my $file ($info->sorted_index) {
}
# zero byte file in /usr/share/doc/
- if ($index_info->size == 0 and $index_info->is_regular_file) {
+ if ($file->size == 0 and $file->is_regular_file) {
# Exceptions: examples may contain empty files for various
# reasons, Doxygen generates empty *.map files, and Python
# uses __init__.py to mark module directories.
@@ -413,10 +412,10 @@ foreach my $file ($info->sorted_index) {
}
# gzipped zero byte files:
# 276 is 255 bytes (maximal length for a filename) + gzip overhead
- if ($file =~ m,.gz$, and $index_info->size <= 276
- and $index_info->is_file
+ if ($file =~ m,.gz$, and $file->size <= 276
+ and $file->is_file
and $info->file_info ($file) =~ m/gzip compressed/) {
- my $fd = open_gz($info->unpacked($index_info));
+ my $fd = open_gz($info->unpacked($file));
my $f = <$fd>;
close($fd);
unless (defined $f and length $f) {
@@ -448,7 +447,7 @@ foreach my $file ($info->sorted_index) {
#----------------- /usr/X11R6/
elsif ($file =~ m,^usr/X11R6/, and
- not $index_info->is_symlink) { #links to FHS locations are allowed
+ not $file->is_symlink) { #links to FHS locations are allowed
tag 'package-installs-file-to-usr-x11r6', $file;
}
@@ -460,7 +459,7 @@ foreach my $file ($info->sorted_index) {
$warned_debug_name = 1;
}
- if ($index_info->is_file &&
+ if ($file->is_file &&
$file =~ m,^usr/lib/debug/usr/lib/pyshared/(python\d?(?:\.\d+))/(.++)$,o){
my $correct = "usr/lib/debug/usr/lib/pymodules/$1/$2";
tag 'python-debug-in-wrong-location', $file, $correct;
@@ -493,7 +492,7 @@ foreach my $file ($info->sorted_index) {
}
# ---------------- /usr/local
elsif ($file =~ m,^usr/local/\S+,) {
- if ($index_info->is_dir) {
+ if ($file->is_dir) {
tag 'dir-in-usr-local', $file;
} else {
tag 'file-in-usr-local', $file;
@@ -508,10 +507,10 @@ foreach my $file ($info->sorted_index) {
if ($type eq 'udeb') {
tag 'udeb-contains-documentation-file', $file;
}
- if ($index_info->is_dir) {
+ if ($file->is_dir) {
tag 'stray-directory-in-manpage-directory', $file
if ($file !~ m,^usr/(?:X11R6|share)/man/(?:[^/]+/)?(?:man\d/)?$,);
- } elsif ($index_info->is_file and ($operm & 0111)) {
+ } elsif ($file->is_file and ($operm & 0111)) {
tag 'executable-manpage', $file;
}
}
@@ -553,13 +552,13 @@ foreach my $file ($info->sorted_index) {
}
# ---------------- /usr/share
elsif ($file =~ m,^usr/share/[^/]+$,) {
- if ($index_info->is_file) {
+ if ($file->is_file) {
tag 'file-directly-in-usr-share', $file;
}
}
# ---------------- /usr/bin
elsif ($file =~ m,^usr/bin/,) {
- if ($index_info->is_dir and $file =~ m,^usr/bin/., and $file !~ m,^usr/bin/(?:X11|mh)/,) {
+ if ($file->is_dir and $file =~ m,^usr/bin/., and $file !~ m,^usr/bin/(?:X11|mh)/,) {
tag 'subdir-in-usr-bin', $file;
}
}
@@ -598,7 +597,7 @@ foreach my $file ($info->sorted_index) {
# ---------------- non-games-specific data in games subdirectory
elsif ($file =~ m,^usr/share/games/(?:applications|mime|icons|pixmaps)/,
- and not $index_info->is_dir) {
+ and not $file->is_dir) {
tag 'global-data-in-games-directory', $file;
}
}
@@ -662,7 +661,7 @@ foreach my $file ($info->sorted_index) {
}
# ---------------- /bin
elsif ($file =~ m,^bin/,) {
- if ($index_info->is_dir and $file =~ m,^bin/.,) {
+ if ($file->is_dir and $file =~ m,^bin/.,) {
tag 'subdir-in-bin', $file;
}
}
@@ -705,7 +704,7 @@ foreach my $file ($info->sorted_index) {
}
# ---------------- any files
- if (not $index_info->is_dir) {
+ if (not $file->is_dir) {
unless ($type eq 'udeb'
or $file =~ m,^usr/(?:bin|dict|doc|games|
include|info|lib(?:x?32|64)?|
@@ -738,7 +737,7 @@ foreach my $file ($info->sorted_index) {
}
# ---------------- __pycache__ (directory for pyc/pyo files)
- if ($index_info->is_dir && $file =~ m,/__pycache__/,o){
+ if ($file->is_dir && $file =~ m,/__pycache__/,o){
tag 'package-installs-python-pycache-dir', $file;
}
@@ -785,8 +784,8 @@ foreach my $file ($info->sorted_index) {
# we do the same check on perl scripts in checks/scripts
{
my $dep = $info->relation('strong');
- if ($index_info->is_file && $file =~ m,\.pm$, && !$dep->implies ('libperl4-corelibs-perl | perl (<< 5.12.3-7)')) {
- open(my $fd, '<', $info->unpacked($index_info));
+ if ($file->is_file && $file =~ m,\.pm$, && !$dep->implies('libperl4-corelibs-perl | perl (<< 5.12.3-7)')) {
+ open(my $fd, '<', $info->unpacked($file));
while (<$fd>) {
if (/(?:do|require)\s+(?:'|")(abbrev|assert|bigfloat|bigint|bigrat|cacheout|complete|ctime|dotsh|exceptions|fastcwd|find|finddepth|flush|getcwd|getopt|getopts|hostname|importenv|look|newgetopt|open2|open3|pwd|shellwords|stat|syslog|tainted|termcap|timelocal|validate)\.pl(?:'|")/) {
tag 'perl-module-uses-perl4-libs-without-dep', "$file:$. ${1}.pl";
@@ -914,10 +913,10 @@ foreach my $file ($info->sorted_index) {
if ($file =~ m,/icons/[^/]+/(\d+)x(\d+)/(?!animations/).*\.png$,) {
my ($dwidth, $dheight) = ($1, $2);
my $path;
- if ($index_info->is_symlink) {
- $path = $index_info->link_normalized;
+ if ($file->is_symlink) {
+ $path = $file->link_normalized;
} else {
- $path = $file;
+ $path = $file->name;
}
my $fileinfo = $info->file_info ($path);
if ($fileinfo && $fileinfo =~ m/,\s*(\d+)\s*x\s*(\d+)\s*,/) {
@@ -934,7 +933,7 @@ foreach my $file ($info->sorted_index) {
}
# ---------------- plain files
- if ($index_info->is_file) {
+ if ($file->is_file) {
# ---------------- backup files and autosave files
if ($file =~ /~$/ or $file =~ m,\#[^/]+\#$, or $file =~ m,/\.[^/]+\.swp$,) {
tag 'backup-file-in-package', $file;
@@ -987,7 +986,7 @@ foreach my $file ($info->sorted_index) {
# ---------------- embedded Feedparser library
if ($file =~ m,/feedparser\.py$, and $pkg ne 'python-feedparser') {
- open(my $fd, '<', $info->unpacked($index_info));
+ open(my $fd, '<', $info->unpacked($file));
while (<$fd>) {
if (m,Universal feed parser,) {
tag 'embedded-feedparser-library', $file;
@@ -1000,7 +999,7 @@ foreach my $file ($info->sorted_index) {
# ---------------- embedded PEAR modules
foreach my $pearmodule (@pearmodules) {
if ($file =~ m,/$pearmodule->[0], and $pkg ne $pearmodule->[1]) {
- open(my $fd, '<', $info->unpacked($index_info));
+ open(my $fd, '<', $info->unpacked($file));
while (<$fd>) {
if (m,/pear[/.],i) {
tag 'embedded-pear-module', $file;
@@ -1029,7 +1028,7 @@ foreach my $file ($info->sorted_index) {
}
my $finfo = $info->file_info ($file) || '';
if ($finfo =~ m/PostScript Type 1 font program data/) {
- my $path = $info->unpacked($index_info);
+ my $path = $info->unpacked($file);
my $foundadobeline = 0;
open(my $t1pipe, '-|', 't1disasm', $path);
while (my $line = <$t1pipe>) {
@@ -1071,7 +1070,7 @@ foreach my $file ($info->sorted_index) {
if ($finfo !~ m/gzip compressed/) {
tag 'gz-file-not-gzip', $file;
} elsif ($isma_same && $file !~ m/\Q$arch\E/o) {
- my $path = $info->unpacked($index_info);
+ my $path = $info->unpacked($file);
my $buff;
open(my $fd, '<', $path);
# We need to read at least 8 bytes
@@ -1100,8 +1099,8 @@ foreach my $file ($info->sorted_index) {
if ($operm & 06000) {
my ($setuid, $setgid) = ('','');
# get more info:
- $setuid = $index_info->owner if $operm & 04000;
- $setgid = $index_info->group if $operm & 02000;
+ $setuid = $file->owner if $operm & 04000;
+ $setgid = $file->group if $operm & 02000;
# 1st special case: program is using svgalib:
if (exists $linked_against_libvga{$file}) {
@@ -1184,7 +1183,7 @@ foreach my $file ($info->sorted_index) {
}
}
# ---------------- directories
- elsif ($index_info->is_dir) {
+ elsif ($file->is_dir) {
# special cases first:
# game directory with setgid bit
if ($file =~ m,^var/(?:lib/)?games/\S+, and $operm == 02775
@@ -1253,7 +1252,7 @@ foreach my $file ($info->sorted_index) {
}
}
# ---------------- symbolic links
- elsif ($index_info->is_symlink) {
+ elsif ($file->is_symlink) {
# link
my $mylink = $link;
diff --git a/checks/group-checks.pm b/checks/group-checks.pm
index d682993..380a986 100644
--- a/checks/group-checks.pm
+++ b/checks/group-checks.pm
@@ -131,18 +131,14 @@ sub _check_file_overlap {
sub _overlap_check {
my ($a_proc, $a_info, $b_proc, $b_info) = @_;
- foreach my $raw ($a_info->sorted_index) {
- my $file;
- my $a_file;
+ foreach my $a_file ($a_info->sorted_index) {
+ my $name = $a_file->name;
my $b_file;
- next unless $raw;
- $file = $raw; # copy, because we have to modifiy it
- $file =~ s,/$,,o;
- $b_file = $b_info->index ($file) // $b_info->index ("$file/");
+ $name =~ s,/$,,o;
+ $b_file = $b_info->index($name) // $b_info->index ("$name/");
if ($b_file) {
- $a_file = $a_info->index ($file) // $a_info->index ("$file/");
next if $a_file->is_dir and $b_file->is_dir;
- tag 'binaries-have-file-conflict', $a_proc->pkg_name, $b_proc->pkg_name, $file;
+ tag 'binaries-have-file-conflict', $a_proc->pkg_name, $b_proc->pkg_name, $name;
}
}
}
diff --git a/checks/huge-usr-share.pm b/checks/huge-usr-share.pm
index 2ef48e4..37ea2ae 100644
--- a/checks/huge-usr-share.pm
+++ b/checks/huge-usr-share.pm
@@ -43,9 +43,9 @@ return 0 if $arch eq 'all';
# in /usr/share. Convert the totals to kilobytes.
my ($size, $size_usrshare) = (0, 0);
for my $file ($info->sorted_index) {
- $size += $info->index ($file)->size;
+ $size += $file->size;
if ($file =~ m,usr/share/,) {
- $size_usrshare += $info->index ($file)->size;
+ $size_usrshare += $file->size;
}
}
$size = int ($size / 1024);
diff --git a/checks/infofiles.pm b/checks/infofiles.pm
index a1feb42..16f24fd 100644
--- a/checks/infofiles.pm
+++ b/checks/infofiles.pm
@@ -35,11 +35,10 @@ my (undef, undef, $info) = @_;
# Read package contents...
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index ($file);
my $file_info = $info->file_info ($file);
my ($fname, $path) = fileparse($file);
- next unless ($index_info->is_symlink or $index_info->is_file)
+ next unless ($file->is_symlink or $file->is_file)
and ($path =~ m,^usr/share/info/, or $path =~ m,^usr/info/,);
# Ignore dir files. That's a different error which we already catch in
@@ -52,7 +51,7 @@ foreach my $file ($info->sorted_index) {
my @fname_pieces = split /\./, $fname;
my $ext = pop @fname_pieces;
if ($ext eq 'gz') { # ok!
- if ($index_info->is_file) { # compressed with maximum compression rate?
+ if ($file->is_file) { # compressed with maximum compression rate?
if ($file_info !~ m/gzip compressed data/o) {
tag 'info-document-not-compressed-with-gzip', $file;
} else {
@@ -77,11 +76,11 @@ foreach my $file ($info->sorted_index) {
# If this is the main info file (no numeric extension). make sure it has
# appropriate dir entry information.
if ($fname !~ /-\d+\.gz/ && $file_info =~ /gzip compressed data/) {
- if ($index_info->is_symlink && !is_ancestor_of($info->unpacked, $file)) {
+ if ($file->is_symlink && !is_ancestor_of($info->unpacked, $file)) {
# unsafe symlink, skip
next;
}
- my $fd = open_gz($info->unpacked($index_info));
+ my $fd = open_gz($info->unpacked($file));
local $_;
my ($section, $start, $end);
while (<$fd>) {
diff --git a/checks/manpages.pm b/checks/manpages.pm
index 0d7e91b..c6d24a0 100644
--- a/checks/manpages.pm
+++ b/checks/manpages.pm
@@ -44,9 +44,8 @@ my %manpage;
# Read package contents...
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index ($file);
- my $file_info = $info->file_info ($file);
- my $link = $index_info->link || '';
+ my $file_info = $info->file_info($file);
+ my $link = $file->link || '';
my ($fname, $path, $suffix) = fileparse($file);
# Binary that wants a manual page?
@@ -54,7 +53,7 @@ foreach my $file ($info->sorted_index) {
# It's tempting to check the section of the man page depending on the
# location of the binary, but there are too many mismatches between
# bin/sbin and 1/8 that it's not clear it's the right thing to do.
- if (($index_info->is_symlink or $index_info->is_file) and
+ if (($file->is_symlink or $file->is_file) and
(($path eq 'bin/') or
($path eq 'sbin/') or
($path eq 'usr/bin/') or
@@ -77,7 +76,7 @@ foreach my $file ($info->sorted_index) {
}
# manual page?
- next unless ($index_info->is_symlink or $index_info->is_file) and
+ next unless ($file->is_symlink or $file->is_file) and
(($path =~ m,^usr/man(/\S+),o)
or ($path =~ m,^usr/X11R6/man(/\S+),o)
or ($path =~ m,^usr/share/man(/\S+),o) );
@@ -103,7 +102,7 @@ foreach my $file ($info->sorted_index) {
if ($ext ne 'gz') {
push @pieces, $ext;
tag 'manpage-not-compressed', $file;
- } elsif ($index_info->is_file) { # so it's .gz... files first; links later
+ } elsif ($file->is_file) { # so it's .gz... files first; links later
if ($file_info !~ m/gzip compressed data/o) {
tag 'manpage-not-compressed-with-gzip', $file;
} elsif ($file_info !~ m/max compression/o) {
@@ -126,7 +125,7 @@ foreach my $file ($info->sorted_index) {
}
# check symbolic links to other manual pages
- if ($index_info->is_symlink) {
+ if ($file->is_symlink) {
if ($link =~ m,(^|/)undocumented,o) {
if ($path =~ m,^usr/share/man,o) {
# undocumented link in /usr/share/man -- possibilities
@@ -158,7 +157,7 @@ foreach my $file ($info->sorted_index) {
}
}
} else { # not a symlink
- my $path = $info->unpacked($index_info);
+ my $path = $info->unpacked($file);
my $fd;
if ($file_info =~ m/gzip compressed/) {
$fd = open_gz($path);
@@ -168,7 +167,7 @@ foreach my $file ($info->sorted_index) {
my @manfile = <$fd>;
close $fd;
# Is it a .so link?
- if ($index_info->size < 256) {
+ if ($file->size < 256) {
my ($i, $first) = (0, '');
do {
$first = $manfile[$i++] || '';
@@ -352,11 +351,9 @@ foreach my $depproc (@{ $ginfo->direct_dependencies ($proc) }) {
# Find the manpages in our related dependencies
my $depinfo = $depproc->info();
foreach my $file ($depinfo->sorted_index){
- next if $file eq '';
- my $index_info = $depinfo->index ($file);
my ($fname, $path, $suffix) = fileparse($file, qr,\..+$,o);
my $lang = '';
- next unless ($index_info->is_file or $index_info->is_symlink) and
+ next unless ($file->is_file or $file->is_symlink) and
(($path =~ m,^usr/man/\S+,o)
or ($path =~ m,^usr/X11R6/man/\S+,o)
or ($path =~ m,^usr/share/man/\S+,o) );
diff --git a/checks/md5sums.pm b/checks/md5sums.pm
index cbca317..8711910 100644
--- a/checks/md5sums.pm
+++ b/checks/md5sums.pm
@@ -50,8 +50,8 @@ unless (-f $control) {
my $only_conffiles = 1;
foreach my $file ($info->sorted_index) {
# Skip non-files, they will not appear in the md5sums file
- next unless $info->index ($file)->is_regular_file;
- unless ($info->is_conffile ($file)) {
+ next unless $file->is_regular_file;
+ unless ($info->is_conffile($file)) {
$only_conffiles = 0;
last;
}
diff --git a/checks/menu-format.pm b/checks/menu-format.pm
index 7e500c4..5757eb8 100644
--- a/checks/menu-format.pm
+++ b/checks/menu-format.pm
@@ -221,12 +221,11 @@ for my $dir ("$mdir/lib", "$mdir/share") {
# Find the desktop files in the package for verification.
my @desktop_files;
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index ($file);
- my $operm = $index_info->operm;
+ my $operm = $file->operm;
tag 'deprecated-kdelnk-file', $file if ($file =~ m,\.kdelnk$,);
- if ($index_info->is_file &&
+ if ($file->is_file &&
$file =~ m,^usr/share/applications/.*\.desktop$,) {
if ($operm & 0111) {
@@ -679,9 +678,9 @@ sub verify_desktop_file {
# TODO: Should check quoting and the check special field
# codes in Exec for desktop files.
if ($file =~ m,^usr/share/applications/, and $vals{'Exec'} and $vals{'Exec'} =~ /\S/) {
- my ($okay, $command) = verify_cmd($file, undef, $vals{'Exec'}, $pkg,
+ my ($okay, $command) = verify_cmd($file->name, undef, $vals{'Exec'}, $pkg,
$info);
- tag 'desktop-command-not-in-package', "$file $command"
+ tag 'desktop-command-not-in-package', $file, $command
unless $okay or $command eq 'kcmshell';
}
diff --git a/checks/menus.pm b/checks/menus.pm
index 8b24ef4..a11fa2e 100644
--- a/checks/menus.pm
+++ b/checks/menus.pm
@@ -76,13 +76,11 @@ check_script($pkg, $info->control('postrm'), 'postrm', \%postrm);
# read package contents
for my $file ($info->sorted_index) {
- next if $file eq '';
- add_file_link_info ($info, $file, \%all_files, \%all_links);
- my $index_info = $info->index ($file);
- my $operm = $index_info->operm;
+ add_file_link_info($info, $file->name, \%all_files, \%all_links);
+ my $operm = $file->operm;
- if ($index_info->is_file) { # file checks
+ if ($file->is_file) { # file checks
# menu file?
if ($file =~ m,^usr/(lib|share)/menu/\S,o) { # correct permissions?
if ($operm & 0111) {
diff --git a/checks/scripts.pm b/checks/scripts.pm
index 3449b3b..08ab785 100644
--- a/checks/scripts.pm
+++ b/checks/scripts.pm
@@ -204,12 +204,10 @@ my %scripts = ();
# says not to depend on it.
foreach my $file ($info->sorted_index) {
- next if $file eq '';
$ELF{$file} = 1 if $info->file_info ($file) =~ /^[^,]*\bELF\b/o;
- my $index_info = $info->index ($file);
- my $operm = $index_info->operm;
- next unless $index_info->is_file and ($operm & 0111);
+ my $operm = $file->operm;
+ next unless $file->is_file and ($operm & 0111);
$executable{$file} = 1;
}
diff --git a/checks/shared-libs.pm b/checks/shared-libs.pm
index e062058..0fed09e 100644
--- a/checks/shared-libs.pm
+++ b/checks/shared-libs.pm
@@ -77,7 +77,6 @@ foreach my $file (sort keys %{$objdump}) {
}
foreach my $file ($info->sorted_index) {
- next unless length $file;
my $fileinfo = $info->file_info ($file);
if ($fileinfo =~ m/^[^,]*\bELF\b/ && $fileinfo =~ m/shared object/) {
$sharedobject{$file} = 1;
@@ -97,17 +96,16 @@ if (%SONAME) {
for my $cur_file ($info->sorted_index) {
# shared library?
- my $cur_file_data = $info->index ($cur_file);
if (exists $SONAME{$cur_file} or
- (defined $cur_file_data->link and exists $SONAME{abs_path(dirname($cur_file).'/'.$cur_file_data->link)})) {
+ (defined $cur_file->link and exists $SONAME{abs_path(dirname($cur_file).'/'.$cur_file->link)})) {
# yes!!
my ($real_file, $perm);
if (exists $SONAME{$cur_file}) {
$real_file = $cur_file;
- $perm = $cur_file_data->operm;
+ $perm = $cur_file->operm;
} else {
- $real_file = abs_path (dirname ($cur_file) . '/' . $cur_file_data->link);
+ $real_file = abs_path(dirname($cur_file) . '/' . $cur_file->link);
# perm not needed for this branch
}
@@ -165,15 +163,16 @@ for my $cur_file ($info->sorted_index) {
} elsif ($ldconfig_dirs->known(dirname($cur_file))
&& exists $sharedobject{$cur_file}) {
tag 'sharedobject-in-library-directory-missing-soname', $cur_file;
- } elsif ($cur_file =~ m/\.la$/ and not defined $cur_file_data->link) {
+ } elsif ($cur_file =~ m/\.la$/ and not defined $cur_file->link) {
local $_;
- open(my $fd, '<', $info->unpacked($cur_file_data));
+ open(my $fd, '<', $info->unpacked($cur_file));
while(<$fd>) {
next unless (m/^(libdir)='(.+?)'$/) or (m/^(dependency_libs)='(.+?)'$/);
my ($field, $value) = ($1, $2);
if ($field eq 'libdir') {
+ # dirname with leading slash and without the trailing one.
+ my $expected = '/' . substr($cur_file->dirname, 0, -1);
$value =~ s,/+$,,;
- my ($expected) = ("/$cur_file" =~ m,^(.+)/[^/]+$,);
# python-central is a special case since the libraries are moved
# at install time.
diff --git a/checks/symlinks.pm b/checks/symlinks.pm
index 7aeefe4..6b2b095 100644
--- a/checks/symlinks.pm
+++ b/checks/symlinks.pm
@@ -35,13 +35,12 @@ my @brokenlinks;
my @dindexes;
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index ($file);
- if ($index_info->is_symlink){
- my $target = $index_info->link//''; # the link target
+ if ($file->is_symlink){
+ my $target = $file->link//''; # the link target
my $path; # the target (from the pkg root)
# Should not happen (too often) - but just in case
next unless $target;
- $path = $index_info->link_normalized;
+ $path = $file->link_normalized;
if (not defined $path) {
# Unresolvable link
tag 'package-contains-unsafe-symlink', $file;
diff --git a/collection/ar-info b/collection/ar-info
index 7e60c48..0cb827b 100755
--- a/collection/ar-info
+++ b/collection/ar-info
@@ -51,8 +51,7 @@ chdir("$dir/unpacked");
foreach my $file ($info->sorted_index) {
- next unless $file =~ m/\.a$/;
- next unless -f $file and not -l $file;
+ next unless $file->is_regular_file && $file =~ m{ \. a \Z }xsm;
my $opts = { pipe_out => FileHandle->new, err => '/dev/null' };
spawn($opts, [ 'ar', 't', $file ]);
diff --git a/collection/java-info b/collection/java-info
index 955c178..6265f7d 100755
--- a/collection/java-info
+++ b/collection/java-info
@@ -76,23 +76,22 @@ my $oldhandler = Archive::Zip::setErrorHandler ($errorhandler);
FILE:
foreach my $file ($info->sorted_index) {
- my $ftype = $info->index ($file);
- next unless $ftype->is_file;
+ next unless $file->is_file;
# Wheezy's version of file calls "jar files" for "Zip archive".
# Newer versions seem to call them "Java Jar file".
next unless $info->file_info($file) =~ m/Java Jar file|Zip archive/o;
if ($file =~ m#\S+\.jar$#i) {
+ my $filename = $file->name;
my $has_manifest = 0;
my $manifest;
my $azip = Archive::Zip->new;
$open_java_info->() unless %opts;
# This script needs unzip, there's no way around.
- print {$opts{pipe_in}} "-- $file\n";
+ print {$opts{pipe_in}} "-- $filename\n";
- # stringify or $azip will make a call back that fails.
- $azip->read ("$file") == AZ_OK or next FILE;
+ $azip->read($filename) == AZ_OK or next FILE;
# First, the file list:
foreach my $member ($azip->members) {
@@ -116,7 +115,7 @@ foreach my $file ($info->sorted_index) {
}
if ($manifest) {
- print {$opts{pipe_in}} "-- MANIFEST: $file\n";
+ print {$opts{pipe_in}} "-- MANIFEST: $filename\n";
my ($contents, $zerr) = $manifest->contents;
next FILE unless $zerr == AZ_OK;
diff --git a/collection/md5sums b/collection/md5sums
index 6ab581a..02897f4 100755
--- a/collection/md5sums
+++ b/collection/md5sums
@@ -47,7 +47,7 @@ spawn(\%opts, ['xargs', '-0r', 'md5sum'] );
$opts{pipe_in}->blocking(1);
foreach my $file ($info->sorted_index) {
- next unless $info->index ($file)->is_file;
+ next unless $file->is_file;
printf {$opts{pipe_in}} "%s\0", $file;
}
diff --git a/collection/scripts b/collection/scripts
index d0a4b59..310fe3c 100755
--- a/collection/scripts
+++ b/collection/scripts
@@ -36,7 +36,7 @@ my $info = Lintian::Collect->new ($pkg, $type, $dir);
open(my $scripts_fd, '>', "$dir/scripts");
foreach my $file ($info->sorted_index) {
- next unless $info->index($file)->is_regular_file;
+ next unless $file->is_regular_file;
my $scriptpath = shebang_line($info->unpacked($file));
next unless defined($scriptpath); # no shebang line => not a script
diff --git a/collection/strings b/collection/strings
index c11c6f1..474ed5d 100755
--- a/collection/strings
+++ b/collection/strings
@@ -73,14 +73,15 @@ my $open_strings_pipe = sub {
};
foreach my $bin ($info->sorted_index) {
+ my $filename = $bin->name;
my $finfo = $info->file_info ($bin);
next unless $finfo =~ m/\bELF\b/o;
- print {$elf_fd} "$bin\n";
+ printf {$elf_fd} "$filename\n";
next if $bin =~ m,^usr/lib/debug/,;
if ($bin =~ m/[:\n\r]/) {
# Do these "interesting cases" manual
- push @manual, $bin;
+ push @manual, $filename;
next;
}
$open_strings_pipe->() unless %opts;
diff --git a/debian/changelog b/debian/changelog
index 93fc542..a3a3372 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -45,6 +45,9 @@ lintian (2.5.14) UNRELEASED; urgency=low
* lib/Lintian/CheckScript.pm:
+ [NT] Prefer loading checks with ".pm", but fall back to loading
checks without the extension (with a deprecation warning).
+ * lib/Lintian/Collect/Package.pm:
+ + [NT] sorted_index (etc.) now returns L::Path objects rather than
+ just file names.
* lib/Lintian/{Path,Util}.pm:
+ [NT] Remove deprecated methods.
* lib/Lintian/Path.pm:
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index fe2a16d..df64017 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -424,6 +424,7 @@ sub _fetch_index_data {
$self->{$field} = \%idxh;
# Remove the "top" dir in the sorted_index as it is hardly ever used.
shift @sorted if scalar @sorted && $sorted[0] eq '';
+ @sorted = map { $idxh{$_} } @sorted;
$self->{"sorted_$field"} = \@sorted;
close($idx);
close($num_idx) if $num_idx;
--
Debian package checker
Reply to: