Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

pp_sys.c: open(), exec() and system() should croak on a UTF-8 filename.

NOT FULLY TESTED
  • Loading branch information...
commit 9de3ecc92d59cdd52817f30e905fe8da6a213034 1 parent 807157d
@Hugmeir authored
Showing with 56 additions and 10 deletions.
  1. +3 −3 doio.c
  2. +16 −6 pp_sys.c
  3. +37 −1 t/op/exec.t
View
6 doio.c
@@ -215,7 +215,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
}
#endif /* USE_STDIO */
name = (SvOK(*svp) || SvGMAGICAL(*svp)) ?
- savesvpv (*svp) : savepvs ("");
+ savepv(SvPVbyte_nolen(*svp)) : savepvs ("");
SAVEFREEPV(name);
}
else {
@@ -1399,13 +1399,13 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
while (++mark <= sp) {
if (*mark)
- *a++ = SvPV_nolen_const(*mark);
+ *a++ = (const char*)SvPVbyte_nolen(*mark);
else
*a++ = "";
}
*a = NULL;
if (really)
- tmps = SvPV_nolen_const(really);
+ tmps = (const char*)SvPVbyte_nolen(really);
if ((!really && *PL_Argv[0] != '/') ||
(really && *tmps != '/')) /* will execvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
View
22 pp_sys.c
@@ -612,7 +612,7 @@ PP(pp_open)
sv = GvSVn(gv);
}
- tmps = SvPV_const(sv, len);
+ tmps = SvPVbyte(sv, len);
ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, NULL, MARK+1, (SP-MARK));
SP = ORIGMARK;
if (ok)
@@ -4169,7 +4169,9 @@ PP(pp_system)
else if (SP - MARK != 1)
value = (I32)do_aexec5(NULL, MARK, SP, pp[1], did_pipes);
else {
- value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
+ value = (I32)do_exec3((PL_tainting
+ ? SvPVbyte_nomg_nolen(sv_mortalcopy(*SP))
+ : SvPVbyte_nolen(sv_mortalcopy(*SP))), pp[1], did_pipes);
}
PerlProc__exit(-1);
}
@@ -4192,7 +4194,9 @@ PP(pp_system)
# endif
}
else {
- value = (I32)do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
+ value = (I32)do_spawn(PL_tainting
+ ? SvPVbyte_nomg_nolen(sv_mortalcopy(*SP))
+ : SvPVbyte_nolen(sv_mortalcopy(*SP)));
}
if (PL_statusvalue == -1) /* hint that value must be returned as is */
result = 1;
@@ -4240,13 +4244,19 @@ PP(pp_exec)
#endif
else {
#ifdef VMS
- value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
+ value = (I32)vms_do_exec(PL_tainting
+ ? SvPVbyte_nomg_nolen(sv_mortalcopy(*SP))
+ : SvPVbyte_nolen(sv_mortalcopy(*SP)));
#else
# ifdef __OPEN_VM
- (void) do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
+ (void) do_spawn(PL_tainting
+ ? SvPVbyte_nomg_nolen(sv_mortalcopy(*SP))
+ : SvPVbyte_nolen(sv_mortalcopy(*SP)));
value = 0;
# else
- value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
+ value = (I32)do_exec(PL_tainting
+ ? SvPVbyte_nomg_nolen(sv_mortalcopy(*SP))
+ : SvPVbyte_nolen(sv_mortalcopy(*SP)));
# endif
#endif
}
View
38 t/op/exec.t
@@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C'; # Ditto in GNU.
my $Is_VMS = $^O eq 'VMS';
my $Is_Win32 = $^O eq 'MSWin32';
-plan(tests => 22);
+plan(tests => 30);
my $Perl = which_perl();
@@ -118,6 +118,42 @@ unless ( ok( $! == 2 or $! =~ /\bno\b.*\bfile/i or
}
+{
+ #exec croak on UTF-8:
+ local $@;
+ eval { exec "\x{30cb}" };
+ like( $@, qr/Wide characer in exec/, "exec UTF8 croaks on UTF-8");
+
+ local $@;
+ eval { exec { "\x{30cb}" } 1 };
+ like( $@, qr/Wide characer in exec/, "exec { UTF8 } croaks on UTF-8");
+
+ local $@;
+ eval { exec { "lskdjfalksdjfdjfkls" } "\x{30cb}" };
+ like( $@, qr/Wide characer in exec/, 'exec { gargabe } UTF8 croaks on UTF-8');
+
+ local $@;
+ eval { exec { $Perl } "\x{30cb}" };
+ like( $@, qr/Wide characer in exec/, 'exec { $Perl } UTF8 croaks on UTF-8');
+
+ #system croak on UTF-8:
+ local $@;
+ eval { system "\x{30cb}" };
+ like( $@, qr/Wide characer in system/, "system UTF8 croaks on UTF-8");
+
+ local $@;
+ eval { system { "\x{30cb}" } 1 };
+ like( $@, qr/Wide characer in system/, "system { UTF8 } croaks on UTF-8");
+
+ local $@;
+ eval { system { "lskdjfalksdjfdjfkls" } "\x{30cb}" };
+ like( $@, qr/Wide characer in system/, 'system { gargabe } UTF8 croaks on UTF-8');
+
+ local $@;
+ eval { system { $Perl } "\x{30cb}" };
+ like( $@, qr/Wide characer in system/, 'system { $Perl } UTF8 croaks on UTF-8');
+}
+
is( `$Perl -le "print 'ok'"`, "ok\n", 'basic ``' );
is( <<`END`, "ok\n", '<<`HEREDOC`' );
$Perl -le "print 'ok'"
Please sign in to comment.
Something went wrong with that request. Please try again.