[SCM] Debian package checker branch, master, updated. 2.5.9-19-g8fcf257
The following commit has been merged in the master branch:
commit 8fcf257fa4d6e723ae3e8262ac9747335b7c74ff
Author: Niels Thykier <niels@thykier.net>
Date: Tue Jun 26 15:33:38 2012 +0200
coll/strings: Optimize for the "common case"
This reduces the runtime of coll/strings noticibly on linux-image,
where strings currently is one of the bottle necks.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/collection/strings b/collection/strings
index 45612a9..63e4658 100755
--- a/collection/strings
+++ b/collection/strings
@@ -22,9 +22,11 @@
use strict;
use warnings;
+use Cwd qw(realpath);
+
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Collect;
-use Lintian::Command qw(spawn);
+use Lintian::Command qw(spawn reap);
use Lintian::Command::Simple;
use Lintian::Util qw(delete_dir fail);
@@ -33,7 +35,9 @@ use Lintian::Util qw(delete_dir fail);
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" ) {
unlink "$dir/elf-index" or fail "unlink elf-index: $!";
@@ -46,26 +50,54 @@ if ( -d "$dir/strings" ) {
open ELF_INDEX, '>', "$dir/elf-index"
or fail "Could not open 'elf-index' for writing: $!";
+# The directory is required, even if it would be empty.
+mkdir "$dir/strings" or
+ fail "mkdir $dir/strings: $!";
+
+chdir ("$dir/unpacked")
+ or fail("cannot chdir to unpacked directory: $!");
+
+my %opts = ( pipe_in => FileHandle->new,
+ fail => 'error' );
+spawn (\%opts, ['xargs', '-0r', 'strings', '-f', '--'], '|', [$helper, "$dir/strings"]);
+$opts{pipe_in}->blocking(1);
-foreach my $bin (keys %$file_info) {
+foreach my $bin ($info->sorted_index) {
my $finfo = $file_info->{$bin};
next unless $finfo =~ m/\bELF\b/o;
print ELF_INDEX "$bin\n";
next if ($bin =~ m,^/usr/lib/debug/,);
-
- my $elfdir = $bin;
- $elfdir =~ s,/[^/]+?$,,;
-
- Lintian::Command::Simple::run ('mkdir', '-p', "$dir/strings/$elfdir") == 0
- or fail "Failed to create directory 'strings/$elfdir'";
-
- spawn ({out => "$dir/strings/${bin}.gz", fail => 'error'},
- ['strings', "$dir/unpacked/$bin"], '|', ['gzip', '-9c']);
+ if ($bin =~ m/[:\n\r]/) {
+ # Do these "interesting cases" manual
+ push @manual, $bin;
+ next;
+ }
+ printf {$opts{pipe_in}} "%s\0", $bin;
+}
+close $opts{pipe_in};
+reap (\%opts);
+
+
+# Fall back to the safe but slower method for files with "special"
+# names.
+if (@manual) {
+ require File::Basename;
+ foreach my $file (@manual) {
+ my $strdir = $dir . '/strings/' . File::Basename::dirname ($file);
+ # create the dir if needed.
+ unless ( -d $strdir) {
+ system ('mkdir', '-p', $strdir) == 0
+ or fail "mkdir -p $strdir failed " . (($? >> 8) & 256), "\n";
+ }
+ spawn ({out => "$dir/strings/${file}.gz", fail => 'fail'},
+ ['strings', "$dir/unpacked/$file"], '|', ['gzip', '-9nc']);
+ }
}
-
close(ELF_INDEX) or fail("cannot write elf-index file: $!");
+exit 0;
+
# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
diff --git a/collection/strings-helper b/collection/strings-helper
new file mode 100755
index 0000000..3e780c7
--- /dev/null
+++ b/collection/strings-helper
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -w
+# strings -- lintian collection script
+
+# Copyright (C) 2012 Niels Thykier <niels@thykier.net>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+use strict;
+use warnings;
+
+use File::Basename qw(dirname);
+use IO::Handle;
+
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Lintian::Command qw(spawn reap);
+
+my ($strdir) = @ARGV;
+my $curfname = '';
+my $curdir = '';
+
+my %opts = ( fail => 'error' );
+my $out = undef;
+
+while ( my $line = <STDIN> ) {
+ my ($fname, $string);
+ chomp $line;
+ ($fname, $string) = ($line =~ m/^([^:]++): (.++)$/o);
+ if ($curfname ne $fname) {
+ # new file, prepare for it.
+ if ($out) {
+ close $out;
+ reap (\%opts);
+ }
+ my $dir = $strdir . '/' . dirname ($fname);
+ if ($dir ne $curdir) {
+ system ('mkdir', '-p', $dir) == 0 or
+ die "mkdir -p $dir failed: " . (($? >> 8) & 256), "\n";
+ $curdir = $dir;
+ }
+ $opts{out} = "$strdir/${fname}.gz";
+ $out = $opts{pipe_in} = IO::Handle->new;
+ spawn (\%opts, ['gzip', '-9nc']);
+ $opts{pipe_in}->blocking(1);
+
+ $curfname = $fname;
+ }
+ print $out "$string\n";
+}
+
+if ($out) {
+ close $out;
+ reap (\%opts);
+}
+
+exit 0;
diff --git a/collection/strings.desc b/collection/strings.desc
index 1333f33..609dd17 100644
--- a/collection/strings.desc
+++ b/collection/strings.desc
@@ -4,4 +4,4 @@ Info: This script runs the strings(1) command over all files of a binary
package.
Type: binary, udeb
Version: 2
-Needs-Info: unpacked, file-info
+Needs-Info: index, unpacked, file-info
diff --git a/debian/changelog b/debian/changelog
index d83e38c..f947e1f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -26,6 +26,11 @@ lintian (2.5.10) UNRELEASED; urgency=low
readelf calls even further.
* collection/objdump-info-helper:
+ [NT] New file.
+ * collection/strings:
+ + [NT] Optimize for the "common case" file names with a
+ fall-back to previous behaviour with special file names.
+ * collection/strings-helper:
+ + [NT] New file.
* debian/control:
+ [NT] Add (Build-)Dependency on libarchive-zip-perl.
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index f58d3e3..dfae5e9 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -93,12 +93,14 @@ sub control_index {
# Returns a handle with the strings in a given binary file (as computed
# by coll/strings)
#
-# If there are no strings for the given file, this method fails.
-#
# sub strings Needs-Info strings
sub strings {
my ($self, $file) = @_;
my $real = $self->_fetch_extracted_dir ('strings', 'strings', $file);
+ if ( not -f "${real}.gz" ) {
+ open my $fd, '<', '/dev/null';
+ return $fd;
+ }
open my $fd, '-|', 'gzip', '-dc', "$real.gz" or fail "open ${file}.gz: $!";
return $fd;
}
--
Debian package checker
Reply to: