pp_sys.c:1236: OP *Perl_pp_sselect(): Assertion `SvPOK(sv)' failed. #16038
Comments
From @dur-randirCreated by @dur-randirWhile fuzzing perl v5.27.1-37-g4c95ee9f29 built with afl and run select$$,$a,$a,$$ to cause an assertion failure. This is a regression between 5.14 and commit 9d6d5a7 Make sselect call fetch once Not only does this commit make four-argument select call fetch once GDB info about the crash location is: (gdb) bt Perl Info |
From @cpansproutOn Sat, 24 Jun 2017 04:30:48 -0700, randir wrote:
I don’t understand why that commit causes the problem, but I can see what the problem is: Perl forces the first three arguments to be strings before processing the timeout argument. When it calls SvGETMAGIC on the timeout argument, it stops it from being a string (if get-magic returns a number, as is the case with $$). In this case, it is also the first argument. Perl does not expect that the arguments that were forced to strings will stop being such by the time it uses them. I have pushed a tentative patch to sprout/131645. Since system functions such as this are barely tested, could someone who actually understands this function check that it still works with my patch? -- Father Chrysostomos |
|
The RT System itself - Status changed from 'new' to 'open' |
From @jkeenanOn Sun, 25 Jun 2017 13:40:46 GMT, sprout wrote:
What would constitute better testing of system functions such as 4-arg select? -- |
From @cpansproutOn Sun, 25 Jun 2017 07:10:34 -0700, jkeenan wrote:
Testing the actual behaviour that the functions implement (e.g., whether select returns the right values for the right file descriptors), which, unfortunately, is very hard to do portably. (This is very easy for me to say, since most of these functions are like voodoo to me.) Most of the functions implemented in pp_sys.c are tested for basic things like whether they compile, whether they produce the right errors for read-only values, etc. These are simple, superficial tests that do basic sanity checks, without getting to the heart of the matter. -- Father Chrysostomos |
From @cpansproutOn Sun, 25 Jun 2017 06:40:46 -0700, sprout wrote:
Attached for convenience. -- Father Chrysostomos |
From @cpansproutcommit dce93df Tentative fix for #131645 Inline Patchdiff --git a/pp_sys.c b/pp_sys.c
index 65900fa..8d93126 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1149,6 +1149,7 @@ PP(pp_sselect)
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ SV *svs[4];
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
@@ -1164,7 +1165,7 @@ PP(pp_sselect)
SP -= 4;
for (i = 1; i <= 3; i++) {
- SV * const sv = SP[i];
+ SV * const sv = svs[i] = SP[i];
SvGETMAGIC(sv);
if (!SvOK(sv))
continue;
@@ -1177,7 +1178,12 @@ PP(pp_sselect)
if (!SvPOKp(sv))
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Non-string passed as bitmask");
- SvPV_force_nomg_nolen(sv); /* force string conversion */
+ if (SvGAMAGIC(sv)) {
+ svs[i] = sv_newmortal();
+ sv_copypv_nomg(svs[i], sv);
+ }
+ else
+ SvPV_force_nomg_nolen(sv); /* force string conversion */
}
j = SvCUR(sv);
if (maxlen < j)
@@ -1228,7 +1234,7 @@ PP(pp_sselect)
tbuf = NULL;
for (i = 1; i <= 3; i++) {
- sv = SP[i];
+ sv = svs[i];
if (!SvOK(sv) || SvCUR(sv) == 0) {
fd_sets[i] = 0;
continue;
@@ -1275,7 +1281,7 @@ PP(pp_sselect)
#endif
for (i = 1; i <= 3; i++) {
if (fd_sets[i]) {
- sv = SP[i];
+ sv = svs[i];
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
s = SvPVX(sv);
for (offset = 0; offset < growsize; offset += masksize) {
@@ -1284,7 +1290,8 @@ PP(pp_sselect)
}
Safefree(fd_sets[i]);
#endif
- SvSETMAGIC(sv);
+ if (sv != SP[i])
+ SvSetMagicSV(SP[i], sv);
}
}
diff --git a/t/op/sselect.t b/t/op/sselect.t
index fedbfc7..9ec1c63 100644
--- a/t/op/sselect.t
+++ b/t/op/sselect.t
@@ -13,7 +13,7 @@ BEGIN {
skip_all("Win32 miniperl has no socket select")
if $^O eq "MSWin32" && is_miniperl();
-plan (15);
+plan (16);
my $blank = "";
eval {select undef, $blank, $blank, 0};
@@ -95,3 +95,12 @@ note("diff=$diff under=$under");
select (undef, undef, undef, $sleep);
::is($count, 1, 'RT120102');
}
+
+package _131645{
+ sub TIESCALAR { bless [] }
+ sub FETCH { 0 }
+ sub STORE { }
+}
+tie $tie, _131645::;
+select ($tie, undef, undef, $tie);
+ok("no crash from select $numeric_tie, undef, undef, $numeric_tie") |
From @demerphqOn 25 Jun 2017 19:57, "Father Chrysostomos via RT" < On Sun, 25 Jun 2017 06:40:46 -0700, sprout wrote:
Attached for convenience. Seems to me it would be easier to just assert that the args must be Yves -- Father Chrysostomos via perlbug: queue: perl5 status: open commit dce93df Tentative fix for #131645 Inline Patchdiff --git a/pp_sys.c b/pp_sys.c
index 65900fa..8d93126 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1149,6 +1149,7 @@ PP(pp_sselect)
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ SV *svs[4];
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
@@ -1164,7 +1165,7 @@ PP(pp_sselect)
SP -= 4;
for (i = 1; i <= 3; i++) {
- SV * const sv = SP[i];
+ SV * const sv = svs[i] = SP[i];
SvGETMAGIC(sv);
if (!SvOK(sv))
continue;
@@ -1177,7 +1178,12 @@ PP(pp_sselect)
if (!SvPOKp(sv))
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Non-string passed as bitmask");
- SvPV_force_nomg_nolen(sv); /* force string conversion */
+ if (SvGAMAGIC(sv)) {
+ svs[i] = sv_newmortal();
+ sv_copypv_nomg(svs[i], sv);
+ }
+ else
+ SvPV_force_nomg_nolen(sv); /* force string conversion */
}
j = SvCUR(sv);
if (maxlen < j)
@@ -1228,7 +1234,7 @@ PP(pp_sselect)
tbuf = NULL;
for (i = 1; i <= 3; i++) {
- sv = SP[i];
+ sv = svs[i];
if (!SvOK(sv) || SvCUR(sv) == 0) {
fd_sets[i] = 0;
continue;
@@ -1275,7 +1281,7 @@ PP(pp_sselect)
#endif
for (i = 1; i <= 3; i++) {
if (fd_sets[i]) {
- sv = SP[i];
+ sv = svs[i];
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
s = SvPVX(sv);
for (offset = 0; offset < growsize; offset += masksize) {
@@ -1284,7 +1290,8 @@ PP(pp_sselect)
}
Safefree(fd_sets[i]);
#endif
- SvSETMAGIC(sv);
+ if (sv != SP[i])
+ SvSetMagicSV(SP[i], sv);
}
}
diff --git a/t/op/sselect.t b/t/op/sselect.t
index fedbfc7..9ec1c63 100644
--- a/t/op/sselect.t
+++ b/t/op/sselect.t
@@ -13,7 +13,7 @@ BEGIN {
skip_all("Win32 miniperl has no socket select")
if $^O eq "MSWin32" && is_miniperl();
-plan (15);
+plan (16);
my $blank = "";
eval {select undef, $blank, $blank, 0};
@@ -95,3 +95,12 @@ note("diff=$diff under=$under");
select (undef, undef, undef, $sleep);
::is($count, 1, 'RT120102');
}
+
+package _131645{
+ sub TIESCALAR { bless [] }
+ sub FETCH { 0 }
+ sub STORE { }
+}
+tie $tie, _131645::;
+select ($tie, undef, undef, $tie);
+ok("no crash from select $numeric_tie, undef, undef, $numeric_tie") |
From @cpansproutOn Mon, 26 Jun 2017 01:49:05 -0700, demerphq wrote:
As far as I know, we do not enforce anything like this anywhere else in perl. There are all sorts of things that may not be sensible, yet for the most part the Perl language is made up of simple building blocks that made things like ‘die return 3’ work, so you *can* write things like that if you are feeling bored. That’s what makes perl so much fun to write in. As for forbidding select$foo,"","",$foo, that to me feels a lot like forbidding substr $foo,$foo, because you might not have meant that. That sort of policing gets very annoying very quickly. -- Father Chrysostomos |
From @demerphqOn 26 June 2017 at 15:26, Father Chrysostomos via RT
Yeah, well, I dunno. I think you are right in general, Perl shouldn't On the other hand, I really think select is a bit of a special beast, select() is special because it both /reads/ and /writes/ from its Also note that select is already special in that it is insisting its So even though i generally agree with you I think select is a good I guess I see it as the exception that proves the rule. :-) Yves -- |
From @cpansproutOn Mon, 26 Jun 2017 09:02:23 -0700, demerphq wrote:
There is a practical problem with forbidding the same SV as multiple arguments to select(). For this to work consistently, we would have to croak in cases like this, too: sub foo { In code like this, perl pretends that $h{bar} and $_[0] within the sub are the same variable, even though they are different SVs. (\$_[0] will actually give a reference to $h{bar}.) select() would have to look at the defelem’s target. I think this approach would make things unnecessarily complicated, and without it forbidding such usage would make things buggy and inconsistent. BTW, my patch to make select() work while being happy to accept the same SV as multiple arguments is already written. :-) And it is simple and straightforward, too. -- Father Chrysostomos |
From @cpansproutOn Tue, 27 Jun 2017 13:13:40 -0700, sprout wrote:
I have gone ahead and applied the patch (with slight tweaks) as e26c690, since it fixes the problem in a way that is backward-compatible and does not prevent Yves’s suggestion from being implemented later. I tested it by writing a one-liner involving ties, running it through gdb, and inspecting the arguments passed to the system function. I confirmed that they were the same values as retrieved from the tied variables. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release yesterday of Perl 5.28.0, this and 185 other issues have been Perl 5.28.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#131645 (status was 'resolved')
Searchable as RT131645$
The text was updated successfully, but these errors were encountered: