[lintian] 03/04: c/debconf.pm: Use L::Path API instead of "unpacked"

[Niels Thykier <nthykier@moszumanska.debian.org>]

This is an automated email from the git hooks/post-receive script.

nthykier pushed a commit to branch master
in repository lintian.

commit bdca8111722918a533c931121bd2d90f795bdce0
Author: Niels Thykier <niels@thykier.net>
Date:   Mon Sep 29 22:25:35 2014 +0200

    c/debconf.pm: Use L::Path API instead of "unpacked"
    
    Signed-off-by: Niels Thykier <niels@thykier.net>
---
 checks/debconf.pm     |  4 +++-
 checks/menu-format.pm | 29 +++++++++++------------------
 checks/systemd.pm     | 36 ++++++++++++------------------------
 3 files changed, 26 insertions(+), 43 deletions(-)

diff --git a/checks/debconf.pm b/checks/debconf.pm
index 3797586..875ec3f 100644
--- a/checks/debconf.pm
+++ b/checks/debconf.pm
@@ -542,7 +542,9 @@ sub run {
     return if ($pkg eq 'debconf') || ($type eq 'udeb');
 
     foreach my $filename (sort keys %{$info->scripts}) {
-        open(my $fd, '<', $info->unpacked($filename));
+        my $path = $info->index_resolved_path($filename);
+        next if not $path or not $path->is_open_ok;
+        my $fd = $path->open;
         while (<$fd>) {
             s/#.*//;    # Not perfect for Perl, but should be OK
             if (   m,/usr/share/debconf/confmodule,
diff --git a/checks/menu-format.pm b/checks/menu-format.pm
index 7897647..1819f4c 100644
--- a/checks/menu-format.pm
+++ b/checks/menu-format.pm
@@ -505,30 +505,23 @@ sub verify_icon {
     }
 
     # Try the explicit location, and if that fails, try the standard path.
-    my $pkgroot = $info->unpacked;
-    my $iconfile = $info->unpacked($icon);
-    if (!-f $iconfile) {
-        $iconfile = $info->unpacked("usr/share/pixmaps/$icon");
-        if (!-f $iconfile) {
+    my $iconfile = $info->index_resolved_path($icon);
+    if (not $iconfile) {
+        $iconfile = $info->index_resolved_path("usr/share/pixmaps/$icon");
+        if (not $iconfile) {
             my $ginfo = $group->info;
             foreach my $depproc (@{ $ginfo->direct_dependencies($proc) }) {
                 my $dinfo = $depproc->info;
-                $pkgroot = $dinfo->unpacked;
-                $iconfile = $dinfo->unpacked($icon);
-                last if -f $iconfile;
-                $iconfile = $info->unpacked("usr/share/pixmaps/$icon");
-                last if -f $iconfile;
+                $iconfile = $dinfo->index_resolved_path($icon);
+                last if $iconfile;
+                $iconfile
+                  = $dinfo->index_resolved_path("usr/share/pixmaps/$icon");
+                last if $iconfile;
             }
         }
     }
 
-    # Last stat is a -f from above, reuse it
-    if (-e _) {
-        if (!is_ancestor_of($pkgroot, $iconfile)) {
-            # unsafe symlink
-            return;
-        }
-    } else {
+    if (not $iconfile or not $iconfile->is_open_ok) {
         tag 'menu-icon-missing', $icon;
         return;
     }
@@ -536,7 +529,7 @@ sub verify_icon {
     my $parse = 'XPM header';
     my $line;
 
-    open(my $fd, '<', $iconfile);
+    my $fd = $iconfile->open;
 
     do { defined($line = <$fd>) or goto parse_error; }
       until ($line =~ /\/\*\s*XPM\s*\*\//);
diff --git a/checks/systemd.pm b/checks/systemd.pm
index 90edfe6..05cb8d1 100644
--- a/checks/systemd.pm
+++ b/checks/systemd.pm
@@ -32,9 +32,7 @@ use List::MoreUtils qw(any);
 use Text::ParseWords qw(shellwords);
 
 use Lintian::Tags qw(tag);
-use Lintian::Util qw(
-  fail is_ancestor_of normalize_pkg_path lstrip rstrip
-);
+use Lintian::Util qw(fail lstrip rstrip);
 
 sub run {
     my (undef, undef, $info) = @_;
@@ -144,9 +142,10 @@ sub check_systemd_service_file {
 
 sub service_file_lines {
     my ($path) = @_;
-    my @lines;
-    my $continuation;
-    open(my $fh, '<', $path);
+    my (@lines, $continuation);
+    return if $path->is_symlink and $path->link eq '/dev/null';
+
+    my $fh = $path->open;
     while (<$fh>) {
         chomp;
 
@@ -180,31 +179,20 @@ sub extract_service_file_values {
 
     my (@values, $section);
 
-    my $unpacked_file = $info->unpacked($file);
-    unless (
-        (-f $unpacked_file&& is_ancestor_of($info->unpacked, $unpacked_file))
+    unless ($file->is_open_ok
         || ($file->is_symlink && $file->link eq '/dev/null')) {
         tag 'service-file-is-not-a-file', $file;
         return;
     }
-    my @lines = service_file_lines($unpacked_file);
+    my @lines = service_file_lines($file);
     if (any { /^\.include / } @lines) {
+        my $parent_dir = $file->parent_dir;
         @lines = map {
             if (/^\.include (.+)$/) {
-                my $path = $1;
-                my $normalized;
-                my $included;
-                if ($path =~ s,^/,,) {
-                    $normalized = normalize_pkg_path('/', $path);
-                } else {
-                    $normalized = normalize_pkg_path($file->dirname, $path);
-                }
-                $included = $info->unpacked($normalized)
-                  if defined($normalized);
-                if (   defined($included)
-                    && -f $included
-                    && is_ancestor_of($info->unpacked, $included)) {
-                    service_file_lines($included);
+                my $path = $parent_dir->resolve_path($1);
+                if (defined($path)
+                    && $path->is_open_ok) {
+                    service_file_lines($path);
                 } else {
                     # doesn't exist, exists but not a file or "out-of-bounds"
                     $_;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/lintian/lintian.git