From f4cf820994119fa5572d41b380e248cb5e8f987a Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Thu, 18 May 2017 20:50:17 +0200
Subject: [PATCH] Die when we try to write a packfile that we cannot read.

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.
---
 MANIFEST                 |  3 ++-
 lib/ExtUtils/Packlist.pm | 13 +++++++++++--
 t/newlines.t             | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 48 insertions(+), 3 deletions(-)
 create mode 100644 t/newlines.t

diff --git a/MANIFEST b/MANIFEST
index f6f49a3..a417415 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -13,6 +13,7 @@ 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
@@ -20,7 +21,7 @@ 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
diff --git a/lib/ExtUtils/Packlist.pm b/lib/ExtUtils/Packlist.pm
index 4299ebe..b2f77e0 100644
--- a/lib/ExtUtils/Packlist.pm
+++ b/lib/ExtUtils/Packlist.pm
@@ -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!
@@ -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};
@@ -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}");
          }
       }
diff --git a/t/newlines.t b/t/newlines.t
new file mode 100644
index 0000000..df2add3
--- /dev/null
+++ b/t/newlines.t
@@ -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;