+++ /dev/null
-#! /bin/sh /usr/share/dpatch/dpatch-run
-## 500-backport-1.23.22-frontend.dpatch by Eero Häkkinen <eero.hakkinen@nokia.com>
-##
-## All lines beginning with `## DP:' are a description of the patch.
-## DP: Backported frontends from lintian 1.23.22
-
-@DPATCH@
-diff -urNad lintian-1.23.8/frontend/lintian lintian-1.23.22/frontend/lintian
---- lintian-1.23.8/frontend/lintian 2005-01-02 00:29:42.000000000 +0000
-+++ lintian-1.23.22/frontend/lintian 2006-07-19 11:57:17.000000000 +0000
-@@ -17,8 +17,8 @@
- # 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., 59 Temple Place - Suite 330, Boston,
--# MA 02111-1307, USA.
-+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
-+# MA 02110-1301, USA.
- # }}}
-
- # {{{ libraries and such
-@@ -64,6 +64,8 @@
- my $LINTIAN_CFG = ""; #config file to use
- our $LINTIAN_ROOT; #location of the lintian modules
-
-+my $experimental_output_opts = undef;
-+
- my @packages;
-
- my $action;
-@@ -72,7 +74,7 @@
- my $unpack_info;
- my $cwd;
- my $cleanup_filename;
--my $exit_code;
-+my $exit_code = 0;
- my $LAB;
-
- my %collection_info;
-@@ -258,6 +260,9 @@
- "unpack-info|U=s" => \&record_unpack_info,
- "md5sums|m" => \$check_md5sums,
- "allow-root" => \$allow_root,
-+ # Note: Ubuntu has (and other derivatives might gain) a
-+ # -D/--debian option to make lintian behave like in Debian, that
-+ # is, to revert distribution-specific changes
-
- # ------------------ configuration options
- "cfg=s" => \$LINTIAN_CFG,
-@@ -274,6 +279,9 @@
- "source|s" => \&record_pkgmode,
- "udeb" => \&record_pkgmode,
- "packages-file|p=s" => \$packages_file,
-+
-+ # ------------------ experimental
-+ "exp-output:s" => \$experimental_output_opts,
- );
-
- # init commandline parser
-@@ -385,7 +393,7 @@
- # LINTIAN_ARCH must have a value.
- unless (defined $LINTIAN_ARCH) {
- if ($LINTIAN_DIST) {
-- chop($LINTIAN_ARCH=`dpkg --print-installation-architecture`);
-+ chop($LINTIAN_ARCH=`dpkg --print-architecture`);
- } else {
- $LINTIAN_ARCH = 'any';
- }
-@@ -475,7 +483,14 @@
- import Util;
- import Pipeline;
-
--# }}}
-+require Tags;
-+import Tags;
-+
-+my @l_secs = read_dpkg_control("$LINTIAN_ROOT/checks/lintian.desc");
-+shift(@l_secs);
-+map Tags::add_tag($_), @l_secs;
-+
-+# }}}
-
- # {{{ No clue why this code is here...
-
-@@ -607,6 +622,7 @@
- next;
- }
-
-+ Tags::set_pkg( $arg, $arg_name, "", "", 'binary' );
- # check distribution field
- if (! (($data->{'distribution'} eq 'stable')
- or ($data->{'distribution'} eq 'testing')
-@@ -616,7 +632,8 @@
- or ($data->{'distribution'} =~ /\w+-security/))
- ) {
- # bad distribution entry
-- print "E: $arg_name: bad-distribution-in-changes-file $data->{'distribution'}\n";
-+ tag("bad-distribution-in-changes-file",
-+ $data->{'distribution'});
- }
-
- # process all listed `files:'
-@@ -636,7 +653,7 @@
- if (-s $filename ne $size) {
- print "N: size is $size, argname is $arg_name, filename is $filename\n";
-
-- print "E: $arg_name: file-size-mismatch-in-changes-file $file\n";
-+ tag( "file-size-mismatch-in-changes-file", $file );
- }
-
- # check md5sums
-@@ -644,13 +661,13 @@
- my $real_md5sum = get_file_md5($filename);
-
- if ($real_md5sum ne $md5sum) {
-- print "E: $arg_name: md5sum-mismatch-in-changes-file $file\n";
-+ tag( "md5sum-mismatch-in-changes-file", $file );
- }
- }
-
- # check section
- if (($section eq 'non-free') or ($section eq 'contrib')) {
-- print "E: $arg_name: bad-section-in-changes-file $file $section\n";
-+ tag( "bad-section-in-changes-file", $file, $section );
- }
-
- # process file?
-@@ -668,6 +685,14 @@
- $info->{'version'}, $filename);
- }
- }
-+
-+ unless ($exit_code) {
-+ my $stats = Tags::get_stats( $arg );
-+ if ($stats->{severity}{4}) {
-+ $exit_code = 1;
-+ }
-+ }
-+
- } else {
- fail("bad package file name $arg (neither .deb, .udeb or .dsc file)");
- }
-@@ -850,10 +875,22 @@
-
- # {{{ Now we're ready to load info about checks & tags
-
--require Tags;
--import Tags;
-+no warnings 'once';
-+if (defined $experimental_output_opts) {
-+ $Tags::output_formatter = \&Tags::print_tag_new;
-+ my %opts = map { split(/=/) } split( /,/, $experimental_output_opts );
-+ foreach (keys %opts) {
-+ if ($_ eq 'format') {
-+ if ($opts{$_} eq 'colons') {
-+ require Tags::ColonSeparated;
-+ $Tags::output_formatter = \&Tags::ColonSeparated::print_tag;
-+ }
-+ }
-+ no strict 'refs';
-+ ${"Tags::$_"} = $opts{$_};
-+ }
-+}
-
--no warnings;
- $Tags::show_info = $display_infotags;
- $Tags::show_overrides = $show_overrides;
- use warnings;
-@@ -920,10 +957,10 @@
- }
- }
-
-+ shift(@secs);
-+ map Tags::add_tag($_), @secs;
- } # end: if ne lintian
-
-- shift(@secs);
-- map Tags::add_tag($_), @secs;
- }
-
- closedir(CHECKDIR);
-@@ -1056,8 +1093,6 @@
- printf "N: Selected checks: %s\n",join(',',keys %checks);
- }
-
--$exit_code = 0;
--
- require Checker;
-
- # for each package (the `reverse sort' is to make sure that source packages are
-@@ -1203,7 +1238,7 @@
- }
-
- if ($action eq 'check') { # read override file
-- Tags::pkg_reset($long_type eq 'binary' ? $pkg : "$pkg $long_type");
-+ Tags::set_pkg( $file, $pkg, "", "", $long_type );
-
-
- unless ($no_override)
-@@ -1259,21 +1294,25 @@
- print "N: Skipping $action of $long_type package $pkg\n";
- next PACKAGE;
- }
-+
-+ }
-+ unless ($exit_code) {
-+ my $stats = Tags::get_stats( $file );
-+ if ($stats->{severity}{4}) {
-+ $exit_code = 1;
-+ }
- }
-
- # report unused overrides
--# if (not $no_override and $verbose) {
--# my $ppkg = $type eq 'b' ? quotemeta($pkg) : quotemeta("$pkg $long_type");
--# for my $o (sort keys %overridden) {
--# next unless $o =~ /^$ppkg:/;
--# next if $overridden{$o};
--#
--# print "I: $pkg: unused-override $o\n";
--#
--# # mark override entry as used
--# $overridden{$o} = 99999;
--# }
--# }
-+ if (not $no_override and $verbose) {
-+ my $overrides = Tags::get_overrides( $file );
-+
-+ for my $o (sort keys %$overrides) {
-+ next if $overrides->{$o};
-+
-+ tag( "unused-override", $o );
-+ }
-+ }
- }
-
- # chdir to lintian root directory (to unlock $base so it can be removed below)
-diff -urNad lintian-1.23.8/frontend/lintian-info lintian-1.23.22/frontend/lintian-info
---- lintian-1.23.8/frontend/lintian-info 2004-11-24 22:44:09.000000000 +0000
-+++ lintian-1.23.22/frontend/lintian-info 2006-07-19 11:57:17.000000000 +0000
-@@ -17,8 +17,8 @@
- # 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., 59 Temple Place - Suite 330, Boston,
--# MA 02111-1307, USA.
-+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
-+# MA 02110-1301, USA.
-
- use strict;
-
-@@ -48,6 +48,7 @@
- my ($type, $pkg, @pieces) = split(/:\s+/);
- if ($type =~ m/^[OEWIX]$/) {
- $tag = shift @pieces;
-+ next if not defined $tag;
- ($tag) = split(/\s+/, $tag, 2);
-
- next if not exists $tag_info{$tag} or $already_displayed{$tag}++;
-diff -urNad lintian-1.23.8/lib/Tags/ColonSeparated.pm lintian-1.23.22/lib/Tags/ColonSeparated.pm
---- lintian-1.23.8/lib/Tags/ColonSeparated.pm 1970-01-01 00:00:00.000000000 +0000
-+++ lintian-1.23.22/lib/Tags/ColonSeparated.pm 2006-07-19 11:58:28.000000000 +0000
-@@ -0,0 +1,55 @@
-+# Tags::ColonSeparated -- Perl tags functions for lintian
-+# $Id: Tags.pm 489 2005-09-17 00:06:30Z djpig $
-+
-+# Copyright (C) 2005 Frank Lichtenheld <frank@lichtenheld.de>
-+#
-+# 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.
-+
-+package Tags::ColonSeparated;
-+use strict;
-+use warnings;
-+
-+sub quote_char {
-+ my ( $char, @items ) = @_;
-+
-+ foreach (@items) {
-+ s/\\/\\\\/go;
-+ s/\Q$char\E/\\$char/go;
-+ }
-+
-+ return @items;
-+}
-+
-+sub print_tag {
-+ my ( $pkg_info, $tag_info, $information ) = @_;
-+
-+ my $extra = "@$information";
-+
-+ print join(':', quote_char( ':',
-+ $tag_info->{severity},
-+ $tag_info->{significance},
-+ @{$tag_info->{overridden}}{'override',
-+ 'severity',
-+ 'significance'},
-+ @{$pkg_info}{'pkg','version','arch','type'},
-+ $tag_info->{tag},
-+ $extra,
-+ ))."\n";
-+}
-+
-+1;
-+
-diff -urNad lintian-1.23.8/lib/Tags.pm lintian-1.23.22/lib/Tags.pm
---- lintian-1.23.8/lib/Tags.pm 2006-07-18 13:39:52.000000000 +0000
-+++ lintian-1.23.22/lib/Tags.pm 2006-07-19 11:57:40.000000000 +0000
-@@ -1,7 +1,8 @@
- # Tags -- Perl tags functions for lintian
--# $Id: Tags.pm 364 2004-11-13 21:07:48Z djpig $
-+# $Id: Tags.pm 510 2005-10-14 00:19:49Z djpig $
-
- # Copyright (C) 1998-2004 Various authors
-+# Copyright (C) 2005 Frank Lichtenheld <frank@lichtenheld.de>
- #
- # 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
-@@ -16,30 +17,30 @@
- # 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., 59 Temple Place - Suite 330, Boston,
--# MA 02111-1307, USA.
-+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
-+# MA 02110-1301, USA.
-
- package Tags;
- use strict;
--
--use Util;
-+use warnings;
-
- use Exporter;
- our @ISA = qw(Exporter);
- our @EXPORT = qw(tag);
-
--my $LINTIAN_ROOT = $::LINTIAN_ROOT;
--
--# Can also be more precise later on (only verbose with lab actions) but for
--# now this will do --Jeroen
--my $verbose = $::verbose;
--my $debug = $::debug;
--
--# What to print between the "E:" and the tag, f.e. "package source"
--our $prefix = undef;
-+# configuration variables and defaults
-+our $verbose = $::verbose;
-+our $debug = $::debug;
- our $show_info = 0;
-+our $show_overrides = 0;
-+our $output_formatter = \&print_tag;
-+our $min_severity = 1;
-+our $max_severity = 99;
-+our $min_significance = 1;
-+our $max_significance = 99;
-
--# The master hash with all tag info. Key is a hash too, with these stuff:
-+# The master hash with all tag info. Key is the tag name, value another hash
-+# with the following keys:
- # - tag: short name
- # - type: error/warning/info/experimental
- # - info: Description in HTML
-@@ -47,53 +48,265 @@
- # - experimental: experimental status (possibly undef)
- my %tags;
-
--our $show_overrides;
--# in the form overrides->tag or full thing
--my %overrides;
-+# Statistics per file. Key is the filename, value another hash with the
-+# following keys:
-+# - overrides
-+# - tags
-+# - severity
-+# - significance
-+my %stats;
-
--my $codes = { 'error' => 'E' , 'warning' => 'W' , 'info' => 'I' };
-+# Info about a specific file. Key is the the filename, value another hash
-+# with the following keys:
-+# - pkg: package name
-+# - version: package version
-+# - arch: package architecture
-+# - type: one of 'binary', 'udeb' or 'source'
-+# - overrides: hash with all overrides for this file as keys
-+my %info;
-
-+# Currently selected file (not package!)
-+my $current;
-
--# TODO
--# - override support back in --> just the unused reporting
--# - be able to return whether any errors were there, better, full stats
-+# Compatibility stuff
-+my %codes = ( 'error' => 'E' , 'warning' => 'W' , 'info' => 'I' );
-+our %type_to_sev = ( error => 4, warning => 2, info => 0 );
-+our @sev_to_type = qw( info warning warning error error );
-
--# Call this function to add a certain tag, by supplying the info as a hash
-+my @sig_to_qualifier = ( '??', '?', '', '!' );
-+my @sev_to_code = qw( I W W E E );
-+
-+# Add a new tag, supplied as a hash reference
- sub add_tag {
- my $newtag = shift;
-- fail("Duplicate tag: $newtag->{'tag'}")
-- if exists $tags{$newtag->{'tag'}};
--
-+ if (exists $tags{$newtag->{tag}}) {
-+ warn "Duplicate tag: $newtag->{tag}\n";
-+ return 0;
-+ }
-+
-+ # smooth transition
-+ $newtag->{type} = $sev_to_type[$newtag->{severity}]
-+ unless $newtag->{type};
-+ $newtag->{significance} = 2 unless exists $newtag->{significance};
-+ $newtag->{severity} = $type_to_sev{$newtag->{type}}
-+ unless exists $newtag->{severity};
- $tags{$newtag->{'tag'}} = $newtag;
-+ return 1;
- }
-
--# Used to reset the matched tags data
--sub pkg_reset {
-- $prefix = shift;
-- %overrides = ();
-+# Add another file, will fail if there is already stored info about
-+# the file
-+sub set_pkg {
-+ my ( $file, $pkg, $version, $arch, $type ) = @_;
-+
-+ if (exists $info{$file}) {
-+ warn "File $file was already processed earlier\n";
-+ return 0;
-+ }
-+
-+ $current = $file;
-+ $info{$file} = {
-+ pkg => $pkg,
-+ version => $version,
-+ arch => $arch,
-+ type => $type,
-+ overrides => {},
-+ };
-+ $stats{$file} = {
-+ severity => {},
-+ significance => {},
-+ tags => {},
-+ overrides => {},
-+ };
-+
-+ return 1;
- }
-
--# Add an override, string tag, string rest
-+# select another file as 'current' without deleting or adding any information
-+# the file must have been added with add_pkg
-+sub select_pkg {
-+ my ( $file ) = @_;
-+
-+ unless (exists $info{$file}) {
-+ warn "Can't select package $file";
-+ return 0;
-+ }
-+
-+ $current = $file;
-+ return 1;
-+}
-+
-+# only delete the value of 'current' without deleting any stored information
-+sub reset_pkg {
-+ undef $current;
-+ return 1;
-+}
-+
-+# delete all the stored information (including tags)
-+sub reset {
-+ undef %stats;
-+ undef %info;
-+ undef %tags;
-+ undef $current;
-+ return 1;
-+}
-+
-+# Add an override. If you specifiy two arguments, the first will be taken
-+# as file to add the override to, otherwise 'current' will be assumed
- sub add_override {
-- my $tag = shift;
-- $overrides{$tag} = 0;
-+ my ($tag, $file) = ( "", "" );
-+ if (@_ > 1) {
-+ ($file, $tag) = @_;
-+ } else {
-+ ($file, $tag) = ($current, @_);
-+ }
-+
-+ unless ($file) {
-+ warn "Don't know which package to add override $tag to";
-+ return 0;
-+ }
-+
-+ $info{$file}{overrides}{$tag} = 0;
-+
-+ return 1;
-+}
-+
-+sub get_overrides {
-+ my ($file) = @_;
-+
-+ unless ($file) {
-+ warn "Don't know which package to get overrides from";
-+ return undef;
-+ }
-+
-+ return $info{$file}{overrides};
-+}
-+
-+# Get the info hash for a tag back as a reference. The hash will be
-+# copied first so that you can edit it safely
-+sub get_tag_info {
-+ my ( $tag ) = @_;
-+ return { %{$tags{$tag}} } if exists $tags{$tag};
-+ return undef;
-+}
-+
-+sub check_range {
-+ my ( $x, $min, $max ) = @_;
-+
-+ return -1 if $x < $min;
-+ return 1 if $x > $max;
-+ return 0;
-+}
-+
-+# check if a certain tag has a override for the 'current' package
-+sub check_overrides {
-+ my ( $tag_info, $information ) = @_;
-+
-+ my $extra = '';
-+ $extra = " @$information" if @$information;
-+ $extra = '' if $extra eq ' ';
-+ if( exists $info{$current}{overrides}{$tag_info->{tag}}) {
-+ $info{$current}{overrides}{$tag_info->{tag}}++;
-+ return $tag_info->{tag};
-+ } elsif( exists $info{$current}{overrides}{"$tag_info->{tag}$extra"} ) {
-+ $info{$current}{overrides}{"$tag_info->{tag}$extra"}++;
-+ return "$tag_info->{tag}$extra";
-+ }
-+
-+ return '';
-+}
-+
-+# sets all the overridden fields of a tag_info hash correctly
-+sub check_need_to_show {
-+ my ( $tag_info, $information ) = @_;
-+ $tag_info->{overridden}{override} = check_overrides( $tag_info,
-+ $information );
-+ my $min_sev = $show_info ? 0 : $min_severity; # compat hack
-+ $tag_info->{overridden}{severity} = check_range( $tag_info->{severity},
-+ $min_sev,
-+ $max_severity );
-+ $tag_info->{overridden}{significance} = check_range( $tag_info->{significance},
-+ $min_significance,
-+ $max_significance );
- }
-
-+# records the stats for a given tag_info hash
-+sub record_stats {
-+ my ( $tag_info ) = @_;
-+
-+ for my $k (qw( severity significance tag )) {
-+ $stats{$current}{$k}{$tag_info->{$k}}++
-+ unless $tag_info->{overridden}{$k};
-+ }
-+ for my $k (qw( severity significance override )) {
-+ $stats{$current}{overrides}{$k}{$tag_info->{overridden}{$k}}++
-+ if $tag_info->{overridden}{$k};
-+ }
-+}
-+
-+# get the statistics for a file (one argument) or for all files (no argument)
-+sub get_stats {
-+ my ( $file ) = @_;
-+
-+ return $stats{$file} if $file;
-+ return \%stats;
-+}
-+
-+sub print_tag {
-+ my ( $pkg_info, $tag_info, $information ) = @_;
-+
-+ my $extra = '';
-+ $extra = " @$information" if @$information;
-+ $extra = '' if $extra eq ' ';
-+ my $code = $codes{$tag_info->{type}};
-+ $code = 'O' if $tag_info->{overridden}{override};
-+ my $type = '';
-+ $type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
-+
-+ print "$code: $pkg_info->{pkg}$type: $tag_info->{tag}$extra\n";
-+}
-+
-+sub print_tag_new {
-+ my ( $pkg_info, $tag_info, $information ) = @_;
-+
-+ my $extra = '';
-+ $extra = " @$information" if @$information;
-+ $extra = '' if $extra eq ' ';
-+ my $code = $sev_to_code[$tag_info->{severity}];
-+ $code = 'O' if $tag_info->{overridden}{override};
-+ my $qualifier = $sig_to_qualifier[$tag_info->{significance}];
-+ $qualifier = '' if $code eq 'O';
-+ my $type = '';
-+ $type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
-+
-+ print "$code$qualifier: $pkg_info->{pkg}$type: $tag_info->{tag}$extra\n";
-+
-+}
-
- sub tag {
-- my $tag = shift;
-- my $info = $tags{$tag};
-- return if not $show_info and $info->{'type'} eq 'info';
-- my $extra = '';
-- $extra = ' '.join(' ', @_) if $#_ >=0;
-- $extra = '' if $extra eq ' ';
-- my $code = $codes->{$info->{'type'}};
-- if (exists $overrides{$tag} or exists $overrides{"$tag$extra"}) {
-- return unless $show_overrides or $verbose;
-- $code = 'O';
-- }
-+ my ( $tag, @information ) = @_;
-+ unless ($current) {
-+ warn "Tried to issue tag $tag without setting package\n";
-+ return 0;
-+ }
-
-- print "$code: $prefix: $tag$extra\n";
-+ my $tag_info = get_tag_info( $tag );
-+ unless ($tag_info) {
-+ warn "Tried to issue unknown tag $tag\n";
-+ return 0;
-+ }
-+ check_need_to_show( $tag_info, \@information );
-+
-+ record_stats( $tag_info );
-+
-+ return 1 if
-+ $tag_info->{overridden}{severity} != 0
-+ || $tag_info->{overridden}{significance} != 0
-+ || ( $tag_info->{overridden}{override} &&
-+ !$show_overrides);
-+
-+ &$output_formatter( $info{$current}, $tag_info, \@information );
-+ return 1;
- }
-
- 1;
projects / maemian / blobdiff