Front page | perl.perl5.changes |
Postings from February 2012
[perl.git] branch smoke-me/kick-FAKE_BIT_BUCKET, updated. v5.15.8-57-g855e92e
From:
Nicholas Clark
Date:
February 27, 2012 06:55
Subject:
[perl.git] branch smoke-me/kick-FAKE_BIT_BUCKET, updated. v5.15.8-57-g855e92e
Message ID:
E1S21zL-0005Kw-3W@camel.ams6.corp.booking.com
In perl.git, the branch smoke-me/kick-FAKE_BIT_BUCKET has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/855e92ec3d7a5fbbd8897cf24982e6a4e641ac2f?hp=55d3f3e53492b8cc2dcf2c5ff35f6b379b1685e8>
- Log -----------------------------------------------------------------
commit 855e92ec3d7a5fbbd8897cf24982e6a4e641ac2f
Author: Nicholas Clark <nick@ccl4.org>
Date: Mon Feb 27 15:21:38 2012 +0100
In perl.c, only compile S_forbid_setid() if it's needed.
If SETUID_SCRIPTS_ARE_SECURE_NOW is defined, S_forbid_setid() is a no-op,
so don't compile it. Move the declaration and definition of S_forbid_setid()
into the same pre-processor blocks as are used for S_validate_suid(), which
is a no-op when SETUID_SCRIPTS_ARE_SECURE_NOW is /not/ defined.
M embed.fnc
M embed.h
M perl.c
M proto.h
commit 22db19a2f6698ee73693715d30ccc569261987b8
Author: Nicholas Clark <nick@ccl4.org>
Date: Mon Feb 27 14:53:24 2012 +0100
Inline the "program input from stdin" check into S_open_script().
This removes the special case code for this from S_forbid_setid(), leaving
it dealing only with checking on -x options. For both locations, refactor the
croak() logic to share the same message format string.
M perl.c
commit 852f8df46d9ee17615b74b9e3163196ccf7a6446
Author: Nicholas Clark <nick@ccl4.org>
Date: Sun Feb 26 19:40:19 2012 +0100
Eliminate the suidscript parameter from S_forbid_setid() - it's always false.
M embed.fnc
M embed.h
M perl.c
M proto.h
commit 660ca6d02943bc1ab354d1de3b3a9c3ca38927bd
Author: Nicholas Clark <nick@ccl4.org>
Date: Sun Feb 26 17:22:17 2012 +0100
Pass doextract to S_open_script(), signaling whether -x is enabled.
Inline the suidscript is true part of the forbid_setid() test for 'x' in the
fdopen branch of S_open_script(). This means that for all callers of
forbid_setid(), the parameter suidscript is false.
M embed.fnc
M embed.h
M perl.c
M proto.h
commit f32b9b3a6ec0762e30c3f3a2b62130cfb2dcf10e
Author: Nicholas Clark <nick@ccl4.org>
Date: Sun Feb 26 16:50:25 2012 +0100
Normalise two error messages in S_open_script() to have trailing periods.
All the other fatal errors generated by switch parsing and script opening
don't pass a trailing "\n" to Perl_croak(), resulting in output with a
trailing period. (And no filename or line number, as these are not set yet.)
M perl.c
M t/run/fdopen.t
commit 5720db1f88aa6cc9147e21f5fbd58ce272bb8d30
Author: Nicholas Clark <nick@ccl4.org>
Date: Sun Feb 26 16:34:00 2012 +0100
Add t/run/fdopen.t, which tests the /dev/fd/\d+ code for opening scripts.
perl uses S_open_script() in perl.c to open the file handle on the Perl
program. In 5.003 this was enhanced to parse filenames such as /dev/fd/3
(directly using fdopen() to open file descriptor 3), as part of a suidperl
fix. It was subsequently further enhanced to permit $0 to be set by
suffixing the /dev/fd/\d+ with the file name to use.
Although suidperl was removed from the core by commit cc69b689ee7c2745 in
Jan 2009, this code remained, as it's a useful feature for anyone wishing
to maintain suidperl externally, or write an alternative secure wrapper
system.
M MANIFEST
M pod/perldelta.pod
A t/run/fdopen.t
commit 446debee14b9ea24ebc47a8bff4318a85efce422
Author: Nicholas Clark <nick@ccl4.org>
Date: Sun Feb 26 00:50:23 2012 +0100
In S_open_script(), avoid setting scriptname to "" to benefit one if() test.
If PL_origfilename is "-" then scriptname was being set to "". However, the
only thing then depending on the value of scriptname was an if() test 4
lines later. Hence simply augment that if test with the check for "-",
avoiding the need for an assignment.
M perl.c
commit 7f362ff2e5b915d2d783029c31fcff125f8eecc5
Author: Nicholas Clark <nick@ccl4.org>
Date: Sun Feb 26 00:37:47 2012 +0100
Add 2 assertions to S_open_script().
If *suidscript is TRUE, then fdscript has to be >= 0;
If we're defaulting to reading from stdin, then *suidscript has to be FALSE.
Knowing that these both hold will permit simplification of the code.
M perl.c
commit 3d6fedc291bd18aaab65adf879877fbd9b2af434
Author: Nicholas Clark <nick@ccl4.org>
Date: Sun Feb 26 00:22:41 2012 +0100
In S_parse_body(), don't "leak" linestr_sv until global destruction.
This commit ensures that linestr_sv is properly cleaned up, if allocated.
The local variable linestr_sv was added by commit 009d90df4e17a415 in 2007,
to replace use of PL_linestr in S_parse_body(). However, that commit didn't
add any code to free linestr_sv at the end of S_parse_body(), meaning that
the SV sticks around until global destruction.
Subsequent code simplification possible by the removal of suidperl reveals
that linestr_sv is only needed for the '-x' option, so it's safe to avoid
allocating it up front. Additionally, during '-x' processing, Perl_sv_gets()
will upgrade the target SV to SVt_PV and allocate the string buffer as needed,
so there's no need to pre-upgrade or pre-allocate the SV in S_parse_body().
This slightly reduces the amount of code.
M perl.c
commit 6947d223ce21ef628bf1fca33e8dcc78a753a908
Author: Nicholas Clark <nick@ccl4.org>
Date: Sat Feb 25 23:50:49 2012 +0100
Remove all the never used parameters from the macro validate_suid()
Several parameters are unused in either remaining variant of the
validate_suid() macro. The two variants which used the extra parameters
were removed with suidperl by commit cc69b689ee7c2745 in Jan 2009.
M perl.c
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
embed.fnc | 3 +-
embed.h | 1 -
perl.c | 119 +++++++++++++++++++++++++---------------------------
pod/perldelta.pod | 5 ++
proto.h | 8 +--
t/run/fdopen.t | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++
7 files changed, 180 insertions(+), 70 deletions(-)
create mode 100644 t/run/fdopen.t
diff --git a/MANIFEST b/MANIFEST
index 92efe61..e775e92 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5441,6 +5441,7 @@ t/re/uniprops.t Test unicode \p{} regex constructs
t/run/cloexec.t Test close-on-exec.
t/run/dtrace.t Test for DTrace probes
t/run/exit.t Test perl's exit status.
+t/run/fdopen.t Test the code that emulates /dev/fd/3 etc
t/run/fresh_perl.t Tests that require a fresh perl.
t/run/locale.t Tests related to locale handling
t/run/noswitch.t Test aliasing ARGV for other switch tests
diff --git a/embed.fnc b/embed.fnc
index 5c380ff..c7ae118 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1770,7 +1770,6 @@ s |void |Slab_to_rw |NN void *op
#if defined(PERL_IN_PERL_C)
s |void |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp
-s |void |forbid_setid |const char flag|const bool suidscript
s |void |incpush |NN const char *const dir|STRLEN len \
|U32 flags
s |SV* |mayberelocate |NN const char *const dir|STRLEN len \
@@ -1785,7 +1784,7 @@ s |void |init_predump_symbols
rs |void |my_exit_jump
s |void |nuke_stacks
s |PerlIO *|open_script |NN const char *scriptname|bool dosearch \
- |NN bool *suidscript
+ |bool doextract
sr |void |usage
#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
so |void |validate_suid |NN PerlIO *rsfp
diff --git a/embed.h b/embed.h
index 9fdf91b..d713fd0 100644
--- a/embed.h
+++ b/embed.h
@@ -1426,7 +1426,6 @@
# endif
# if defined(PERL_IN_PERL_C)
#define find_beginning(a,b) S_find_beginning(aTHX_ a,b)
-#define forbid_setid(a,b) S_forbid_setid(aTHX_ a,b)
#define incpush(a,b,c) S_incpush(aTHX_ a,b,c)
#define incpush_use_sep(a,b,c) S_incpush_use_sep(aTHX_ a,b,c)
#define init_ids() S_init_ids(aTHX)
diff --git a/perl.c b/perl.c
index 104cac7..a9f380b 100644
--- a/perl.c
+++ b/perl.c
@@ -77,11 +77,13 @@ char *getenv (char *); /* Usually in <stdlib.h> */
static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-/* Drop everything. Heck, don't even try to call it */
-# define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) NOOP
+static void S_forbid_setid(pTHX_ const char flag);
+
+# define validate_suid(rsfp) NOOP
+# define forbid_setid(flag) S_forbid_setid(aTHX_ flag)
#else
-/* Drop almost everything */
-# define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp)
+# define validate_suid(rsfp) S_validate_suid(aTHX_ rsfp)
+# define forbid_setid(flag) NOOP
#endif
#define CALL_BODY_SUB(myop) \
@@ -1801,15 +1803,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
#ifdef USE_SITECUSTOMIZE
bool minus_f = FALSE;
#endif
- SV *linestr_sv = newSV_type(SVt_PVIV);
+ SV *linestr_sv = NULL;
bool add_read_e_script = FALSE;
U32 lex_start_flags = 0;
PERL_SET_PHASE(PERL_PHASE_START);
- SvGROW(linestr_sv, 80);
- sv_setpvs(linestr_sv,"");
-
init_main_stash();
{
@@ -1868,7 +1867,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
PL_minus_E = TRUE;
/* FALL THROUGH */
case 'e':
- forbid_setid('e', FALSE);
+ forbid_setid('e');
if (!PL_e_script) {
PL_e_script = newSVpvs("");
add_read_e_script = TRUE;
@@ -1892,7 +1891,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
goto reswitch;
case 'I': /* -I handled both here and in moreswitches() */
- forbid_setid('I', FALSE);
+ forbid_setid('I');
if (!*++s && (s=argv[1]) != NULL) {
argc--,argv++;
}
@@ -1904,7 +1903,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
Perl_croak(aTHX_ "No directory specified for -I");
break;
case 'S':
- forbid_setid('S', FALSE);
+ forbid_setid('S');
dosearch = TRUE;
s++;
goto reswitch;
@@ -2072,16 +2071,13 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
init_perllib();
{
- bool suidscript = FALSE;
-
- rsfp = open_script(scriptname, dosearch, &suidscript);
+ rsfp = open_script(scriptname, dosearch, doextract);
if (!rsfp) {
rsfp = PerlIO_stdin();
lex_start_flags = LEX_DONT_CLOSE_RSFP;
}
- validate_suid(validarg, scriptname, fdscript, suidscript,
- linestr_sv, rsfp);
+ validate_suid(rsfp);
#ifndef PERL_MICRO
# if defined(SIGCHLD) || defined(SIGCLD)
@@ -2100,12 +2096,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
#endif
if (doextract) {
+ forbid_setid('x');
- /* This will croak if suidscript is true, as -x cannot be used with
- setuid scripts. */
- forbid_setid('x', suidscript);
- /* Hence you can't get here if suidscript is true */
-
+ linestr_sv = newSV_type(SVt_PV);
+ lex_start_flags |= LEX_START_COPIED;
find_beginning(linestr_sv, rsfp);
if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
Perl_croak(aTHX_ "Can't chdir to %s",cddir);
@@ -2234,6 +2228,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
#endif
lex_start(linestr_sv, rsfp, lex_start_flags);
+ if(linestr_sv)
+ SvREFCNT_dec(linestr_sv);
+
PL_subname = newSVpvs("main");
if (add_read_e_script)
@@ -3110,7 +3107,7 @@ Perl_moreswitches(pTHX_ const char *s)
s++;
return s;
case 'd':
- forbid_setid('d', FALSE);
+ forbid_setid('d');
s++;
/* -dt indicates to the debugger that threads will be used */
@@ -3158,7 +3155,7 @@ Perl_moreswitches(pTHX_ const char *s)
case 'D':
{
#ifdef DEBUGGING
- forbid_setid('D', FALSE);
+ forbid_setid('D');
s++;
PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
@@ -3193,7 +3190,7 @@ Perl_moreswitches(pTHX_ const char *s)
}
return s;
case 'I': /* -I handled both here and in parse_body() */
- forbid_setid('I', FALSE);
+ forbid_setid('I');
++s;
while (*s && isSPACE(*s))
++s;
@@ -3241,10 +3238,10 @@ Perl_moreswitches(pTHX_ const char *s)
}
return s;
case 'M':
- forbid_setid('M', FALSE); /* XXX ? */
+ forbid_setid('M'); /* XXX ? */
/* FALL THROUGH */
case 'm':
- forbid_setid('m', FALSE); /* XXX ? */
+ forbid_setid('m'); /* XXX ? */
if (*++s) {
const char *start;
const char *end;
@@ -3304,7 +3301,7 @@ Perl_moreswitches(pTHX_ const char *s)
s++;
return s;
case 's':
- forbid_setid('s', FALSE);
+ forbid_setid('s');
PL_doswitches = TRUE;
s++;
return s;
@@ -3620,7 +3617,7 @@ S_init_main_stash(pTHX)
}
STATIC PerlIO *
-S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
+S_open_script(pTHX_ const char *scriptname, bool dosearch, bool doextract)
{
int fdscript = -1;
PerlIO *rsfp = NULL;
@@ -3650,33 +3647,45 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
* Is it a mistake to use a similar /dev/fd/ construct for
* suidperl?
*/
- *suidscript = TRUE;
+ assert(fdscript >= 0);
/* PSz 20 Feb 04
* Be supersafe and do some sanity-checks.
* Still, can we be sure we got the right thing?
*/
if (*s != '/') {
- Perl_croak(aTHX_ "Wrong syntax (suid) fd script name \"%s\"\n", s);
+ Perl_croak(aTHX_ "Wrong syntax (suid) fd script name \"%s\"", s);
}
if (! *(s+1)) {
- Perl_croak(aTHX_ "Missing (suid) fd script name\n");
+ Perl_croak(aTHX_ "Missing (suid) fd script name");
}
scriptname = savepv(s + 1);
Safefree(PL_origfilename);
PL_origfilename = (char *)scriptname;
+ if (doextract) {
+ /* This will croak, as -x is not permitted with setuid
+ scripts. */
+ Perl_croak(aTHX_ "No -x allowed with (suid) fdscript");
+ }
}
}
}
CopFILE_free(PL_curcop);
CopFILE_set(PL_curcop, PL_origfilename);
- if (*PL_origfilename == '-' && PL_origfilename[1] == '\0')
- scriptname = (char *)"";
if (fdscript >= 0) {
rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
}
- else if (!*scriptname) {
- forbid_setid(0, *suidscript);
+ else if (!*scriptname
+ || (*PL_origfilename == '-' && PL_origfilename[1] == '\0')) {
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+ char what = 0;
+ if (PerlProc_getuid() != PerlProc_geteuid())
+ what = 'u';
+ else if (PerlProc_getgid() != PerlProc_getegid())
+ what = 'g';
+ if (what)
+ Perl_croak(aTHX_ "No program input from stdin allowed while running set%cid", what);
+#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
return NULL;
}
else {
@@ -3746,7 +3755,19 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-/* Don't even need this function. */
+static void
+S_forbid_setid(pTHX_ const char flag)
+{
+ dVAR;
+ char what = 0;
+
+ if (PerlProc_getuid() != PerlProc_geteuid())
+ what = 'u';
+ else if (PerlProc_getgid() != PerlProc_getegid())
+ what = 'g';
+ if (what)
+ Perl_croak(aTHX_ "No -%c allowed while running set%cid", flag, what);
+}
#else
STATIC void
S_validate_suid(pTHX_ PerlIO *rsfp)
@@ -3864,32 +3885,6 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
return 0;
}
-/* Passing the flag as a single char rather than a string is a slight space
- optimisation. The only message that isn't /^-.$/ is
- "program input from stdin", which is substituted in place of '\0', which
- could never be a command line flag. */
-STATIC void
-S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */
-{
- dVAR;
- char string[3] = "-x";
- const char *message = "program input from stdin";
-
- if (flag) {
- string[1] = flag;
- message = string;
- }
-
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
- if (PerlProc_getuid() != PerlProc_geteuid())
- Perl_croak(aTHX_ "No %s allowed while running setuid", message);
- if (PerlProc_getgid() != PerlProc_getegid())
- Perl_croak(aTHX_ "No %s allowed while running setgid", message);
-#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
- if (suidscript)
- Perl_croak(aTHX_ "No %s allowed with (suid) fdscript", message);
-}
-
void
Perl_init_dbargs(pTHX)
{
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index dbdd492..3c84bbb 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -248,6 +248,11 @@ the file handle that it opens. Previously, it had been leaking the file handle
if it happened to have file descriptor 0, which would happen if C<require> was
called (explicitly or implicitly) when C<STDIN> had been closed.
+=item *
+
+F<t/run/fdopen.t> has been added, to test code that processes script names
+such as C</dev/fd/3>.
+
=back
=head1 Platform Support
diff --git a/proto.h b/proto.h
index dd3fd58..86e1818 100644
--- a/proto.h
+++ b/proto.h
@@ -5892,7 +5892,6 @@ STATIC void S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
#define PERL_ARGS_ASSERT_FIND_BEGINNING \
assert(linestr_sv); assert(rsfp)
-STATIC void S_forbid_setid(pTHX_ const char flag, const bool suidscript);
STATIC void S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_INCPUSH \
@@ -5925,11 +5924,10 @@ STATIC void S_my_exit_jump(pTHX)
__attribute__noreturn__;
STATIC void S_nuke_stacks(pTHX);
-STATIC PerlIO * S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
- __attribute__nonnull__(pTHX_1)
- __attribute__nonnull__(pTHX_3);
+STATIC PerlIO * S_open_script(pTHX_ const char *scriptname, bool dosearch, bool doextract)
+ __attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_OPEN_SCRIPT \
- assert(scriptname); assert(suidscript)
+ assert(scriptname)
STATIC void* S_parse_body(pTHX_ char **env, XSINIT_t xsinit);
STATIC void S_run_body(pTHX_ I32 oldscope)
diff --git a/t/run/fdopen.t b/t/run/fdopen.t
new file mode 100644
index 0000000..4e679a5
--- /dev/null
+++ b/t/run/fdopen.t
@@ -0,0 +1,113 @@
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+ skip_all_without_config('d_fork');
+}
+use strict;
+
+my $perl = which_perl();
+watchdog(60);
+$^F = 65536;
+
+$SIG{PIPE} = sub {
+ print "# Ignoring a SIGPIPE\n";
+};
+
+sub one_pipe {
+ my ($stdin, @args) = @_;
+ pipe my $r, my $w or die "pipe: $!";
+
+ my $pid = fork;
+ die "fork: $!" unless defined $pid;
+
+ unless ($pid) {
+ # child
+ open STDIN, '<&', $r or die "reopen: $!";
+ # Has to be a die, as we're in the child:
+ my $fileno = fileno STDIN;
+ die "fileno STDIN is $fileno" unless defined $fileno && $fileno == 0;
+ close $w or die "close: $!";
+ exec $perl, @args;
+ die "exec: $!";
+ }
+
+ close $r or die "close: $!";
+ print $w $stdin;
+ close $w or die "close: $!";
+
+ waitpid $pid, 0;
+}
+
+one_pipe(qq{print "ok 1 - simple OK\\n"});
+one_pipe(qq{print "not ok 2 - should not read stdin\\n"},
+ '-eprint "ok 2 - -e is honoured\n"');
+one_pipe(qq{print "ok 3 - fd open\\n"}, '/dev/fd/0');
+# This one exploits knowledge of the implementation to be sure which code is
+# being run. I don't think that we should rely on it being atoi() internally.
+one_pipe(qq{print "ok 4 - *our* fd open\\n"}, '/dev/fd/00');
+one_pipe(<<'EOP', '-x', '/dev/fd/00');
+print "not ok 5 - -x didn't work\n";
+die;
+#!perl
+print "ok 5 - -x worked\n";
+EOP
+
+{
+ pipe my $r, my $w or die "pipe: $!";
+ pipe my $r2, my $w2 or die "pipe: $!";
+
+ my $pid = fork;
+ die "fork: $!" unless defined $pid;
+
+ unless ($pid) {
+ # child
+ open STDIN, '<&', $r or die "reopen: $!";
+ # Has to be a die, as we're in the child:
+ my $fileno = fileno STDIN;
+ die "fileno STDIN is $fileno" unless defined $fileno && $fileno == 0;
+ $fileno = fileno $r2;
+ die "fileno \$r2 is $fileno" unless defined $fileno;
+ close $w or die "close: $!";
+ close $w2 or die "close: $!";
+ exec $perl, "/dev/fd/$fileno";
+ die "exec: $!";
+ }
+
+ close $r or die "close: $!";
+ close $r2 or die "close: $!";
+ print $w qq{print "not ok 6 - you shouldn't see this\n"};
+ close $w or die "close: $!";
+ print $w2 qq{print "ok 6 - read from the correct file descriptor\\n"};
+ close $w2 or die "close: $!";
+
+ waitpid $pid, 0;
+}
+
+{
+ my $pathname = 'whamm/glipp/klonk';
+ one_pipe(qq{print \$0 eq '$pathname' ? "ok 7 - pathname set\\n" : "not ok 7 - pathname was '$0'\n"},
+ "/dev/fd/0/$pathname");
+}
+
+curr_test(8);
+
+like(runperl(progfile => '/dev/fd/-1', stderr => 1),
+ qr!^Can't open perl script "/dev/fd/-1": !,
+ "Can't open a negative file handle");
+
+like(runperl(progfile => '/dev/fd/0/', stderr => 1),
+ qr/\AMissing \(suid\) fd script name\.\r?\n/,
+ "Missing suid script name error");
+
+like(runperl(progfile => '/dev/fd/0swoosh', stderr => 1),
+ qr/\AWrong syntax \(suid\) fd script name "swoosh"\.\r?\n/,
+ "Wrong suid script name error");
+
+like(runperl(progfile => '/dev/fd/0/a', stderr => 1, switches => ['-x']),
+ qr/\ANo -x allowed with \(suid\) fdscript\.\r?\n/,
+ 'No -x allowed with suid fdscript');
+
+done_testing();
--
Perl5 Master Repository
-
[perl.git] branch smoke-me/kick-FAKE_BIT_BUCKET, updated. v5.15.8-57-g855e92e
by Nicholas Clark