The patch that we're using to address this bug is attached.
From aaeeafb5f7c8d72f275fcb8f7747e0b6a102f315 Mon Sep 17 00:00:00 2001
From: John Lightsey <jd@cpanel.net>
Date: Thu, 22 Sep 2011 10:27:01 -0500
Subject: [PATCH] Add -loose_perms option to Devel::Cover.
RT 49916: Test code that changes EUID before exiting cannot write to the cover
db directory by default due to restrictive file/directory permissions. This is
corrected with an option to give all cover DB directories 777 permisisons.
---
lib/Devel/Cover.pm | 14 +++++++++++++-
lib/Devel/Cover/DB.pm | 3 +++
lib/Devel/Cover/DB/IO/JSON.pm | 1 +
lib/Devel/Cover/DB/IO/Storable.pm | 1 +
lib/Devel/Cover/DB/Structure.pm | 3 +++
5 files changed, 21 insertions(+), 1 deletions(-)
diff --git a/lib/Devel/Cover.pm b/lib/Devel/Cover.pm
index ab56f18..6a94a49 100755
--- a/lib/Devel/Cover.pm
+++ b/lib/Devel/Cover.pm
@@ -54,6 +54,7 @@ my $Summary = 1; # Output coverage summary.
my $Subs_only = 0; # Coverage only for sub bodies.
my $Self_cover; # Coverage of Devel::Cover.
my $Self_cover_run = 0; # Covering Devel::Cover now.
+my $Loose_perms = 0; # Use loose permissions in the cover DB
my @Ignore; # Packages to ignore.
my @Inc; # Original @INC to ignore.
@@ -284,6 +285,7 @@ sub import
/^-silent/ && do { $Silent = shift @o; next };
/^-dir/ && do { $Dir = shift @o; next };
/^-db/ && do { $DB = shift @o; next };
+ /^-loose_perms/ && do { $Loose_perms = shift @o; next };
/^-merge/ && do { $Merge = shift @o; next };
/^-summary/ && do { $Summary = shift @o; next };
/^-blib/ && do { $blib = shift @o; next };
@@ -331,6 +333,9 @@ sub import
{
mkdir $DB, 0700 or die "Can't mkdir $DB: $!";
}
+ if ($Loose_perms) {
+ chmod 0777, $DB;
+ }
$DB = $1 if abs_path($DB) =~ /(.*)/;
Devel::Cover::DB->delete($DB) unless $Merge;
@@ -665,7 +670,7 @@ sub _report
chdir $Dir or die __PACKAGE__ . ": Can't chdir $Dir: $!\n";
$Run{collected} = \@collected;
- $Structure = Devel::Cover::DB::Structure->new(base => $DB);
+ $Structure = Devel::Cover::DB::Structure->new(base => $DB, loose_perms => $Loose_perms);
$Structure->read_all;
$Structure->add_criteria(@collected);
# print STDERR "Start structure: ", Dumper $Structure;
@@ -725,6 +730,7 @@ sub _report
base => $DB,
runs => { $run => \%Run },
structure => $Structure,
+ loose_perms => $Loose_perms,
);
my $dbrun = "$DB/runs";
@@ -732,6 +738,9 @@ sub _report
{
mkdir $dbrun, 0700 or croak "Can't mkdir $dbrun: $!\n";
}
+ if ($Loose_perms) {
+ chmod 0777, $dbrun;
+ }
$dbrun .= "/$run";
print OUT __PACKAGE__, ": Writing coverage database to $dbrun\n"
@@ -1378,6 +1387,9 @@ if the tests fail and you would like nice output telling you why.
+ignore RE - Append to REs of files to ignore.
-inc path - Set prefixes of files to ignore (default @INC).
+inc path - Append to prefixes of files to ignore.
+ -loose_perms val - Use loose permissions on all files and directories in
+ the coverage db so that code changing EUID can still
+ write coverage information (default off).
-merge val - Merge databases, for multiple test benches (default on).
-select RE - Set REs of files to select (default none).
+select RE - Append to REs of files to select.
diff --git a/lib/Devel/Cover/DB.pm b/lib/Devel/Cover/DB.pm
index 3fed6ac..8a5f397 100644
--- a/lib/Devel/Cover/DB.pm
+++ b/lib/Devel/Cover/DB.pm
@@ -83,6 +83,9 @@ sub write
{
mkdir $self->{db}, 0700 or croak "Can't mkdir $self->{db}: $!\n";
}
+ if ($self->{loose_perms}) {
+ chmod 0777, $self->{db};
+ }
$self->validate_db;
my $db = { runs => $self->{runs} };
diff --git a/lib/Devel/Cover/DB/IO/JSON.pm b/lib/Devel/Cover/DB/IO/JSON.pm
index f1d305d..a6a26e1 100644
--- a/lib/Devel/Cover/DB/IO/JSON.pm
+++ b/lib/Devel/Cover/DB/IO/JSON.pm
@@ -42,6 +42,7 @@ sub write
my $json = JSON::PP->new->utf8;
$json->ascii->pretty->canonical if $self->{options} =~ /\bpretty\b/i;
+ unlink $file;
open my $fh, ">", $file or die "Can't open $file: $!";
flock($fh, LOCK_EX) or die "Cannot lock file: $!\n";
print $fh $json->encode($data);
diff --git a/lib/Devel/Cover/DB/IO/Storable.pm b/lib/Devel/Cover/DB/IO/Storable.pm
index 0608b7e..a24b97e 100644
--- a/lib/Devel/Cover/DB/IO/Storable.pm
+++ b/lib/Devel/Cover/DB/IO/Storable.pm
@@ -34,6 +34,7 @@ sub write
my $self = shift;
my ($data, $file) = @_;
+ unlink $file;
Storable::lock_nstore($data, $file);
$self
}
diff --git a/lib/Devel/Cover/DB/Structure.pm b/lib/Devel/Cover/DB/Structure.pm
index d7dc13c..b128285 100644
--- a/lib/Devel/Cover/DB/Structure.pm
+++ b/lib/Devel/Cover/DB/Structure.pm
@@ -274,6 +274,9 @@ sub write
{
mkdir $dir, 0700 or croak "Can't mkdir $dir: $!\n";
}
+ if ($self->{loose_perms}) {
+ chmod 0777, $dir;
+ }
for my $file (sort keys %{$self->{f}})
{
$self->{f}{$file}{file} = $file;
--
1.7.5
