On Wed, Aug 17, 2011 at 09:31:41AM +0200, Niels Thykier wrote:
> Thanks for the patch and sorry if it has been difficult to get an
> overview of how the whole machinery. :)
Hi,
I've attached a new patch, and will comment point by point below.
> I got two issues with the patch; first off, the return value from open
> is not (always) checked.
Fixed.
> The second issue is that there are no checks
> for symlinks (possible exception being checks/scripts, I cannot remember
> the context).
> With the latter, we probably still have a couple of cases in other
> checks, where it fails to do that as well. So if you copy-pasted this
> from somewhere, let me know and I will fix that part as well[1].
> For this particular check, I would personally just skip symlinks,
> since whatever they point to ought to be picked up anyway.
checks/perl_modules was based on checks/scripts. I've got rid of that
now. I can't see any explicit checks for symlinks in collections/scripts,
or checks/scripts; I'm not sure if it makes sense to introduce one just
for this test?
> There is no need to introduce a collection just to "pick" .pm files.
> Either add it to checks/files (finding the right place can be tricky
> though) or rewrite the collection to open the scripts and modules and
> write what they do/require/use. The check can then be simplified to
> check that, this approach would also make it easier to check for other
> deprecated modules later. :)
> We can start with the simple approach you use now and modify it later
> if you are more comfortable with that. :)
Okay, I've made the patch a lot simpler by putting the .pm check in
checks/files.
> Other comments:
>
> [checks/perl_modules]
> """
> +#
> +# This is probably the right file to add a check for the use of
> +# set -e in bash and sh scripts.
> +#
> """
>
> Copy/waste error? :)
>
>
> [checks/perl_modules]
> """
> +foreach (@{$info->sorted_index}) {
> + next if $_ eq '';
> + my $index_info = $info->index->{$_};
> + my $operm = $index_info->{operm};
> + next unless ($index_info->{type} =~ m,^[-h], and ($operm & 01 or
> + $operm & 010 or $operm & 0100));
> +}
> """
> I am missing something here or is this just a no-op?
>
> [checks/perl_modules]
> """
> +my $all_deps = '';
> +for my $field (qw/suggests recommends depends pre-depends provides/) {
> + if (defined $info->field($field)) {
> + $all_deps .= ', ' if $all_deps;
> + $all_deps .= $info->field($field);
> + }
> +}
> +$all_deps .= ', ' if $all_deps;
> +$all_deps .= $pkg;
> +my $all_parsed = Lintian::Relation->new($all_deps);
> """
>
> Looks to me like a:
> """
> my $all_parsed = $info->relation('all');
> """
>
> ($info is a Lintian::Collect::Binary in this case)
>
> [checks/perl_modules.desc]
>
> """
> Needs-Info: unpacked, file-info, perl_modules, bin-pkg-control, fields,
> index
> """
>
> To me it only looks like unpacked, perl_modules and index are used[2].
> And the latter (as far as I can tell) only in the (possible) no-op loop
> above.
All of that is now moot (and was a result of cargoculting), as I'm now
adding to existing scripts.
The new patch also has a set of tests.
Cheers,
Dominic.
--
Dominic Hargreaves | http://www.larted.org.uk/~dom/
PGP key 5178E2A5 from the.earth.li (keyserver,web,email)
>From 948e24e291f2a973f61aa13f8e8b45e3962510f6 Mon Sep 17 00:00:00 2001
From: Dominic Hargreaves <d...@earth.li>
Date: Sun, 14 Aug 2011 16:22:14 +0100
Subject: [PATCH] Add new perl4 libs checks
These new checks add the following tags:
- perl-module-uses-perl4-libs-without-dep
- script-uses-perl4-libs-without-dep
Closes: #636994
---
checks/files | 15 +++++++++++++++
checks/files.desc | 9 +++++++++
checks/scripts | 11 +++++++++++
checks/scripts.desc | 9 +++++++++
.../debian/Naughty.pm | 7 +++++++
.../debian/debian/control.in | 15 +++++++++++++++
.../debian/debian/install | 2 ++
.../debian/naughty-script | 8 ++++++++
t/tests/uses-perl4-libs-without-dep-fp/desc | 7 +++++++
t/tests/uses-perl4-libs-without-dep-fp/tags | 1 +
.../uses-perl4-libs-without-dep/debian/Naughty.pm | 7 +++++++
.../debian/debian/install | 2 ++
.../debian/naughty-script | 8 ++++++++
t/tests/uses-perl4-libs-without-dep/desc | 7 +++++++
t/tests/uses-perl4-libs-without-dep/tags | 3 +++
15 files changed, 111 insertions(+), 0 deletions(-)
create mode 100644 t/tests/uses-perl4-libs-without-dep-fp/debian/Naughty.pm
create mode 100644 t/tests/uses-perl4-libs-without-dep-fp/debian/debian/control.in
create mode 100644 t/tests/uses-perl4-libs-without-dep-fp/debian/debian/install
create mode 100644 t/tests/uses-perl4-libs-without-dep-fp/debian/naughty-script
create mode 100644 t/tests/uses-perl4-libs-without-dep-fp/desc
create mode 100644 t/tests/uses-perl4-libs-without-dep-fp/tags
create mode 100644 t/tests/uses-perl4-libs-without-dep/debian/Naughty.pm
create mode 100644 t/tests/uses-perl4-libs-without-dep/debian/debian/install
create mode 100644 t/tests/uses-perl4-libs-without-dep/debian/naughty-script
create mode 100644 t/tests/uses-perl4-libs-without-dep/desc
create mode 100644 t/tests/uses-perl4-libs-without-dep/tags
diff --git a/checks/files b/checks/files
index 5315e56..94d45d5 100644
--- a/checks/files
+++ b/checks/files
@@ -797,6 +797,21 @@ foreach my $file (@{$info->sorted_index}) {
tag 'perl-module-in-core-directory', $file
unless $is_perl;
}
+
+ # ---------------- perl modules using old libraries
+ # we do the same check on perl scripts in checks/scripts
+ {
+ my $dep = Lintian::Relation->new($info->field('depends')//'');
+ if ($file =~ m,\.pm$, && !$dep->implies('libperl4-corelibs-perl')) {
+ open (PM, '<', $info->unpacked($file)) or fail("cannot open .pm file: $!");
+ while (<PM>) {
+ if (/(?:do|require)\s+(?:'|")(?:abbrev|assert|bigfloat|bigint|bigrat|cacheout|complete|ctime|dotsh|exceptions|fastcwd|find|finddepth|flush|getcwd|getopt|getopts|hostname|importenv|look|newgetopt|open2|open3|pwd|shellwords|stat|syslog|tainted|termcap|timelocal|validate)\.pl(?:'|")/) {
+ tag('perl-module-uses-perl4-libs-without-dep', "$file:$_");
+ }
+ }
+ close(PM);
+ }
+ }
# ---------------- license files
if ($file =~ m,(?:copying|licen[cs]e)(?:\.[^/]+)?$,i
diff --git a/checks/files.desc b/checks/files.desc
index c3ccec6..07b9739 100644
--- a/checks/files.desc
+++ b/checks/files.desc
@@ -1275,3 +1275,12 @@ Info: The package ships a library in one of the multiarch lib directories,
pre-dependency on multiarch-support. Packages installing to these
paths must Pre-Depend: multiarch-support to ensure the library can be
found by the dynamic linker at every point during an upgrade.
+
+Tag: perl-module-uses-perl4-libs-without-dep
+Severity: normal
+Certainty: possible
+Info: This package includes perl modules using obsoleted perl 4-era
+ libraries. These libraries have been deprecated in perl in 5.14, and
+ are likely to be removed from the core in perl 5.16. Please either
+ remove references to these libraries, or add a dependency on
+ <tt>libperl4-corelibs-perl | perl (<< 5.12.3-7)</tt> to this package.
diff --git a/checks/scripts b/checks/scripts
index bcb0526..1dca45a 100644
--- a/checks/scripts
+++ b/checks/scripts
@@ -449,6 +449,17 @@ for my $filename (sort keys %{$info->scripts}) {
script_tag('unusual-interpreter', $filename, "#!$interpreter");
}
+ # Check for obsolete perl libraries
+ if ($base eq 'perl' && !$all_parsed->implies('libperl4-corelibs-perl')) {
+ open(FH, '<', $path) or fail("could not open script $path");
+ while (<FH>) {
+ if (/(?:do|require)\s+(?:'|")(?:abbrev|assert|bigfloat|bigint|bigrat|cacheout|complete|ctime|dotsh|exceptions|fastcwd|find|finddepth|flush|getcwd|getopt|getopts|hostname|importenv|look|newgetopt|open2|open3|pwd|shellwords|stat|syslog|tainted|termcap|timelocal|validate)\.pl(?:'|")/) {
+ tag('script-uses-perl4-libs-without-dep', "$filename:$_");
+ }
+ }
+ close(FH);
+ }
+
# Do some additional checks on shell scripts in /etc. This should
# probably be extended eventually to any script in a public directory.
# This also needs smarter processing of multiline quoted strings,
diff --git a/checks/scripts.desc b/checks/scripts.desc
index efca4af..4571902 100644
--- a/checks/scripts.desc
+++ b/checks/scripts.desc
@@ -680,3 +680,12 @@ Info: The maintainer script removes a diversion that it didn't add. If
you're cleaning up unnecessary diversions from older versions of the
package, remove them in <tt>preinst</tt> or <tt>postinst</tt> instead of
waiting for <tt>postrm</tt> to do it.
+
+Tag: script-uses-perl4-libs-without-dep
+Severity: normal
+Certainty: possible
+Info: This package includes perl scripts using obsoleted perl 4-era
+ libraries. These libraries have been deprecated in perl in 5.14, and
+ are likely to be removed from the core in perl 5.16. Please either
+ remove references to these libraries, or add a dependency on
+ <tt>libperl4-corelibs-perl | perl (<< 5.12.3-7)</tt> to this package.
diff --git a/t/tests/uses-perl4-libs-without-dep-fp/debian/Naughty.pm b/t/tests/uses-perl4-libs-without-dep-fp/debian/Naughty.pm
new file mode 100644
index 0000000..f4a8c51
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep-fp/debian/Naughty.pm
@@ -0,0 +1,7 @@
+package Naughty;
+use strict;
+use warnings;
+
+require 'assert.pl';
+
+1;
diff --git a/t/tests/uses-perl4-libs-without-dep-fp/debian/debian/control.in b/t/tests/uses-perl4-libs-without-dep-fp/debian/debian/control.in
new file mode 100644
index 0000000..502547d
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep-fp/debian/debian/control.in
@@ -0,0 +1,15 @@
+Source: {$srcpkg}
+Priority: extra
+Section: {$section}
+Maintainer: {$author}
+Standards-Version: {$standards_version}
+Build-Depends: debhelper (>= 7.0.50~)
+
+Package: {$srcpkg}
+Architecture: any
+Depends: $\{shlibs:Depends\}, $\{misc:Depends\}, libperl4-corelibs-perl
+Description: {$description}
+ This is a test package designed to exercise some feature or tag of
+ Lintian. It is part of the Lintian test suite and may do very odd
+ things. It should not be installed like a regular package. It may
+ be an empty package.
diff --git a/t/tests/uses-perl4-libs-without-dep-fp/debian/debian/install b/t/tests/uses-perl4-libs-without-dep-fp/debian/debian/install
new file mode 100644
index 0000000..510fff0
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep-fp/debian/debian/install
@@ -0,0 +1,2 @@
+naughty-script usr/bin
+Naughty.pm usr/share/perl5
diff --git a/t/tests/uses-perl4-libs-without-dep-fp/debian/naughty-script b/t/tests/uses-perl4-libs-without-dep-fp/debian/naughty-script
new file mode 100644
index 0000000..a27daf2
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep-fp/debian/naughty-script
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+do 'newgetopt.pl';
+
+NGetOpt();
diff --git a/t/tests/uses-perl4-libs-without-dep-fp/desc b/t/tests/uses-perl4-libs-without-dep-fp/desc
new file mode 100644
index 0000000..4196a64
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep-fp/desc
@@ -0,0 +1,7 @@
+Testname: uses-perl4-libs-without-dep-fp
+Sequence: 6000
+Version: 1.0
+Description: Check that script-uses-perl4-libs-without-dep works (negative)
+Test-Against:
+ script-uses-perl4-libs-without-dep
+ perl-module-uses-perl4-libs-without-dep
diff --git a/t/tests/uses-perl4-libs-without-dep-fp/tags b/t/tests/uses-perl4-libs-without-dep-fp/tags
new file mode 100644
index 0000000..d952946
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep-fp/tags
@@ -0,0 +1 @@
+W: uses-perl4-libs-without-dep-fp: binary-without-manpage usr/bin/naughty-script
diff --git a/t/tests/uses-perl4-libs-without-dep/debian/Naughty.pm b/t/tests/uses-perl4-libs-without-dep/debian/Naughty.pm
new file mode 100644
index 0000000..f4a8c51
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep/debian/Naughty.pm
@@ -0,0 +1,7 @@
+package Naughty;
+use strict;
+use warnings;
+
+require 'assert.pl';
+
+1;
diff --git a/t/tests/uses-perl4-libs-without-dep/debian/debian/install b/t/tests/uses-perl4-libs-without-dep/debian/debian/install
new file mode 100644
index 0000000..510fff0
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep/debian/debian/install
@@ -0,0 +1,2 @@
+naughty-script usr/bin
+Naughty.pm usr/share/perl5
diff --git a/t/tests/uses-perl4-libs-without-dep/debian/naughty-script b/t/tests/uses-perl4-libs-without-dep/debian/naughty-script
new file mode 100644
index 0000000..a27daf2
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep/debian/naughty-script
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+do 'newgetopt.pl';
+
+NGetOpt();
diff --git a/t/tests/uses-perl4-libs-without-dep/desc b/t/tests/uses-perl4-libs-without-dep/desc
new file mode 100644
index 0000000..52bf408
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep/desc
@@ -0,0 +1,7 @@
+Testname: uses-perl4-libs-without-dep
+Sequence: 6000
+Version: 1.0
+Description: Check that script-uses-perl4-libs-without-dep works (positive)
+Test-For:
+ script-uses-perl4-libs-without-dep
+ perl-module-uses-perl4-libs-without-dep
diff --git a/t/tests/uses-perl4-libs-without-dep/tags b/t/tests/uses-perl4-libs-without-dep/tags
new file mode 100644
index 0000000..4932641
--- /dev/null
+++ b/t/tests/uses-perl4-libs-without-dep/tags
@@ -0,0 +1,3 @@
+W: uses-perl4-libs-without-dep: binary-without-manpage usr/bin/naughty-script
+W: uses-perl4-libs-without-dep: perl-module-uses-perl4-libs-without-dep usr/share/perl5/Naughty.pm:require 'assert.pl';\n
+W: uses-perl4-libs-without-dep: script-uses-perl4-libs-without-dep usr/bin/naughty-script:do 'newgetopt.pl';\n
--
1.7.5.4
