Have echo() escape all dollar signs by default.

This completely protects the PPD and META files from stray variables. It's the default not to expand because most folks don't think about that. There's an option now to turn it on. Derivative changes... Possibly incompatible changes * echo() now escapes all dollar signs by default New Features * echo() has an option to allow make variable expansion. * echo() is now passed a hash of options (old style $appending flag still works for compatibility). * quote_literal() now escapes dollar signs, but allows make variables. * quote_literal() has an option to escape make variables. * escape_dollarsigns() to escape dollar signs but allow variables * escape_all_dollarsigns() to escape all dollar signs For rt.cpan.org 71847
rkitover · Oct 23, 2011 · 577aa89 · 577aa89
1 parent 2d1787a
commit 577aa89
Show file tree

Hide file tree

Showing 8 changed files with 137 additions and 32 deletions.
diff --git a/Changes b/Changes
@@ -1,8 +1,27 @@
-6.61_01  Sat Sep 24 22:16:13 PDT 2011
+6.61_02
     Bug Fixes
-    * Stray $ in the ABSTRACT or other locations are now escaped.
-      [rt.cpan.org 71847]
+    * Stray $ in the PPD and meta files (for example, from the ABSTRACT)
+      are now escaped.  [rt.cpan.org 71847]
+
+    Possibly incompatible changes
+    * echo() now escapes all dollar signs by default
+
+    New Features
+    * echo() has an option to allow make variable expansion.
+    * echo() is now passed a hash of options (old style $appending flag
+      still works for compatibility).
+    * quote_literal() now escapes dollar signs, but allows make variables.
+    * quote_literal() has an option to escape make variables.
+    * escape_dollarsigns() to escape dollar signs but allow variables
+    * escape_all_dollarsigns() to escape all dollar signs
+
 
+    Improvements
+    * The PPD VERSION is now derived from the VERSION variable in the Makefile
+      rather than hard coded.
+
+
+6.61_01  Sat Sep 24 22:16:13 PDT 2011
     Win32
     * Liblist::Kid now checks the ActiveState MinGW library path environment
       variable [MITHALDU]

diff --git a/lib/ExtUtils/MM_Any.pm b/lib/ExtUtils/MM_Any.pm
@@ -206,14 +206,18 @@ sub _expand_macros {
 
     my @commands = $MM->echo($text);
     my @commands = $MM->echo($text, $file);
-    my @commands = $MM->echo($text, $file, $appending);
+    my @commands = $MM->echo($text, $file, \%opts);
 
 Generates a set of @commands which print the $text to a $file.
 
 If $file is not given, output goes to STDOUT.
 
-If $appending is true the $file will be appended to rather than
-overwritten.
+If $opts{append} is true the $file will be appended to rather than
+overwritten.  Default is to overwrite.
+
+If $opts{allow_variables} is true, make variables of the form
+C<$(...)> will not be escaped.  Other C<$> will.  Default is to escape
+all C<$>.
 
 Example of use:
 
@@ -222,13 +226,20 @@ Example of use:
 =cut
 
 sub echo {
-    my($self, $text, $file, $appending) = @_;
-    $appending ||= 0;
+    my($self, $text, $file, $opts) = @_;
+
+    # Compatibility with old options
+    if( !ref $opts ) {
+        my $append = $opts;
+        $opts = { append => $append || 0 };
+    }
+    $opts->{allow_variables} = 0 unless defined $opts->{allow_variables};
 
-    my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_) } 
+    my $ql_opts = { allow_variables => $opts->{allow_variables} };
+    my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) } 
                split /\n/, $text;
     if( $file ) {
-        my $redirect = $appending ? '>>' : '>';
+        my $redirect = $opts->{append} ? '>>' : '>';
         $cmds[0] .= " $redirect $file";
         $_ .= " >> $file" foreach @cmds[1..$#cmds];
     }
@@ -338,12 +349,16 @@ to include more flexible code and switches.
 =head3 quote_literal  I<Abstract>
 
     my $safe_text = $MM->quote_literal($text);
+    my $safe_text = $MM->quote_literal($text, \%options);
 
 This will quote $text so it is interpreted literally in the shell.
 
 For example, on Unix this would escape any single-quotes in $text and
 put single-quotes around the whole thing.
 
+If $options{allow_variables} is true it will leave C<'$(FOO)'> make
+variables untouched.  If false they will be escaped like any other
+C<$>.  Defaults to true.
 
 =head3 escape_dollarsigns
 
@@ -365,6 +380,24 @@ sub escape_dollarsigns {
 }
 
 
+=head3 escape_all_dollarsigns
+
+    my $escaped_text = $MM->escape_all_dollarsigns($text);
+
+Escapes all C<$> so they are not interpreted as make variables.
+
+=cut
+
+sub escape_all_dollarsigns {
+    my($self, $text) = @_;
+
+    # Escape dollar signs
+    $text =~ s{\$}{\$\$}gx;
+
+    return $text;
+}
+
+
 =head3 escape_newlines  I<Abstract>
 
     my $escaped_text = $MM->escape_newlines($text);

diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
@@ -2892,8 +2892,13 @@ sub ppd {
     $author =~ s/</&lt;/g;
     $author =~ s/>/&gt;/g;
 
-    my $ppd_xml = sprintf <<'PPD_HTML', $self->{VERSION}, $abstract, $author;
-<SOFTPKG NAME="$(DISTNAME)" VERSION="%s">
+    my $ppd_file = '$(DISTNAME).ppd';
+
+    my @ppd_cmds = $self->echo(<<'PPD_HTML', $ppd_file, { append => 0, allow_variables => 1 });
+<SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">
+PPD_HTML
+
+    my $ppd_xml = sprintf <<'PPD_HTML', $abstract, $author;
     <ABSTRACT>%s</ABSTRACT>
     <AUTHOR>%s</AUTHOR>
 PPD_HTML
@@ -2955,7 +2960,7 @@ PPD_OUT
 </SOFTPKG>
 PPD_XML
 
-    my @ppd_cmds = $self->echo($ppd_xml, '$(DISTNAME).ppd');
+    push @ppd_cmds, $self->echo($ppd_xml, $ppd_file, { append => 1 });
 
     return sprintf <<'PPD_OUT', join "\n\t", @ppd_cmds;
 # Creates a PPD (Perl Package Description) for a binary distribution.
@@ -3146,12 +3151,14 @@ sub oneliner {
 =cut
 
 sub quote_literal {
-    my($self, $text) = @_;
+    my($self, $text, $opts) = @_;
+    $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
 
     # Quote single quotes
     $text =~ s{'}{'\\''}g;
 
-    $text = $self->escape_dollarsigns($text);
+    $text = $opts->{allow_variables}
+      ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
 
     return "'$text'";
 }

diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
@@ -1789,12 +1789,14 @@ sub echo {
 =cut
 
 sub quote_literal {
-    my($self, $text) = @_;
+    my($self, $text, $opts) = @_;
+    $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
 
     # I believe this is all we should need.
     $text =~ s{"}{""}g;
 
-    $text = $self->escape_dollarsigns($text);
+    $text = $opts->{allow_variables}
+      ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
 
     return qq{"$text"};
 }

diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm
@@ -496,7 +496,8 @@ sub oneliner {
 
 
 sub quote_literal {
-    my($self, $text) = @_;
+    my($self, $text, $opts) = @_;
+    $opts->{allow_variables} = 1 unless defined $opts->{allow_variables};
 
     # See: http://www.autohotkey.net/~deleyd/parameters/parameters.htm#CPP
 
@@ -519,7 +520,8 @@ sub quote_literal {
         $text =~ s/}/}}/g;
     }
 
-    $text = $self->escape_dollarsigns($text);
+    $text = $opts->{allow_variables}
+      ? $self->escape_dollarsigns($text) : $self->escape_all_dollarsigns($text);
 
     return $text;
 }

diff --git a/t/basic.t b/t/basic.t
@@ -82,7 +82,7 @@ close PPD;
 like( $ppd_html, qr{^<SOFTPKG NAME="Big-Dummy" VERSION="0.01">}m, 
                                                            '  <SOFTPKG>' );
 like( $ppd_html,
-      qr{^\s*<ABSTRACT>Try "our" hot dog's and \$andwiche\$</ABSTRACT>}m,
+      qr{^\s*<ABSTRACT>Try "our" hot dog's, \$andwiche\$ and \$\(ub\)\$!</ABSTRACT>}m,
                                                            '  <ABSTRACT>');
 like( $ppd_html, 
       qr{^\s*<AUTHOR>Michael G Schwern &lt;schwern\@pobox.com&gt;</AUTHOR>}m,
@@ -279,7 +279,7 @@ note "META file validity"; {
       };
       $is->( name => "Big-Dummy" );
       $is->( version => "0.01" );
-      $is->( abstract => q{Try "our" hot dog's and $andwiche$} );
+      $is->( abstract => q{Try "our" hot dog's, $andwiche$ and $(ub)$!} );
       $is_list->( licenses => [q{unknown}] );
       $is_list->( authors => [ q{Michael G Schwern <schwern@pobox.com>} ] );
       $is_map->( prereqs => {

diff --git a/t/echo.t b/t/echo.t
@@ -14,39 +14,45 @@ use MakeMaker::Test::Utils;
 use File::Temp;
 use Cwd 'abs_path';
 
-my $Is_VMS   = $^O eq 'VMS';
-my $Is_Win32 = $^O eq 'MSWin32';
-
 use Test::More;
 
-# Setup
+
+#--------------------- Setup
+
 my $cwd  = abs_path;
 my $perl = which_perl;
 my $make = make_run();
 my $mm = bless { NAME => "Foo", MAKE => $Config{make} }, "MM";
 $mm->init_tools;  # need ECHO
 
 
-# Testing functions
+#------------------- Testing functions
+
 sub test_for_echo {
-    my($args, $want, $name) = @_;
-    my $output_file = $args->[1];
+    my($calls, $want, $name) = @_;
+    my $output_file = $calls->[0][1];
 
     note "Testing $name";
 
     my $dir = File::Temp->newdir();
     chdir $dir;
     note "Temp dir: $dir";
 
+    # Write a Makefile to test the output of echo
     {
         open my $makefh, ">", "Makefile" or croak "Can't open Makefile: $!";
+        print $makefh "FOO=42\n";       # a variable to test with
         print $makefh "ECHO=$mm->{ECHO}\n\n";
         print $makefh "all:\n";
-        print $makefh map { "\t".$_ } $mm->echo(@$args);
+        for my $args (@$calls) {
+            print $makefh map { "\t$_\n" } $mm->echo(@$args);
+        }
     }
 
+    # Run the Makefile
     ok run($make), "make: $name";
 
+    # Check it made the file in question
     ok -e $output_file, "$output_file exists";
     open my $fh, "<", $output_file or croak "Can't open $output_file: $!";
     is join("", <$fh>), $want, "contents";
@@ -55,10 +61,46 @@ sub test_for_echo {
 }
 
 
-# Tests begin
+#---------------- Tests begin
+
 test_for_echo(
-    ["Foo", "bar.txt"], "Foo\n", "simple echo"
+    [["Foo", "bar.txt"]],
+    "Foo\n",
+    "simple echo"
 );
 
+test_for_echo(
+    [["Foo\nBar\nBaz Biff\n", "something.txt"]],
+    "Foo\nBar\nBaz Biff\n",
+    "multiline echo"
+);
+
+test_for_echo(
+    [['$something$', "something.txt"]],
+    '$something$'."\n",
+    "dollar signs escaped"
+);
+
+test_for_echo(
+    [['$(something)', "something.txt"]],
+    '$(something)'."\n",
+    "variables escaped"
+);
+
+test_for_echo(
+    [['Answer: $(FOO)', "bar.txt", { allow_variables => 1 }]],
+    "Answer: 42\n",
+    "allow_variables"
+);
+
+test_for_echo(
+    [
+        ["Foo", "bar.txt"],
+        ["Bar", "bar.txt", { append => 1 }],
+        ["Baz", "bar.txt", 1],
+    ],
+    "Foo\nBar\nBaz\n",
+    "append"
+);
 
 done_testing;
diff --git a/t/lib/MakeMaker/Test/Setup/BFD.pm b/t/lib/MakeMaker/Test/Setup/BFD.pm
@@ -19,7 +19,7 @@ $VERSION = 0.01;
 
 =head1 NAME
 
-Big::Dummy - Try "our" hot dog's and $andwiche$
+Big::Dummy - Try "our" hot dog's, $andwiche$ and $(ub)$!
 
 =cut