From @cowens

0001-adds-P-N-switches-that-use-instead-of.patch

From 655a89bc9672892b287cfe9c519633405c6c61cb Mon Sep 17 00:00:00 2001
From: "Chas. Owens" <chas.owens@gmail.com>
Date: Sat, 24 Jun 2017 22:52:42 -0400
Subject: [PATCH] adds -P & -N switches that use <<>> instead of <>

The -n and -p switches use the two argument version of open.
This can lead to a security issue if a file is named starting
with > or |.  The <<>> operator fixes the security issue, but
isn't easily available to commandline perl.  This patch adds
-N and -P flags that work like -n and -p, but use <<>> instead
of <>.
---
 MANIFEST             |  3 ++
 embedvar.h           |  2 ++
 intrpvar.h           |  2 ++
 perl.c               | 14 ++++++++++
 pod/perldelta.pod    |  9 ++++++
 pod/perlrun.pod      | 41 +++++++++++++++++++++++++--
 sv.c                 |  2 ++
 t/run/switches.t     |  4 +--
 t/run/switchloop.t   | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 t/run/switchn_safe.t | 22 +++++++++++++++
 t/run/switchp_safe.t | 19 +++++++++++++
 toke.c               | 21 +++++++++-----
 12 files changed, 207 insertions(+), 11 deletions(-)
 create mode 100644 t/run/switchloop.t
 create mode 100644 t/run/switchn_safe.t
 create mode 100644 t/run/switchp_safe.t

diff --git a/MANIFEST b/MANIFEST
index 795a991..871069a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5869,9 +5869,12 @@ t/run/switchF.t			Test the -F switch
 t/run/switchF1.t		Pathological tests for the -F switch
 t/run/switchF2.t		Pathological tests for the -F switch
 t/run/switchI.t			Test the -I switch
+t/run/switchloop.t		Test the -F, -N, P, -a, -n, and -p switch interactions
 t/run/switchM.t			Test the -M switch
 t/run/switchn.t			Test the -n switch
+t/run/switchn_safe.t		Test the -N switch
 t/run/switchp.t			Test the -p switch
+t/run/switchp_safe.t		Test the -P switch
 t/run/switcht.t			Test the -t switch
 t/run/switchx.aux		Data for switchx.t
 t/run/switchx.t			Test the -x switch
diff --git a/embedvar.h b/embedvar.h
index 1e3f9a2..4fb8c41 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -203,6 +203,8 @@
 #define PL_min_intro_pending	(vTHX->Imin_intro_pending)
 #define PL_minus_E		(vTHX->Iminus_E)
 #define PL_minus_F		(vTHX->Iminus_F)
+#define PL_minus_N		(vTHX->Iminus_N)
+#define PL_minus_P		(vTHX->Iminus_P)
 #define PL_minus_a		(vTHX->Iminus_a)
 #define PL_minus_c		(vTHX->Iminus_c)
 #define PL_minus_l		(vTHX->Iminus_l)
diff --git a/intrpvar.h b/intrpvar.h
index c6070ea..05d44c9 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -341,6 +341,8 @@ PERLVAR(I, localpatches, const char * const *)
 PERLVARI(I, splitstr,	const char *, " ")
 
 PERLVAR(I, minus_c,	bool)
+PERLVAR(I, minus_N,	bool)
+PERLVAR(I, minus_P,	bool)
 PERLVAR(I, minus_n,	bool)
 PERLVAR(I, minus_p,	bool)
 PERLVAR(I, minus_l,	bool)
diff --git a/perl.c b/perl.c
index d7b0866..24e521d 100644
--- a/perl.c
+++ b/perl.c
@@ -979,6 +979,8 @@ perl_destruct(pTHXx)
     /* switches */
     PL_minus_n      = FALSE;
     PL_minus_p      = FALSE;
+    PL_minus_N      = FALSE;
+    PL_minus_P      = FALSE;
     PL_minus_l      = FALSE;
     PL_minus_a      = FALSE;
     PL_minus_F      = FALSE;
@@ -1976,8 +1978,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	case 'l':
 	case 'M':
 	case 'm':
+	case 'N':
 	case 'n':
 	case 'p':
+	case 'P':
 	case 's':
 	case 'u':
 	case 'U':
@@ -3117,6 +3121,8 @@ S_usage(pTHX)		/* XXX move this out into a module ? */
 "  -Idirectory       specify @INC/#include directory (several -I's allowed)\n",
 "  -l[octal]         enable line ending processing, specifies line terminator\n"
 "  -[mM][-]module    execute \"use/no module...\" before executing program\n"
+"  -N                assume \"while (<<>>) { ... }\" loop around program\n"
+"  -P                assume loop like -N but print line also\n"
 "  -n                assume \"while (<>) { ... }\" loop around program\n"
 "  -p                assume loop like -n but print line also, like sed\n"
 "  -s                enable rudimentary parsing for switches after programfile\n"
@@ -3483,6 +3489,14 @@ Perl_moreswitches(pTHX_ const char *s)
 	PL_minus_p = TRUE;
 	s++;
 	return s;
+    case 'N':
+	PL_minus_N = TRUE;
+	s++;
+	return s;
+    case 'P':
+	PL_minus_P = TRUE;
+	s++;
+	return s;
     case 's':
 	forbid_setid('s', FALSE);
 	PL_doswitches = TRUE;
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 0f64fc8..190d967 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -32,6 +32,15 @@ here, but most should go in the L</Performance Enhancements> section.
 A list of changes is at
 L<http://www.unicode.org/versions/Unicode10.0.0>.
 
+=head2 Two new commandline switches: -N and -P
+
+The B<-n> and B<-p> switches use B<readline> which uses the two argument
+version of B<open> which has a security flaw (it will run a program if it
+sees a file whose name starts with |).  The B<< <<>> >> operator does not
+have this issue, but was not available from simply from the commandline.
+The B<-N> and B<-P> operators behave the same as B<-n> and B<-p>, but use
+B<< <<>> >> instead of B<readline>.
+
 =head1 Security
 
 XXX Any security-related notices go here.  In particular, any security
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index f32c8ed..7920ce9 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -7,7 +7,7 @@ perlrun - how to execute the Perl interpreter
 B<perl>	S<[ B<-sTtuUWX> ]>
 	S<[ B<-hv> ] [ B<-V>[:I<configvar>] ]>
 	S<[ B<-cw> ] [ B<-d>[B<t>][:I<debugger>] ] [ B<-D>[I<number/list>] ]>
-	S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal/hexadecimal>] ]>
+	S<[ B<-PNpna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal/hexadecimal>] ]>
 	S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]>
 	S<[ B<-C [I<number/list>] >]>
 	S<[ B<-S> ]>
@@ -684,6 +684,22 @@ A consequence of this is that B<-MI<MODULE>=number> never does a version check,
 unless C<I<MODULE>::import()> itself is set up to do a version check, which
 could happen for example if I<MODULE> inherits from L<Exporter>.
 
+=item B<-N>
+X<-N>
+
+causes Perl to assume the following loop around your program, which
+makes it iterate over filename arguments in a fashion similar to,
+but safer than B<-n> (documented below):
+
+  LINE:
+    while (<<>>) {
+	...		# your program goes here
+    }
+
+Note that the lines are not printed by default.  See L</-P> to have
+lines printed.  If a file named by an argument cannot be opened for
+some reason, Perl warns you about it and moves on to the next file.
+
 =item B<-n>
 X<-n>
 
@@ -718,6 +734,27 @@ you can fix if you follow the example under B<-0>.
 C<BEGIN> and C<END> blocks may be used to capture control before or after
 the implicit program loop, just as in I<awk>.
 
+=item B<-P>
+X<-P>
+
+causes Perl to assume the following loop around your program, which
+makes it iterate over filename arguments in a fashion similar to,
+but safer than B<-p> (documented below):
+
+
+  LINE:
+    while (<<>>) {
+	...		# your program goes here
+    } continue {
+	print or die "-p destination: $!\n";
+    }
+
+If a file named by an argument cannot be opened for some reason, Perl
+warns you about it, and moves on to the next file.  Note that the
+lines are printed automatically.  An error occurring during printing is
+treated as fatal.  To suppress printing use the B<-N> switch.  A B<-P>
+overrides a B<-N> or B<-n> switch.
+
 =item B<-p>
 X<-p>
 
@@ -736,7 +773,7 @@ If a file named by an argument cannot be opened for some reason, Perl
 warns you about it, and moves on to the next file.  Note that the
 lines are printed automatically.  An error occurring during printing is
 treated as fatal.  To suppress printing use the B<-n> switch.  A B<-p>
-overrides a B<-n> switch.
+overrides a B<-n> or B<-N> switch.
 
 C<BEGIN> and C<END> blocks may be used to capture control before or after
 the implicit loop, just as in I<awk>.
diff --git a/sv.c b/sv.c
index 4576f9c..8d2f94a 100644
--- a/sv.c
+++ b/sv.c
@@ -15186,6 +15186,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_splitstr		= proto_perl->Isplitstr;
     PL_minus_n		= proto_perl->Iminus_n;
     PL_minus_p		= proto_perl->Iminus_p;
+    PL_minus_N		= proto_perl->Iminus_N;
+    PL_minus_P		= proto_perl->Iminus_P;
     PL_minus_l		= proto_perl->Iminus_l;
     PL_minus_a		= proto_perl->Iminus_a;
     PL_minus_E		= proto_perl->Iminus_E;
diff --git a/t/run/switches.t b/t/run/switches.t
index b61be56..b45c650 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -12,7 +12,7 @@ BEGIN {
 
 BEGIN { require "./test.pl";  require "./loc_tools.pl"; }
 
-plan(tests => 115);
+plan(tests => 111);
 
 use Config;
 
@@ -322,7 +322,7 @@ is runperl(stderr => 1, prog => '#!perl -M'),
 
 # Tests for switches which do not exist
 
-foreach my $switch (split //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_")
+foreach my $switch (split //, "ABbGgHJjKkLOoQqRrYyZz123456789_")
 {
     local $TODO = '';   # these ones should work on VMS
 
diff --git a/t/run/switchloop.t b/t/run/switchloop.t
new file mode 100644
index 0000000..7a338c6
--- /dev/null
+++ b/t/run/switchloop.t
@@ -0,0 +1,79 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+use strict;
+
+require './test.pl';
+
+# test the interaction of -F, -a, -n, -p, -N, and -P
+
+sub result {
+	my @flags = split //, shift;
+	my $has_N = grep { /N/ } @flags;
+	my $has_P = grep { /P/ } @flags;
+	my $has_p = grep { /p/ } @flags;
+	my $has_a = grep { /[Fa]/ } @flags;
+	my $has_F = grep { /F/ } @flags;
+
+	my $while = $has_P || ($has_N && !$has_p)
+		? 'LINE: while (defined($_ = <<>>)) {'
+		: 'LINE: while (defined($_ = readline ARGV)) {';
+
+	my $zero = "    '???';";
+
+	my $body = $has_F ? q{    our @F = split(/,/, $_, 0);} . "\n"
+		 : $has_a ? q{    our @F = split(' ', $_, 0);} . "\n"
+		 :          "";
+
+	my $while_end = $has_P || $has_p
+		? qq/}\ncontinue {\n    die "-p destination: \$!\\n" unless print \$_;\n}/
+		: "}";
+
+	return "-e syntax OK\n$while\n$body$zero\n$while_end\n";
+}
+
+# XXX this is probably not comprehensive,
+# but I think it covers the important interactions
+my %tests = (
+    pn  => ["-MO=Deparse", "-e0", "-p"],
+    np  => ["-MO=Deparse", "-e0", "-p"],
+    p   => ["-MO=Deparse", "-e0", "-p"],
+    n   => ["-MO=Deparse", "-e0", "-n"],
+    a   => ["-MO=Deparse", "-e0", "-a"],
+    an  => ["-MO=Deparse", "-e0", "-an"],
+    na  => ["-MO=Deparse", "-e0", "-na"],
+    ap  => ["-MO=Deparse", "-e0", "-ap"],
+    pa  => ["-MO=Deparse", "-e0", "-pa"],
+    F   => ["-MO=Deparse", "-e0", "-F,"],
+    Fa  => ["-MO=Deparse", "-e0", "-F,", "-a"],
+    Fan => ["-MO=Deparse", "-e0", "-F,", "-an"],
+    Fp  => ["-MO=Deparse", "-e0", "-F,", "-p"],
+    Fpa => ["-MO=Deparse", "-e0", "-F,", "-pa"],
+    aF  => ["-MO=Deparse", "-e0", "-a", "-F,"],
+    PN  => ["-MO=Deparse", "-e0", "-PN"],
+    NP  => ["-MO=Deparse", "-e0", "-NP"],
+    pN  => ["-MO=Deparse", "-e0", "-pN"],
+    Np  => ["-MO=Deparse", "-e0", "-Np"],
+    Pn  => ["-MO=Deparse", "-e0", "-Pn"],
+    nP  => ["-MO=Deparse", "-e0", "-nP"],
+    P   => ["-MO=Deparse", "-e0", "-P"],
+    N   => ["-MO=Deparse", "-e0", "-N"],
+    aN  => ["-MO=Deparse", "-e0", "-aN"],
+    Na  => ["-MO=Deparse", "-e0", "-Na"],
+    aP  => ["-MO=Deparse", "-e0", "-aP"],
+    Pa  => ["-MO=Deparse", "-e0", "-Pa"],
+    FaN => ["-MO=Deparse", "-e0", "-F,", "-aN"],
+    FP  => ["-MO=Deparse", "-e0", "-F,", "-P"],
+    FPa => ["-MO=Deparse", "-e0", "-F,", "-Pa"],
+);
+
+plan(scalar keys %tests);
+
+for my $flags (keys %tests) {
+	my $result = result($flags);
+	ok(runperl(switches => $tests{$flags}, stderr => 1) eq $result,
+	    "testing $flags flags");
+}
diff --git a/t/run/switchn_safe.t b/t/run/switchn_safe.t
new file mode 100644
index 0000000..545c8b6
--- /dev/null
+++ b/t/run/switchn_safe.t
@@ -0,0 +1,22 @@
+#!./perl -N
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+    $file = '|safe_argv.tmp';
+    open(TRY, '>', $file) || (die "Can't open temp file: $!");
+    print TRY "ok 1\nok 2\n";
+    close TRY or die "Could not close: $!";
+    @ARGV = ($file);
+    plan(tests => 3);
+}
+
+END {
+    pass("Final test");
+}
+
+chomp;
+is("ok ".$., $_, "Checking line $.");
+
+s/^/not /;
diff --git a/t/run/switchp_safe.t b/t/run/switchp_safe.t
new file mode 100644
index 0000000..1ec6224
--- /dev/null
+++ b/t/run/switchp_safe.t
@@ -0,0 +1,19 @@
+#!./perl -P
+
+# This test file does not use test.pl because of the involved way in which it
+# generates its TAP output.
+
+BEGIN {
+    print "1..3\n";
+    $file = '|safe_argv.tmp';
+    open(TRY, '>', $file) || (die "Can't open temp file: $!");
+    print TRY "not ok 1 - -p 1st iteration\nnot ok 2 - -p 2nd iteration\n";
+    close TRY or die "Could not close: $!";
+    @ARGV = ($file);
+}
+
+END {
+    print "ok 3 - -p switch tested\n";
+}
+
+s/^not //;
diff --git a/toke.c b/toke.c
index 0dcf623..7fe1e1d 100644
--- a/toke.c
+++ b/toke.c
@@ -1367,13 +1367,13 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
 	    (void)PerlIO_close(PL_parser->rsfp);
 	PL_parser->rsfp = NULL;
 	PL_parser->in_pod = PL_parser->filtered = 0;
-	if (!PL_in_eval && PL_minus_p) {
+	if (!PL_in_eval && (PL_minus_p || PL_minus_P)) {
 	    sv_catpvs(linestr,
 		/*{*/";}continue{print or die qq(-p destination: $!\\n);}");
-	    PL_minus_n = PL_minus_p = 0;
-	} else if (!PL_in_eval && PL_minus_n) {
+	    PL_minus_n = PL_minus_p = PL_minus_N = PL_minus_P = 0;
+	} else if (!PL_in_eval && (PL_minus_n || PL_minus_N)) {
 	    sv_catpvs(linestr, /*{*/";}");
-	    PL_minus_n = 0;
+	    PL_minus_n = PL_minus_N = 0;
 	} else
 	    sv_catpvs(linestr, ";");
 	got_some = 1;
@@ -5226,8 +5226,12 @@ Perl_yylex(pTHX)
 	    if (PL_minus_E)
 		sv_catpvs(PL_linestr,
 			  "use feature ':5." STRINGIFY(PERL_VERSION) "';");
-	    if (PL_minus_n || PL_minus_p) {
-		sv_catpvs(PL_linestr, "LINE: while (<>) {"/*}*/);
+	    if (PL_minus_n || PL_minus_p || PL_minus_N || PL_minus_P) {
+		if ((PL_minus_N || PL_minus_P) && !PL_minus_p) {
+		    sv_catpvs(PL_linestr, "LINE: while (<<>>) {"/*}*/);
+		} else {
+		    sv_catpvs(PL_linestr, "LINE: while (<>) {"/*}*/);
+		}
 		if (PL_minus_l)
 		    sv_catpvs(PL_linestr,"chomp;");
 		if (PL_minus_a) {
@@ -5467,6 +5471,8 @@ Perl_yylex(pTHX)
 			const U32 oldpdb = PL_perldb;
 			const bool oldn = PL_minus_n;
 			const bool oldp = PL_minus_p;
+			const bool oldN = PL_minus_N;
+			const bool oldP = PL_minus_P;
 			const char *d1 = d;
 
 			do {
@@ -5495,7 +5501,8 @@ Perl_yylex(pTHX)
 			    init_argv_symbols(argc,argv);
 			}
 			if (   (PERLDB_LINE_OR_SAVESRC && !oldpdb)
-                            || ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
+                            || ((PL_minus_n || PL_minus_p || PL_minus_N || PL_minus_P)
+                            && !(oldn || oldp || oldN || oldP)))
 			      /* if we have already added "LINE: while (<>) {",
 			         we must not do it again */
 			{
-- 
2.10.1 (Apple Git-78)

Add -P and -N switches that use <<>> instead of readline #16043

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions