From owner-freebsd-bugs@FreeBSD.ORG Wed Oct 26 00:10:11 2011 Return-Path: Delivered-To: freebsd-bugs@hub.freebsd.org Received: from mx1.freebsd.org (mx1.freebsd.org [IPv6:2001:4f8:fff6::34]) by hub.freebsd.org (Postfix) with ESMTP id 0FA851065674 for ; Wed, 26 Oct 2011 00:10:11 +0000 (UTC) (envelope-from gnats@FreeBSD.org) Received: from freefall.freebsd.org (freefall.freebsd.org [IPv6:2001:4f8:fff6::28]) by mx1.freebsd.org (Postfix) with ESMTP id E3A948FC17 for ; Wed, 26 Oct 2011 00:10:10 +0000 (UTC) Received: from freefall.freebsd.org (localhost [127.0.0.1]) by freefall.freebsd.org (8.14.4/8.14.4) with ESMTP id p9Q0AASl031483 for ; Wed, 26 Oct 2011 00:10:10 GMT (envelope-from gnats@freefall.freebsd.org) Received: (from gnats@localhost) by freefall.freebsd.org (8.14.4/8.14.4/Submit) id p9Q0AA9p031482; Wed, 26 Oct 2011 00:10:10 GMT (envelope-from gnats) Date: Wed, 26 Oct 2011 00:10:10 GMT Message-Id: <201110260010.p9Q0AA9p031482@freefall.freebsd.org> To: freebsd-bugs@FreeBSD.org From: Michael G Schwern Cc: Subject: Re: misc/162016: BSDPAN::ExtUtils::Packlist-> get_dir_list can go into an infinite loop X-BeenThere: freebsd-bugs@freebsd.org X-Mailman-Version: 2.1.5 Precedence: list Reply-To: Michael G Schwern List-Id: Bug reports List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 26 Oct 2011 00:10:11 -0000 The following reply was made to PR misc/162016; it has been noted by GNATS. From: Michael G Schwern To: bug-followup@FreeBSD.org Cc: Subject: Re: misc/162016: BSDPAN::ExtUtils::Packlist->get_dir_list can go into an infinite loop Date: Tue, 25 Oct 2011 17:04:39 -0700 This is a multi-part message in MIME format. --------------010506050404040500090003 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 7bit Attached is a test and a fix for BSDPAN::ExtUtils::Packlist::get_dir_list(). I patched the version from BSDPAN-5.12.1_20100713.tar.bz2. --------------010506050404040500090003 Content-Type: text/plain; name="get_dir_list.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="get_dir_list.patch" diff --git a/BSDPAN/ExtUtils/Packlist.pm b/BSDPAN/ExtUtils/Packlist.pm index 19f764e..b659513 100644 --- a/BSDPAN/ExtUtils/Packlist.pm +++ b/BSDPAN/ExtUtils/Packlist.pm @@ -17,6 +17,7 @@ use Config; use Fcntl; use BSDPAN; use BSDPAN::Override; +use File::Basename qw(dirname basename); sub write { my $orig = shift; # original ExtUtils::Packlist::write @@ -210,18 +211,20 @@ sub get_dir_list { my %alldirs; for my $file (@files) { - $file =~ s|/[^/]+$||; - while (-d $file) { - $file =~ s|/([^/]+)$||; - my $last = $1; - last if $last eq "bin"; - last if $last eq "auto"; - last if $last eq "man1"; - last if $last eq "man3"; - last if $last eq "site_perl"; - last if $last eq "mach"; + my $dir = dirname($file); + + while( -d $dir ) { + my $last = basename($dir); + last if grep { $last eq $_ } qw(bin auto man1 man3 site_perl mach); + last if $last =~ /^[\d.]+$/; - $alldirs{"$file/$last"}++; + + $alldirs{$dir}++; + + my $parent = dirname($dir); + last if $parent eq $dir; + last if $parent eq '/'; + $dir = $parent; } } diff --git a/t/get_dir_list.t b/t/get_dir_list.t new file mode 100644 index 0000000..703a78e --- /dev/null +++ b/t/get_dir_list.t @@ -0,0 +1,79 @@ +#!/usr/bin/env perl -w + +use strict; +use warnings; + +use autodie; +use BSDPAN::ExtUtils::Packlist; +use ExtUtils::Packlist; +use File::Temp; +use File::Spec; +use File::Path; +use Cwd qw(abs_path); + +use Test::More; + +my $Orig_Cwd = abs_path; + +my $get_dir_list = \&BSDPAN::ExtUtils::Packlist::get_dir_list; + +my $packlist = ExtUtils::Packlist->new; + + +note "get_dir_list"; { + my $tempdir = File::Temp->newdir; + + my @tempdir = grep { length $_ } File::Spec->splitdir($tempdir); + my %want; + for my $depth (0..$#tempdir) { + $want{File::Spec->catdir("", @tempdir[0..$depth])}++; + } + + is_deeply + [sort $get_dir_list->($packlist, "$tempdir/.packlist", "$tempdir/lib/perl5/Foo/Bar.pm")], + [sort keys %want]; + + # Now do it again with the lib directory existing + mkpath "$tempdir/lib/perl5/Foo"; + + $want{"$tempdir/lib/perl5/Foo"} = 1; + $want{"$tempdir/lib/perl5"} = 1; + $want{"$tempdir/lib"} = 1; + + is_deeply + [sort $get_dir_list->($packlist, "$tempdir/.packlist", "$tempdir/lib/perl5/Foo/Bar.pm")], + [sort keys %want]; + + # Does it ignore bin? + mkpath "$tempdir/bin"; + + is_deeply + [sort $get_dir_list->( + $packlist, + "$tempdir/.packlist", + "$tempdir/lib/perl5/Foo/Bar.pm", + "$tempdir/bin/foo", + )], + [sort keys %want]; +} + + +note "With .. and ."; { + my $tempdir = File::Temp->newdir; + mkdir "$tempdir/foo"; + chdir "$tempdir/foo"; + + is_deeply + [sort $get_dir_list->($packlist, "../foo/.packlist")], + ["../foo"]; + + chdir $tempdir; + + is_deeply + [sort $get_dir_list->($packlist, "./foo/.packlist")], + ["./foo"]; + + chdir $Orig_Cwd; +} + +done_testing; --------------010506050404040500090003--