Add -P and -N switches that use <<>> instead of readline #16043
Comments
From @cowensCreated by @cowensThe -n and -p switches use the two argument version of open. This is a It also adds a test of the interactions amongst -F, -N, -P, -a, Perl Info |
From @cowens0001-adds-P-N-switches-that-use-instead-of.patchFrom 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)
|
From @jkeenanOn Sun, 25 Jun 2017 09:48:06 GMT, cowens wrote:
Since this requests a significant change, I have made the patch available for smoke-testing in the smoke-me/jkeenan/cowens/131651-P-N-switches branch. Thank you very much. -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @xsawyerxI think this is a good idea, but it takes two letters, and when we talk Perhaps we should provide a flag that turns on double diamond on other It would be great if -E could do that, but that will likely break stuff. :/ On 06/25/2017 02:48 AM, Chas Owens (via RT) wrote:
|
From @cowensHow about -g for good? Or -z for zafe? On Tue, Jun 27, 2017, 17:32 Sawyer X <xsawyerx@gmail.com> wrote:
|
From @cowensAlso, what about an environment variable to make it the default? If so, On Tue, Jun 27, 2017, 18:12 Chas. Owens <chas.owens@gmail.com> wrote:
|
From @cowensHmm, another option: -N (implies -n) uses <<>> instead of readline That at least makes sense from a mnemonic point of view. On Tue, Jun 27, 2017 at 6:16 PM Chas. Owens <chas.owens@gmail.com> wrote:
|
From @cpansproutOn Tue, 27 Jun 2017 14:31:50 -0700, xsawyerx@gmail.com wrote:
Proposals for new command-line switches (as opposed to regexp flags) are generally few and far between.
The -N and -P options initially proposed are the clearest, I think. And I do think clarity is important, at least sometimes. (Even though I program in Perl.)
If -E meant ‘turn on whatever you want on,’ then it would have to read people’s minds. I guess you could implement such an -E with neural networks, and then it would be as good as random.
I just want to clarify that the security issue is mainly when the file name comes from some untrusted source, from someone who does not have the ability to execute arbitrary code. If someone already has access to a command line, then it is more about surprises than security. but
I have not had (and do not have) time to read the patch, but I think the idea is good. -- Father Chrysostomos |
From @cpansproutIn case it is not clear, parts of my previous message were intended to be risible. On Tue, 27 Jun 2017 16:10:41 -0700, sprout wrote:
-- Father Chrysostomos |
From @LeontOn Tue, Jun 27, 2017 at 11:31 PM, Sawyer X <xsawyerx@gmail.com> wrote:
Capital letters are still quite available. I mean, currently only C, D, E, Leon |
From @xsawyerxOn 06/27/2017 04:29 PM, Leon Timmermans wrote:
I had plans for half of them already, Leon. Kidding. |
From @xsawyerxOn 06/27/2017 04:10 PM, Father Chrysostomos via RT wrote:
Fair enough.
Good point. Let's go with that.
I meant the user telling us we can turn on whatever we wanted. It could
Thank you for adding that. |
From @cowensOn Tue, Jun 27, 2017, 19:46 Sawyer X <xsawyerx@gmail.com> wrote:
File names aren't necessarily safe: $ tar xvfz somecode.tgz If somecode.tgz had a file named "|rm -rf /home" then you are very unhappy. |
From zefram@fysh.orgChas. Owens wrote:
No, no, no. Also, no. The validity and meaning of a program (in this -zefram |
From @maukeAm 28.06.2017 um 02:07 schrieb Chas. Owens:
You can't have / in a filename, so it's impossible for * to expand to -- |
From @cowensWhere does this stand? Is it desirable to have a patch that implements LINE: while (defined($_ = <<ARGV>>)) { and -Np is LINE: while (defined($_ = <<ARGV>>)) { On Sun, Jul 2, 2017 at 4:55 AM Lukas Mai via RT <perlbug-followup@perl.org>
|
From @xsawyerxWhy just -N? I think there are no objections left for -N or -P. On 07/26/2017 05:26 PM, Chas. Owens wrote:
|
|
I agree with -N and -P for reasons stated above. There does not seem to be any great rush to use up the remaining switches. I will create a PR implementing the original proposed patch. |
|
The patch does not apply cleanly to blead currently. @cowens can you provide a new patch or open a PR? |
|
I'll take a look this weekend |
|
How does this address the problem: [ https://github.com/MasterInQuestion/perlp ]? |
Migrated from rt.perl.org#131651 (status was 'open')
Searchable as RT131651$
The text was updated successfully, but these errors were encountered: