Skip to content

Commit

Permalink
Die when we try to write a packfile that we cannot read.
Browse files Browse the repository at this point in the history
Currently the packfile format simply does not allow for the data
it stores to contain a newline. Instead of allowing us to write
a broken packfile and then find out later it is unreadable we throw
an exception when we try to write.

This is part of a response to Issue #8.
  • Loading branch information
demerphq committed May 18, 2017
1 parent a8d1818 commit f4cf820
Show file tree
Hide file tree
Showing 3 changed files with 48 additions and 3 deletions.
3 changes: 2 additions & 1 deletion MANIFEST
Original file line number Diff line number Diff line change
Expand Up @@ -13,14 +13,15 @@ t/can_write_dir.t
t/Install.t
t/Installapi2.t
t/Installed.t
t/InstallWithMM.t
t/lib/MakeMaker/Test/Setup/BFD.pm
t/lib/MakeMaker/Test/Utils.pm
t/lib/Test/Builder.pm
t/lib/Test/Builder/Module.pm
t/lib/Test/More.pm
t/lib/Test/Simple.pm
t/lib/TieOut.pm
t/InstallWithMM.t
t/newlines.t
t/Packlist.t
t/pod-coverage.t
t/pod.t
13 changes: 11 additions & 2 deletions lib/ExtUtils/Packlist.pm
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ use strict;
use Carp qw();
use Config;
use vars qw($VERSION $Relocations);
$VERSION = '2.10';
$VERSION = '2.11';
$VERSION = eval $VERSION;

# Used for generating filehandle globs. IO::File might not be available!
Expand Down Expand Up @@ -154,11 +154,16 @@ sub write($;$)
{
my ($self, $packfile) = @_;
$self = tied(%$self) || $self;
my $fh;
if (ref $packfile) {
$fh= $packfile;
} else {
if (defined($packfile)) { $self->{packfile} = $packfile; }
else { $packfile = $self->{packfile}; }
Carp::croak("No packlist filename specified") if (! defined($packfile));
my $fh = mkfh();
$fh = mkfh();
open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
}
foreach my $key (sort(keys(%{$self->{data}})))
{
my $data = $self->{data}->{$key};
Expand All @@ -185,11 +190,15 @@ foreach my $key (sort(keys(%{$self->{data}})))
}
}
}
if ($key=~/\n/) { Carp::croak("Can't write packfile with newlines in the data. Sorry."); }
print $fh ("$key");
if (ref($data))
{
foreach my $k (sort(keys(%$data)))
{
if ($k=~/\n/ or $data->{$k}=~/\n/) {
Carp::croak("Can't write packfile with newlines in the data. Sorry.");
}
print $fh (" $k=$data->{$k}");
}
}
Expand Down
35 changes: 35 additions & 0 deletions t/newlines.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,35 @@
use strict;
use warnings;

use Test::More;

use ExtUtils::Packlist;
use File::Temp qw( tempfile );

my $packlist = ExtUtils::Packlist->new();

my $evil_path = "/some/evil\npath";
my $packfile = tempfile;

$packlist->{$evil_path} = { type => 'file' };
my $error;
eval {
$packlist->write($packfile);
} or $error= $@;
like($error,qr/Sorry/,"Got expected error");

if (0) {
# in theory we should be able to pass this test,
# in practice we die. I am leaving this here as a reminder.
my $new_packlist = ExtUtils::Packlist->new($packfile);

ok( exists $packlist->{$evil_path},
"Original path found in packlist before writing" )
or diag explain $packlist;

ok( exists $new_packlist->{$evil_path},
"Original path found in packlist after reading" )
or diag explain $new_packlist;
}

done_testing;

0 comments on commit f4cf820

Please sign in to comment.