lintian: r57 - in branches/1.22.11+udeb: branches/1.22.11+udeb/checks branches/1.22.11+udeb/collection branches/1.22.11+udeb/debian branches/1.22.11+udeb/frontend branches/1.22.11+udeb/lib
Author: djpig
Date: 2004-02-22 15:01:29 +0100 (Sun, 22 Feb 2004)
New Revision: 57
Modified:
branches/1.22.11+udeb/checks/binaries.desc
branches/1.22.11+udeb/checks/files
branches/1.22.11+udeb/checks/files.desc
branches/1.22.11+udeb/collection/file-info.desc
branches/1.22.11+udeb/collection/md5sums.desc
branches/1.22.11+udeb/collection/objdump-info.desc
branches/1.22.11+udeb/collection/override-file.desc
branches/1.22.11+udeb/collection/scripts.desc
branches/1.22.11+udeb/debian/changelog
branches/1.22.11+udeb/frontend/lintian
branches/1.22.11+udeb/lib/Read_pkglists.pm
Log:
Basic udeb support
Modified: branches/1.22.11+udeb/checks/binaries.desc
===================================================================
--- branches/1.22.11+udeb/checks/binaries.desc 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/checks/binaries.desc 2004-02-22 14:01:29 UTC (rev 57)
@@ -2,7 +2,7 @@
Author: Christian Schwarz <schwarz@debian.org>
Abbrev: bin
Standards-Version: 3.2.0
-Type: binary
+Type: binary, udeb
Unpack-Level: 1
Needs-Info: objdump-info, file-info
Info: This script checks binaries and object files for bugs.
Modified: branches/1.22.11+udeb/checks/files
===================================================================
--- branches/1.22.11+udeb/checks/files 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/checks/files 2004-02-22 14:01:29 UTC (rev 57)
@@ -133,46 +133,50 @@
elsif ($file =~ m,^usr/,) {
# ---------------- /usr/share/doc
if ($file =~ m,^usr/share/doc/\S,) {
- # file not owned by root?
- if ($owner ne 'root/root') {
- print "E: $pkg $type: bad-owner-for-doc-file $file $owner != root/root\n";
- }
-
- # file directly in /usr/share/doc ?
- if ($perm =~ m/^-/ and $file =~ m,^usr/share/doc/[^/]+$,) {
- print "E: $pkg $type: file-directly-in-usr-share-doc $file\n";
- }
-
- # executable in /usr/share/doc ?
- if ($perm =~ m/^-.*[xs]/ and $file !~ m,^usr/share/doc/([^/]+/)?examples/,) {
- if ($script{$file}) {
- print "I: $pkg $type: script-in-usr-share-doc $file\n";
- } else {
- print "E: $pkg $type: executable-in-usr-share-doc $file " . (sprintf "%04o\n", $operm);
+ if ($type eq 'udeb') {
+ print "E: $pkg $type: file-in-usr-share-doc $file\n";
+ } else {
+ # file not owned by root?
+ if ($owner ne 'root/root') {
+ print "E: $pkg $type: bad-owner-for-doc-file $file $owner != root/root\n";
}
- }
+
+ # file directly in /usr/share/doc ?
+ if ($perm =~ m/^-/ and $file =~ m,^usr/share/doc/[^/]+$,) {
+ print "E: $pkg $type: file-directly-in-usr-share-doc $file\n";
+ }
+
+ # executable in /usr/share/doc ?
+ if ($perm =~ m/^-.*[xs]/ and $file !~ m,^usr/share/doc/([^/]+/)?examples/,) {
+ if ($script{$file}) {
+ print "I: $pkg $type: script-in-usr-share-doc $file\n";
+ } else {
+ print "E: $pkg $type: executable-in-usr-share-doc $file " . (sprintf "%04o\n", $operm);
+ }
+ }
+
+ # zero byte file in /usr/share/doc/
+ if ($size == 0 and $perm =~ m,^-,) {
+ # exception: __init__.py files are empty tagging files (see
+ # bug #215234)
+ unless ($file =~ m,^usr/share/doc/([^/]+/)?examples/(.+/)?__init__\.py$,) {
+ print "W: $pkg $type: zero-byte-file-in-doc-directory $file\n";
+ }
+ }
- # zero byte file in /usr/share/doc/
- if ($size == 0 and $perm =~ m,^-,) {
- # exception: __init__.py files are empty tagging files (see
- # bug #215234)
- unless ($file =~ m,^usr/share/doc/([^/]+/)?examples/(.+/)?__init__\.py$,) {
- print "W: $pkg $type: zero-byte-file-in-doc-directory $file\n";
+ # override files have moved
+ my $tmp = quotemeta($pkg);
+ if ($file =~ m,^usr/share/doc/$tmp/override\.[lL]intian(\.gz)?$,) {
+ print "E: $pkg $type: override-file-in-wrong-location $file\n";
+ } elsif ($file =~ m,^usr/share/lintian/overrides/$tmp/.*,) {
+ print "E: $pkg $type: override-file-in-wrong-location $file\n";
}
+
+ # contains an INSTALL file?
+ if ($file =~ m,^usr/share/doc/$tmp/INSTALL(?:\..+)*$,) {
+ print "W: $pkg $type: package-contains-upstream-install-documentation $file\n";
+ }
}
-
- # override files have moved
- my $tmp = quotemeta($pkg);
- if ($file =~ m,^usr/share/doc/$tmp/override\.[lL]intian(\.gz)?$,) {
- print "E: $pkg $type: override-file-in-wrong-location $file\n";
- } elsif ($file =~ m,^usr/share/lintian/overrides/$tmp/.*,) {
- print "E: $pkg $type: override-file-in-wrong-location $file\n";
- }
-
- # contains an INSTALL file?
- if ($file =~ m,^usr/share/doc/$tmp/INSTALL(?:\..+)*$,) {
- print "W: $pkg $type: package-contains-upstream-install-documentation $file\n";
- }
}
# ---------------- /usr/doc
elsif ($file =~ m,^usr/doc/\S,) {
Modified: branches/1.22.11+udeb/checks/files.desc
===================================================================
--- branches/1.22.11+udeb/checks/files.desc 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/checks/files.desc 2004-02-22 14:01:29 UTC (rev 57)
@@ -2,7 +2,7 @@
Author: Christian Schwarz <schwarz@debian.org>
Abbrev: fil
Standards-Version: 3.5.0
-Type: binary
+Type: binary, udeb
Unpack-Level: 1
Needs-Info: objdump-info
Info: This script checks if a binary package conforms to policy
@@ -196,6 +196,14 @@
absolute.
Ref: policy 10.5
+Tag: contains-usr-share-doc
+Type: error
+Info: udeb packages should not contain any documentation.
+ .
+ If this is an exception, please contact &maint;
+ about this so that this exception would be recognized in future versions of
+ Lintian.
+
Tag: executable-in-usr-share-doc
Type: error
Info: Usually, documentation files in <tt>/usr/share/doc</tt> should have mode
Modified: branches/1.22.11+udeb/collection/file-info.desc
===================================================================
--- branches/1.22.11+udeb/collection/file-info.desc 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/collection/file-info.desc 2004-02-22 14:01:29 UTC (rev 57)
@@ -1,7 +1,7 @@
Collector-Script: file-info
Author: Richard Braakman <dark@xs4all.nl>
Info: This script runs the `file' command over all files of a binary package.
-Type: binary
+Type: binary, udeb
Unpack-Level: 2
Output: file-info
Order: 1
Modified: branches/1.22.11+udeb/collection/md5sums.desc
===================================================================
--- branches/1.22.11+udeb/collection/md5sums.desc 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/collection/md5sums.desc 2004-02-22 14:01:29 UTC (rev 57)
@@ -1,7 +1,7 @@
Collector-Script: md5sums
Author: Richard Braakman <dark@xs4all.nl>
Info: This script runs the `md5sums' over all files in a binary package.
-Type: binary
+Type: binary, udeb
Unpack-Level: 2
Output: md5sums
Order: 1
Modified: branches/1.22.11+udeb/collection/objdump-info.desc
===================================================================
--- branches/1.22.11+udeb/collection/objdump-info.desc 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/collection/objdump-info.desc 2004-02-22 14:01:29 UTC (rev 57)
@@ -1,7 +1,7 @@
Collector-Script: objdump-info
Author: Christian Schwarz <schwarz@debian.org>
Info: This script runs `objdump' over all binaries and object files of a binary package.
-Type: binary
+Type: binary, udeb
Unpack-Level: 2
Output: objdump-info
Order: 2
Modified: branches/1.22.11+udeb/collection/override-file.desc
===================================================================
--- branches/1.22.11+udeb/collection/override-file.desc 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/collection/override-file.desc 2004-02-22 14:01:29 UTC (rev 57)
@@ -1,7 +1,7 @@
Collector-Script: override-file
Author: Darren Benham <gecko@debian.org>
Info: This script copies the `override' file of a package into the lintian directory.
-Type: binary
+Type: binary, udeb
Unpack-Level: 2
Output: override
Order: 1
Modified: branches/1.22.11+udeb/collection/scripts.desc
===================================================================
--- branches/1.22.11+udeb/collection/scripts.desc 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/collection/scripts.desc 2004-02-22 14:01:29 UTC (rev 57)
@@ -5,7 +5,7 @@
The format is: scriptpath filename
Note that the filename might contain spaces, but the scriptpath will not,
because linux only looks at the first word when executing a script.
-Type: binary
+Type: binary, udeb
Unpack-Level: 2
Output: scripts
Order: 1
Modified: branches/1.22.11+udeb/debian/changelog
===================================================================
--- branches/1.22.11+udeb/debian/changelog 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/debian/changelog 2004-02-22 14:01:29 UTC (rev 57)
@@ -1,3 +1,9 @@
+lintian (1.22.11+udeb) unstable; urgency=low
+
+ * Add support for udeb packages
+
+ -- Frank Lichtenheld <djpig@debian.org> Sun, 22 Feb 2004 12:13:04 +0100
+
lintian (1.22.11) unstable; urgency=low
Jeroen van Wolffelaar <jeroen@wolffelaar.nl>
Modified: branches/1.22.11+udeb/frontend/lintian
===================================================================
--- branches/1.22.11+udeb/frontend/lintian 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/frontend/lintian 2004-02-22 14:01:29 UTC (rev 57)
@@ -29,9 +29,9 @@
# Global Variables
#######################################
my $lintian_info_cmd = 'lintian-info'; #Command to run for ?
-my $LINTIAN_VERSION = "1.22.11"; #External Version number
+my $LINTIAN_VERSION = "1.22.11+udeb"; #External Version number
my $BANNER = "Lintian v$LINTIAN_VERSION"; #Version Banner - text form
-my $LAB_FORMAT = 6; #Lab format Version Number
+my $LAB_FORMAT = 7; #Lab format Version Number
#increased whenever incompatible
#changes are done to the lab
#so that all packages are re-unpacked
@@ -155,6 +155,7 @@
-a, --all process all packages in distribution
-b, --binary process only binary packages
-s, --source process only source packages
+ --udeb process only udeb packages
-p X, --packages-file X process all files in file (special syntax!)
EOT-EOT-EOT
@@ -207,6 +208,7 @@
sub record_pkgmode {
$pkg_mode = 'b' if $_[0] eq 'binary';
$pkg_mode = 's' if $_[0] eq 'source';
+ $pkg_mode = 'u' if $_[0] eq 'udeb';
}
# Hash used to process commandline options
@@ -249,6 +251,7 @@
"all|a" => \$check_everything,
"binary|b" => \&record_pkgmode,
"source|s" => \&record_pkgmode,
+ "udeb" => \&record_pkgmode,
"packages-file|p=s" => \$packages_file,
);
@@ -428,7 +431,7 @@
require Util;
require Pipeline;
require Read_pkglists;
-use vars qw(%source_info %binary_info); # from the above
+use vars qw(%source_info %binary_info %udeb_info); # from the above
# determine requested unpack level
if (defined($unpack_level)) {
@@ -478,6 +481,7 @@
# LINTIAN_LAB has to exist in this mode
unless (-d "$LINTIAN_LAB/binary" &&
+ -d "$LINTIAN_LAB/udeb" &&
-d "$LINTIAN_LAB/source" &&
-d "$LINTIAN_LAB/info") {
fail("lintian lab has not been set up correctly (run lintian --setup-lab)");
@@ -552,6 +556,15 @@
}
schedule_package('b', $info->{'package'}, $info->{'version'}, $arg);
}
+ # .udeb file?
+ if ($arg =~ /\.udeb$/) {
+ my $info = get_deb_info($arg);
+ if (not defined $info) {
+ print STDERR "$arg is a zero-byte file, skipping\n";
+ next;
+ }
+ schedule_package('u', $info->{'package'}, $info->{'version'}, $arg);
+ }
# .dsc file?
elsif ($arg =~ /\.dsc$/) {
my $info = get_dsc_info($arg);
@@ -634,10 +647,14 @@
my $info = get_deb_info($filename);
schedule_package('b', $info->{'package'},
$info->{'version'}, $filename);
+ } elsif ($file =~ /\.udeb$/) {
+ my $info = get_deb_info($filename);
+ schedule_package('u', $info->{'package'},
+ $info->{'version'}, $filename);
}
}
} else {
- fail("bad package file name $arg (neither .deb or .dsc file)");
+ fail("bad package file name $arg (neither .deb, .udeb or .dsc file)");
}
} else {
# parameter is a package name--so look it up
@@ -657,6 +674,7 @@
# read package info
read_src_list("$LINTIAN_LAB/info/source-packages", 0);
read_bin_list("$LINTIAN_LAB/info/binary-packages", 0);
+ read_udeb_list("$LINTIAN_LAB/info/udeb-packages", 0);
if (($pkg_mode eq 'b') or ($pkg_mode eq 'a')) {
if ($binary_info{$arg}) {
@@ -666,6 +684,14 @@
$found = 1;
}
}
+ if (($pkg_mode eq 'u') or ($pkg_mode eq 'a')) {
+ if ($udeb_info{$arg}) {
+ schedule_package('u', $udeb_info{$arg}->{'package'},
+ $udeb_info{$arg}->{'version'},
+ "$LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}");
+ $found = 1;
+ }
+ }
if (($pkg_mode eq 's') or ($pkg_mode eq 'a')) {
if ($source_info{$arg}) {
schedule_package('s', $source_info{$arg}->{'source'},
@@ -682,6 +708,7 @@
my $b = "$LINTIAN_LAB/binary/$arg";
my $s = "$LINTIAN_LAB/source/$arg";
+ my $u = "$LINTIAN_LAB/udeb/$arg";
if ($pkg_mode eq 'b') {
unless (-d $b) {
@@ -695,10 +722,16 @@
$exit_code = 2;
next;
}
+ } elsif ($pkg_mode eq 'u') {
+ unless (-d $u) {
+ warn "error: cannot find udeb package $arg in $search (skipping)\n";
+ $exit_code = 2;
+ next;
+ }
} else {
# $pkg_mode eq 'a'
- unless (-d $b or -d $s) {
- warn "error: cannot find binary or source package $arg in $search (skipping)\n";
+ unless (-d $b or -d $s or -d $u) {
+ warn "error: cannot find binary, udeb or source package $arg in $search (skipping)\n";
$exit_code = 2;
next;
}
@@ -710,6 +743,9 @@
if (($pkg_mode eq 's') or (($pkg_mode eq 'a') and (-d $s))) {
schedule_package('s', get_src_info_from_lab($s));
}
+ if (($pkg_mode eq 'u') or (($pkg_mode eq 'a') and (-d $u))) {
+ schedule_package('u', get_bin_info_from_lab($u));
+ }
}
}
@@ -753,25 +789,19 @@
set_value($f, $p,'type',$secs[0],1);
# convert Type:
- my ($b,$s);
+ my ($b,$s,$u) = ( "", "", "" );;
for (split(/\s*,\s*/o,$p->{'type'})) {
if ($_ eq 'binary') {
- $b = 1;
+ $b = 'b';
} elsif ($_ eq 'source') {
- $s = 1;
+ $s = 's';
+ } elsif ($_ eq 'udeb') {
+ $u = 'u';
} else {
fail("unknown type $_ specified in description file $f");
}
}
- if ($b and $s) {
- $p->{'type'} = 'a';
- } elsif ($b) {
- $p->{'type'} = 'b';
- } elsif ($s) {
- $p->{'type'} = 's';
- } else {
- $p->{'type'} = '';
- }
+ $p->{'type'} = "$s$b$u";
set_value($f,$p,'unpack-level',$secs[0],1);
set_value($f,$p,'output',$secs[0],1);
@@ -825,25 +855,19 @@
set_value($f,$p,'type',$secs[0],1);
# convert Type:
- my ($b,$s);
+ my ($b,$s,$u) = ( "", "", "" );
for (split(/\s*,\s*/o,$p->{'type'})) {
if ($_ eq 'binary') {
- $b = 1;
+ $b = 'b';
} elsif ($_ eq 'source') {
- $s = 1;
+ $s = 's';
+ } elsif ($_ eq 'udeb') {
+ $u = 'u';
} else {
fail("unknown type $_ specified in description file $f");
}
}
- if ($b and $s) {
- $p->{'type'} = 'a';
- } elsif ($b) {
- $p->{'type'} = 'b';
- } elsif ($s) {
- $p->{'type'} = 's';
- } else {
- $p->{'type'} = '';
- }
+ $p->{'type'} = "$s$b$u";
set_value($f,$p,'unpack-level',$secs[0],1);
set_value($f,$p,'abbrev',$secs[0],1);
@@ -942,6 +966,7 @@
# make sure package info is available
read_src_list("$LINTIAN_LAB/info/source-packages", 0);
read_bin_list("$LINTIAN_LAB/info/binary-packages", 0);
+ read_udeb_list("$LINTIAN_LAB/info/udeb-packages", 0);
if ($debug >= 2) {
print STDERR "pkg_mode = $pkg_mode\n";
@@ -962,6 +987,12 @@
push(@packages,"b $binary_info{$arg}->{'package'} $binary_info{$arg}->{'version'} $LINTIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}");
}
}
+ if (($pkg_mode eq 'a') or ($pkg_mode eq 'u')) {
+ for my $arg (keys %udeb_info) {
+ print STDERR "doing stuff with $LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}\n" if $debug;
+ push(@packages,"u $udeb_info{$arg}->{'package'} $udeb_info{$arg}->{'version'} $LINTIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}");
+ }
+ }
# package list still empty?
if ($#packages == -1) {
@@ -999,9 +1030,9 @@
# can use information from the source packages if these are unpacked)
PACKAGE:
for (reverse sort @packages) {
- m/^([bs]) (\S+) (\S+) (.+)$/ or fail("internal error: syntax error in \@packages array: $_");
+ m/^([bsu]) (\S+) (\S+) (.+)$/ or fail("internal error: syntax error in \@packages array: $_");
my ($type,$pkg,$ver,$file) = ($1,$2,$3,$4);
- my $long_type = ($type eq 'b' ? 'binary' : 'source');
+ my $long_type = ($type eq 'b' ? 'binary' : ($type eq 's' ? 'source' : 'udeb' ));
print "N: ----\n" if $verbose;
if ($verbose) {
@@ -1102,7 +1133,7 @@
my $ci = $collection_info{$coll};
# current type?
- next unless ($ci->{'type'} eq $type) or ($ci->{'type'} eq 'a');
+ next unless ($ci->{'type'} =~ m/$type/);
# info already available?
next if (-e "$base/$ci->{'output'}");
@@ -1165,7 +1196,7 @@
my $ci = $check_info{$check};
# current type?
- next unless ($ci->{'type'} eq $type) or ($ci->{'type'} eq 'a');
+ next unless ($ci->{'type'} =~ m/$type/);
# unpack to desired unpack level (if necessary)
$act_unpack_level = unpack_pkg($type,$base,$file,$act_unpack_level,$ci->{'unpack-level'});
@@ -1356,13 +1387,16 @@
if (not -d "$LINTIAN_LAB/source") {
mkdir("$LINTIAN_LAB/source",0777) or fail("cannot create lab directory $LINTIAN_LAB/source");
}
+ if (not -d "$LINTIAN_LAB/udeb") {
+ mkdir("$LINTIAN_LAB/udeb",0777) or fail("cannot create lab directory $LINTIAN_LAB/udeb");
+ }
if (not -d "$LINTIAN_LAB/info") {
mkdir("$LINTIAN_LAB/info",0777) or fail("cannot create lab directory $LINTIAN_LAB/info");
}
# distribution specified?
if ($LINTIAN_DIST) {
- print STDERR "spawning list-binpkg and list-srcpkg since LINTIAN_DIST=$LINTIAN_DIST\n" if ($debug >= 2);
+ print STDERR "spawning list-binpkg, list-udebpkg and list-srcpkg since LINTIAN_DIST=$LINTIAN_DIST\n" if ($debug >= 2);
# yes!
my $v = $verbose ? '-v' : '';
@@ -1373,13 +1407,18 @@
spawn("$LINTIAN_ROOT/unpack/list-srcpkg",
"$LINTIAN_LAB/info/source-packages", $v) == 0
or fail("cannot create source package list");
+ spawn("$LINTIAN_ROOT/unpack/list-udebpkg",
+ "$LINTIAN_LAB/info/udeb-packages", $v) == 0
+ or fail("cannot create udeb package list");
} else {
- print STDERR "not spawning list-binpkg and list-srcpkg since LINTIAN_DIST is empty\n" if ($debug >= 2);
+ print STDERR "not spawning list-binpkg, list-udebpkg and list-srcpkg since LINTIAN_DIST is empty\n" if ($debug >= 2);
# just create empty files
touch("$LINTIAN_LAB/info/binary-packages")
or fail("cannot create binary package list");
touch("$LINTIAN_LAB/info/source-packages")
or fail("cannot create source package list");
+ touch("$LINTIAN_LAB/info/udeb-packages")
+ or fail("cannot create udeb package list");
}
}
@@ -1421,6 +1460,7 @@
if (spawn('rm', '-rf', '--',
"$LINTIAN_LAB/binary",
"$LINTIAN_LAB/source",
+ "$LINTIAN_LAB/udeb",
"$LINTIAN_LAB/info") != 0) {
print STDERR "warning: cannot remove lab directory $LINTIAN_LAB (please remove it yourself)\n";
}
@@ -1454,7 +1494,7 @@
(not defined ($cur_level) or ($cur_level < 1)) ) {
# create new directory
print "N: Unpacking package to level 1 ...\n" if $debug;
- if ($type eq 'b') {
+ if (($type eq 'b') || ($type eq 'u')) {
spawn("$LINTIAN_ROOT/unpack/unpack-binpkg-l1", $base, $file) == 0
or return -1;
} else {
@@ -1468,7 +1508,7 @@
(not defined ($cur_level) or ($cur_level < 2)) ) {
# unpack package contents
print "N: Unpacking package to level 2 ...\n" if $debug;
- if ($type eq 'b') {
+ if (($type eq 'b') || ($type eq 'u')) {
spawn("$LINTIAN_ROOT/unpack/unpack-binpkg-l2", $base) == 0
or return -1;
} else {
@@ -1589,7 +1629,7 @@
if ( $already_scheduled{$s}++ ) {
if ($verbose) {
printf "N: Ignoring duplicate %s package $pkg (version $ver)\n",
- $type eq 'b' ? 'binary' : 'source';
+ $type eq 'b' ? 'binary' : ($type eq 's' ? 'source': 'udeb');
}
return;
}
Modified: branches/1.22.11+udeb/lib/Read_pkglists.pm
===================================================================
--- branches/1.22.11+udeb/lib/Read_pkglists.pm 2004-02-21 19:03:56 UTC (rev 56)
+++ branches/1.22.11+udeb/lib/Read_pkglists.pm 2004-02-22 14:01:29 UTC (rev 57)
@@ -20,15 +20,17 @@
# MA 02111-1307, USA.
use strict;
-use vars qw($BINLIST_FORMAT $SRCLIST_FORMAT %source_info %binary_info %bin_src_ref);
+use vars qw($BINLIST_FORMAT $SRCLIST_FORMAT $UDEBLIST_FORMAT %source_info %binary_info %udeb_info %bin_src_ref);
# these banner lines have to be changed with every incompatible change of the
# binary and source list file formats
$BINLIST_FORMAT = "Lintian's list of binary packages in the archive--V2";
$SRCLIST_FORMAT = "Lintian's list of source packages in the archive--V2";
+$UDEBLIST_FORMAT = "Lintian's list of udeb packages in the archive--V1";
%source_info = ();
%binary_info = ();
+%udeb_info = ();
%bin_src_ref = ();
sub read_src_list {
@@ -126,6 +128,54 @@
close(IN);
}
+sub read_udeb_list {
+ my ($udeb_list,$quiet) = @_;
+ my $LINTIAN_LAB = $ENV{'LINTIAN_LAB'};
+
+ if (%udeb_info) {
+ warn "\%udeb_info exists, nothing to do in read_bin_list\n" unless $quiet;
+ return;
+ }
+
+ $udeb_list or ($udeb_list = "$LINTIAN_LAB/info/udeb-packages");
+ return unless -s $udeb_list;
+
+ open(IN,$udeb_list) or fail("cannot open udeb list file $udeb_list: $!");
+
+ # compatible file format?
+ my $f;
+ chop($f = <IN>);
+ if ($f ne $UDEBLIST_FORMAT) {
+ close(IN);
+ return 0 if $quiet;
+ fail("the udeb list file $udeb_list has an incompatible file format (run lintian --setup-lab)");
+ }
+
+ # compatible format, so read file
+ while (<IN>) {
+ chop;
+
+ next if /^\s*$/o;
+ my ($udeb,$ver,$source,$file,$timestamp) = split(/\;/o,$_);
+
+ my $udeb_struct;
+ %$udeb_struct =
+ (
+ 'package' => $udeb,
+ 'version' => $ver,
+ 'source' => $source,
+ 'file' => $file,
+ 'timestamp' => $timestamp,
+ );
+
+ $udeb_info{$udeb} = $udeb_struct;
+ }
+
+ close(IN);
+}
+
+
+
sub get_bin_src_ref {
read_src_list();
for my $source (keys %source_info) {
Reply to: