[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

[SCM] Debian package checker branch, master, updated. 2.5.10-50-g17ee39a



The following commit has been merged in the master branch:
commit 17ee39a0e1bef5697271a7c1778bc4ed77e18b1e
Author: Niels Thykier <niels@thykier.net>
Date:   Mon Jul 16 19:06:11 2012 +0200

    L::C::Package: Alter the API of file_info method
    
    file_info now only returns the file(1) output for a given file, which
    is passed as an extra argument to file_info.
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/checks/binaries b/checks/binaries
index c5f58b1..114e5c4 100644
--- a/checks/binaries
+++ b/checks/binaries
@@ -209,7 +209,7 @@ foreach ($info->sorted_index) {
 
 # process all files in package
 foreach my $file ($info->sorted_index) {
-    my $fileinfo = $info->file_info->{$file};
+    my $fileinfo = $info->file_info ($file);
     my $objdump = $info->objdump_info->{$file};
 
     # binary or object file?
diff --git a/checks/changelog-file b/checks/changelog-file
index 7dc5b16..85884de 100644
--- a/checks/changelog-file
+++ b/checks/changelog-file
@@ -54,7 +54,7 @@ return 0 if $info->index ("usr/share/doc/$pkg") and
 for my $file ($info->sorted_index) {
     next unless $file =~ m/doc/o;
 
-    $file_info{$file} = $info->file_info->{$file};
+    $file_info{$file} = $info->file_info ($file);
 
     if ($file_info{$file} =~ m/^(?:broken )?symbolic link to (.*)/) {
         # Figure out the link destination.  This algorithm is
@@ -76,8 +76,8 @@ for my $file ($info->sorted_index) {
             # concatenate the results
             $newfile .= '/' . $link;
         }
-        if (exists $info->file_info->{$newfile}) {
-            $file_info{$file} = $info->file_info->{$newfile};
+        if ($info->file_info ($newfile)) {
+            $file_info{$file} = $info->file_info ($newfile);
         }
     }
 }
diff --git a/checks/cruft b/checks/cruft
index 79a9a7c..362e144 100644
--- a/checks/cruft
+++ b/checks/cruft
@@ -147,17 +147,17 @@ find($wanted, $abs);
 
 # Look for cruft based on file's results, but allow cruft in test directories
 # where it may be part of a test suite.
-my $file_info = $info->file_info;
-for my $file (keys(%$file_info)) {
+for my $file ($info->sorted_index) {
     next if ($file =~ m,(?:^|/)t(?:est(?:s(?:et)?)?)?/,);
-    if ($file_info->{$file} =~ m/\bELF\b/) {
+    my $file_info = $info->file_info ($file);
+    if ($file_info =~ m/\bELF\b/) {
         tag 'source-contains-prebuilt-binary', $file;
-    } elsif ($file_info->{$file} =~ m/\b(?:MS-DOS|PE(?:32|64)|COFF executable)\b/) {
+    } elsif ($file_info =~ m/\b(?:MS-DOS|PE(?:32|64)|COFF executable)\b/) {
         tag 'source-contains-prebuilt-windows-binary', $file;
     } elsif ($file =~ /\bwaf$/) {
         my $ok = 1;
         # If file believes this is data, then we trust that
-        $ok = 0 if $file_info->{$file} =~ m/data/;
+        $ok = 0 if $file_info =~ m/data/;
         if ($ok) {
             # Unfortunately file 5.04 (Squeeze) and 5.09 does not
             # always agree, so manually check for the bz2 entry if
@@ -184,12 +184,12 @@ for my $file (keys(%$file_info)) {
 
 for my $file (@EOL_TERMINATORS_FILES) {
     $file = "debian/$file";
-
-    next unless defined $file_info->{$file};
+    my $file_info = $info->file_info ($file);
+    next unless defined $file_info;
 
 
     tag 'control-file-with-CRLF-EOLs', $file
-        if ($file_info->{$file} =~ m/\bCRLF\b/);
+        if $file_info =~ m/\bCRLF\b/;
 }
 
 # Report any error messages from tar while unpacking the source package if it
diff --git a/checks/files b/checks/files
index 8e59f6e..4dd66c3 100644
--- a/checks/files
+++ b/checks/files
@@ -426,7 +426,7 @@ foreach my $file ($info->sorted_index) {
                 # 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
-                    and $info->file_info->{$file} =~ m/gzip compressed/) {
+                    and $info->file_info ($file) =~ m/gzip compressed/) {
                     my $fd = open_gz ($info->unpacked ($file)) or fail "open $file: $!";
                     my $f = <$fd>;
                     close $fd;
@@ -450,7 +450,7 @@ foreach my $file ($info->sorted_index) {
 
                 # contains a compressed version of objects.inv in sphinx-generated documentation?
                 if ($file =~ m,^usr/share/doc/$ppkg/(?:[^/]+/)+objects\.inv\.gz$,
-                    and $info->file_info->{$file} =~ m/gzip compressed/) {
+                    and $info->file_info ($file) =~ m/gzip compressed/) {
                     tag 'compressed-objects.inv', $file;
                 }
 
@@ -734,7 +734,7 @@ foreach my $file ($info->sorted_index) {
             $file =~ m,^(?:usr/)?lib/([^/]+)/lib[^/]+\.so(?:\.[^/]+)?$,o) {
         my $subdir = $1;
         # Skip if it not an ELF file (probably a .so script)
-        next unless ($info->file_info->{$file}//'') =~ m/\bELF\b/o;
+        next unless ($info->file_info ($file)//'') =~ m/\bELF\b/o;
         if ($TRIPLETS->known($subdir) && $arch eq $TRIPLETS->value($subdir)) {
             my $dep = $info->relation('pre-depends');
             tag 'missing-pre-dependency-on-multiarch-support' unless ($dep->implies('multiarch-support'));
@@ -839,7 +839,7 @@ foreach my $file ($info->sorted_index) {
 
         # okay, we cannot rule it out based on file name; but if it is an elf or a static
         # library, we also skip it.  (In case you hadn't guessed; liblicense)
-        my $fileinfo = $info->file_info->{$file};
+        my $fileinfo = $info->file_info ($file);
         tag 'extra-license-file', $file
             unless $fileinfo && ($fileinfo =~ m/^[^,]*\bELF\b/) or ($fileinfo =~ m/\bcurrent ar archive\b/);
     }
@@ -930,7 +930,7 @@ foreach my $file ($info->sorted_index) {
         } else {
             $path = $file;
         }
-        my $fileinfo = $info->file_info->{$path};
+        my $fileinfo = $info->file_info ($path);
         if ($fileinfo && $fileinfo =~ m/,\s*(\d+)\s*x\s*(\d+)\s*,/) {
             my ($fwidth, $fheight) = ($1, $2);
             my $width_delta = abs($dwidth - $fwidth);
@@ -1050,7 +1050,7 @@ foreach my $file ($info->sorted_index) {
 
         # ---------------- .gz files
         if ($file =~ m/\.gz$/) {
-            my $finfo = $info->file_info->{$file} || '';
+            my $finfo = $info->file_info ($file) || '';
             if ($finfo !~ m/gzip compressed/) {
                 tag 'gz-file-not-gzip', $file;
             } elsif ($isma_same && $file !~ m/\Q$arch\E/o) {
@@ -1076,7 +1076,7 @@ foreach my $file ($info->sorted_index) {
         # --------------- compressed + uncompressed files
         if ($file =~ m,^(.+)\.(?:gz|bz2)$,) {
             tag 'duplicated-compressed-file', $file
-                if exists $info->file_info->{$1};
+                if $info->file_info ($1);
         }
 
         # ---------------- general: setuid/setgid files!
diff --git a/checks/infofiles b/checks/infofiles
index 8dc32b8..959e45e 100644
--- a/checks/infofiles
+++ b/checks/infofiles
@@ -37,7 +37,7 @@ my $info = shift;
 # Read package contents...
 foreach my $file ($info->sorted_index) {
     my $index_info = $info->index ($file);
-    my $file_info = $info->file_info->{$file};
+    my $file_info = $info->file_info ($file);
     my $link = $index_info->link || '';
     my ($fname, $path) = fileparse($file);
 
diff --git a/checks/manpages b/checks/manpages
index 98377b9..8b1d87c 100644
--- a/checks/manpages
+++ b/checks/manpages
@@ -47,7 +47,7 @@ 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 $file_info = $info->file_info ($file);
     my $link = $index_info->link || '';
     my ($fname, $path, $suffix) = fileparse($file);
 
diff --git a/checks/ocaml b/checks/ocaml
index 5ba796a..597af78 100644
--- a/checks/ocaml
+++ b/checks/ocaml
@@ -82,11 +82,11 @@ my $dev_prefix;
 my $has_meta = 0;
 
 foreach my $file ($info->sorted_index) {
-    my $fileinfo = $info->file_info->{$file};
+    my $fileinfo = $info->file_info ($file);
 
     # For each .cmxa file, there must be a matching .a file (#528367)
     $_ = $file;
-    if (s/\.cmxa$/.a/ && !(exists $info->file_info->{$_})) {
+    if (s/\.cmxa$/.a/ && !$info->file_info ($_)) {
         tag 'ocaml-dangling-cmxa', $file;
     }
 
@@ -95,8 +95,8 @@ foreach my $file ($info->sorted_index) {
     if ($is_lib_package) {
         $_ = $file;
         if (s/\.cmxs$/.cm/
-            && !(exists $info->file_info->{"${_}a"})
-            && !(exists $info->file_info->{"${_}o"})) {
+            && !$info->file_info ("${_}a")
+            && !$info->file_info ("${_}o")) {
             tag 'ocaml-dangling-cmxs', $file;
         }
     }
@@ -106,7 +106,7 @@ foreach my $file ($info->sorted_index) {
     # .a file in the same directory
     $_ = $file;
     if (s/\.cmx$/.o/
-        && !(exists $info->file_info->{$_})
+        && !$info->file_info ($_)
         && !(exists $provided_o{$_})) {
         tag 'ocaml-dangling-cmx', $file;
     }
@@ -114,8 +114,8 @@ foreach my $file ($info->sorted_index) {
     # $somename.cmi should be shipped with $somename.mli or $somename.ml
     $_ = $file;
     if ($is_dev_package && s/\.cmi$/.ml/
-        && !(exists $info->file_info->{"${_}i"})
-        && !(exists $info->file_info->{$_})) {
+        && !$info->file_info ("${_}i")
+        && !$info->file_info ($_)) {
         $cmi_number++;
         if ($cmi_number <= $MAX_CMI) {
             tag 'ocaml-dangling-cmi', $file;
@@ -134,7 +134,7 @@ foreach my $file ($info->sorted_index) {
 
     # $somename.cmo should usually not be shipped with $somename.cma
     $_ = $file;
-    if (s/\.cma$/.cmo/ && exists $info->file_info->{$_}) {
+    if (s/\.cma$/.cmo/ && $info->file_info ($_)) {
         tag 'ocaml-stray-cmo', $file;
     }
 
diff --git a/checks/scripts b/checks/scripts
index 3e4be62..845d4d8 100644
--- a/checks/scripts
+++ b/checks/scripts
@@ -204,7 +204,7 @@ my $info = shift;
 
 foreach my $file ($info->sorted_index) {
     next if $file eq '';
-    $ELF{$file} = 1 if $info->file_info->{$file} =~ /^[^,]*\bELF\b/o;
+    $ELF{$file} = 1 if $info->file_info ($file) =~ /^[^,]*\bELF\b/o;
 
     my $index_info = $info->index ($file);
     my $operm = $index_info->operm;
diff --git a/checks/shared-libs b/checks/shared-libs
index 75edab5..792694b 100644
--- a/checks/shared-libs
+++ b/checks/shared-libs
@@ -79,7 +79,7 @@ foreach my $file (sort keys %{$objdump}) {
 
 foreach my $file ($info->sorted_index) {
     next unless length $file;
-    my $fileinfo = $info->file_info->{$file};
+    my $fileinfo = $info->file_info ($file);
     if ($fileinfo =~ m/^[^,]*\bELF\b/ && $fileinfo =~ m/shared object/) {
         $sharedobject{$file} = 1;
     }
diff --git a/collection/hardening-info b/collection/hardening-info
index 1c926a9..23eecd3 100755
--- a/collection/hardening-info
+++ b/collection/hardening-info
@@ -39,7 +39,6 @@ use Lintian::Util qw(fail);
 
 my ($pkg, $type, $dir) = @ARGV;
 my $info = Lintian::Collect->new ($pkg, $type, $dir);
-my $file_info = $info->file_info;
 
 my $helper = realpath("$0-helper");
 
@@ -67,7 +66,7 @@ foreach my $bin ($info->sorted_index) {
     # Skip kernel modules - most of the checks do not apply to the
     # kernel.
     next if $bin =~ m/\.ko/o;
-    my $finfo = $file_info->{$bin};
+    my $finfo = $info->file_info ($bin);
     next unless $finfo =~ m/\bELF\b/o;
     printf {$opts{pipe_in}} "%s\0", $bin;
 }
diff --git a/collection/java-info b/collection/java-info
index b96e7f6..bb342ef 100755
--- a/collection/java-info
+++ b/collection/java-info
@@ -55,7 +55,7 @@ chdir ("$dir/unpacked")
 foreach my $file ($info->sorted_index) {
     my $ftype = $info->index ($file);
     next unless $ftype->is_file;
-    next unless $info->file_info->{$file} =~ m/Zip archive/o;
+    next unless $info->file_info ($file) =~ m/Zip archive/o;
     if ($file =~ m#\S+\.jar$#i) {
         my $has_manifest = 0;
         my $manifest;
diff --git a/collection/objdump-info b/collection/objdump-info
index e069406..097124b 100755
--- a/collection/objdump-info
+++ b/collection/objdump-info
@@ -46,8 +46,6 @@ if ( -e "$dir/objdump-info.gz" ) {
     unlink "$dir/objdump-info.gz" or fail "unlink objdump-info.gz: $!"
 }
 
-my $file_info = $info->file_info;
-
 chdir ("$dir/unpacked")
     or fail ("unable to chdir to unpacked: $!\n");
 
@@ -58,7 +56,7 @@ spawn(\%opts, ['xargs', '-0r', $helper], '|', ['gzip', '-9c'] );
 $opts{pipe_in}->blocking(1);
 
 foreach my $bin ($info->sorted_index) {
-    my $finfo = $file_info->{$bin};
+    my $finfo = $info->file_info ($bin);
 
     if ($finfo =~ m/^\bELF\b/) {
         printf {$opts{pipe_in}} "%s\0", $bin;
diff --git a/collection/strings b/collection/strings
index 04e6ecc..bb1357a 100755
--- a/collection/strings
+++ b/collection/strings
@@ -37,7 +37,6 @@ my ($pkg, $type, $dir) = @ARGV;
 my $info = Lintian::Collect->new ($pkg, $type, $dir);
 
 my $helper = realpath("$0-helper");
-my $file_info = $info->file_info;
 my @manual = ();
 
 if ( -e "$dir/elf-index" ) {
@@ -64,7 +63,7 @@ spawn (\%opts, ['xargs', '-0r', 'strings', '-f', '--'], '|', [$helper, "$dir/str
 $opts{pipe_in}->blocking(1);
 
 foreach my $bin ($info->sorted_index) {
-    my $finfo = $file_info->{$bin};
+    my $finfo = $info->file_info ($bin);
     next unless $finfo =~ m/\bELF\b/o;
     print ELF_INDEX "$bin\n";
 
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index 24d809e..d79275b 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -38,8 +38,12 @@ sub unpacked {
 
 # Returns the information from collect/file-info
 sub file_info {
-    my ($self) = @_;
-    return $self->{file_info} if exists $self->{file_info};
+    my ($self, $file) = @_;
+    if (exists $self->{file_info}) {
+        return $self->{file_info}->{$file}
+            if exists $self->{file_info}->{$file};
+        return;
+    }
     my %file_info;
     my $path = $self->lab_data_path ('file-info.gz');
     local $_;
@@ -60,7 +64,9 @@ sub file_info {
     close $idx;
     $self->{file_info} = \%file_info;
 
-    return $self->{file_info};
+    return $self->{file_info}->{$file}
+        if exists $self->{file_info}->{$file};
+    return;
 }
 
 # Returns the information from the indices
@@ -317,9 +323,9 @@ The following code may be helpful in checking for path traversal:
 
 Alternatively one can use Lintian::Util::resolve_pkg_path.
 
-=item file_info
+=item file_info (FILE)
 
-Returns a hashref mapping file names to the output of file for that file.
+Returns the output of file(1) for FILE (if it exists) or C<undef>.
 
 Note the file names do not have any leading "./" nor "/".
 

-- 
Debian package checker


Reply to: