[SCM] Debian package checker branch, master, updated. 2.5.1-58-g566f082

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit ab0cd9aa9d7e965f238b2cd86415be09bdaa5f49
Author: Niels Thykier <niels@thykier.net>
Date:   Sat Jul 9 02:08:48 2011 +0200

    Made file-info cope for file's failure to detect gzip files
    
    The frequency of false-positivies in the fields-doc-pkg-wrong-arch
    test made the test suite an almost guaranteed FTBFS.  To counter
    this collection/file-info now double checks all .gz files that
    file(1) does not say is gzip compressed.

diff --git a/collection/file-info b/collection/file-info
index 2dbc1a7..b26f2b3 100755
--- a/collection/file-info
+++ b/collection/file-info
@@ -30,6 +30,7 @@ use Lintian::Command qw(spawn reap);
 ($#ARGV == 1) or fail('syntax: file-info <pkg> <type>');
 my $pkg = shift;
 my $type = shift;
+my $last = '';
 
 -f 'fields/source' or fail('file-info invoked in wrong directory');
 
@@ -37,12 +38,56 @@ unlink('file-info');
 chdir('unpacked')
     or fail("cannot chdir to unpacked directory: $!");
 
+open(FILE_INFO, '>', '../file-info')
+    or fail("cannot open file-info: $!");
+
+my $collect = sub {
+    my @lines = map { split "\n" } @_;
+    if ($last ne '') {
+        $lines[0] = $last . $lines[0];
+    }
+    if ($_[-1] !~ /\n\z/) {
+        $last = pop @lines;
+    } else {
+        $last = '';
+    }
+    for my $line (@lines) {
+        my ($file, $type) = $line =~ (m/^(.*?)\x00(.*)$/o);
+        if ($file =~ m/\.gz$/o && -e $file && ! -l $file && $type !~ m/compressed/o){
+            # While file could be right, it is unfortunately
+            # regularly wrong here as well; double check the type
+	    my $text = '';
+	    if (open(my $gzf, '<', $file)) {
+		my $buff;
+		# We need to read at least 9 bytes
+		if (sysread($gzf, $buff, 1024) >= 9) {
+		    # translation of the unpack
+		    #  nn nn ,  NN NN NN NN, nn nn, cc     - bytes read (in hex, network order)
+		    #  $magic,  __ __ __ __, __ __, $comp  - variables
+		    my ($magic, undef, undef, $comp) = unpack('nNnc', $buff);
+		    if ($magic == 0x1f8b){ # the gzip file magic
+			$text = 'gzip compressed';
+			# 2 for max compression; RFC1952 suggests this is a flag and not a value,
+			# hench the bit and operation
+			if (($comp & 2) == 2){
+			    $text = "$text, max compression";
+			}
+		    }
+		}
+		close($gzf);
+	    }
+	    $type = "$type, $text" if $text;
+        }
+        printf FILE_INFO "%s%c%s\n", $file , 0, $type;
+    }
+}; # End $collect = sub;
+
 # We ignore failures from file because sometimes file returns a non-zero exit
 # status when it can't parse a file.  So far, the resulting output still
 # appears to be usable (although will contain "ERROR" strings, which Lintian
 # doesn't care about), and the only problem was the exit status.
 my %opts = ( pipe_in => FileHandle->new,
-	     out => '../file-info',
+	     out => $collect,
 	     fail => 'never' );
 spawn(\%opts, ['xargs', '-0r', 'file', '-F', '', '--print0', '--']);
 $opts{pipe_in}->blocking(1);
@@ -61,3 +106,6 @@ close(INDEX) or fail("cannot close index file: $!");
 
 close $opts{pipe_in};
 reap(\%opts);
+
+close(FILE_INFO) or fail("cannot close file-info: $!");
+
diff --git a/debian/changelog b/debian/changelog
index aa05e93..f44971e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -92,6 +92,11 @@ lintian (2.5.2) UNRELEASED; urgency=low
     + [NT] Symlink checking extended to relative paths as well.
       (Closes: #217023)
 
+  * collection/file-info:
+    + [NT] Double check the output of file(1) when it says a ".gz"
+      file is not gzip compressed.  This should reduce the number
+      of false-positives gz-file-not-gzip tags.
+      (Closes: #620289)
   * collection/index{,.desc}:
     + [NT] Updated to handle source packages and with support for
       multi tarball source packages.

-- 
Debian package checker