summaryrefslogtreecommitdiff
path: root/util.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2021-07-28 13:01:35 +0000
committerNicholas Clark <nick@ccl4.org>2021-07-28 13:14:54 +0000
commit3235da5abd4c96f5ae2ec908dc9c110d2aebf65a (patch)
treef40ee1bc15d76e6dfb5c66af334ef1791f70a61a /util.c
parentfbc41327d5599cf49e8f0c5a8e5395b52adf7d2c (diff)
downloadperl-3235da5abd4c96f5ae2ec908dc9c110d2aebf65a.tar.gz
Don't call av_fetch() with TRUE to create an SV that is immediately freed.
In Perl_my_pclose() the code as been calling av_fetch() with TRUE (lvalue; create the SV if not found) since the Perl 4 -> Perl 5 migration. The code *had* been assuming that the returned result was always a valid SvIV until commit 25d9202327791097 in Jan 2001: Safe fix for Simon's pclose() doing SvIVX of undef -> core bug. which fixes the bug reported in https://www.nntp.perl.org/group/perl.perl5.porters/2001/01/msg28651.html That commit changed the code to default the IV result (the pid) to -1 if the av_fetch() failed to return SVt_IV. However, that commit failed to notice that the value -1 was *already* "in use" *only 4 lines later* as a flag for OS/2 to indicate "Opened by popen." Hence switch the OS/2 sentinel value to -2. The that states that OS/2 has a my_pclose implementation in os2.c is wrong. It was erroneously added by commit 5f05dabc4054964a in Dec 1996: [inseparable changes from patch from perl5.003_11 to perl5.003_12] It appears to be a copy-paste error from the previous comment added about my_popen. I tested this fix with the 2001-era code of commit 25d9202327791097 - it (also) solves the bug reported back then.
Diffstat (limited to 'util.c')
-rw-r--r--util.c16
1 files changed, 10 insertions, 6 deletions
diff --git a/util.c b/util.c
index 3cea45a34b..f187145202 100644
--- a/util.c
+++ b/util.c
@@ -3210,7 +3210,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
#endif /* !HAS_SIGACTION */
#endif /* !PERL_MICRO */
- /* VMS' my_pclose() is in VMS.c; same with OS/2 */
+ /* VMS' my_pclose() is in VMS.c */
#if (!defined(DOSISH) || defined(HAS_FORK)) && !defined(VMS) && !defined(__LIBCATAMOUNT__) && !defined(__amigaos4__)
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
@@ -3224,10 +3224,14 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
const int fd = PerlIO_fileno(ptr);
bool should_wait;
- svp = av_fetch(PL_fdpid,fd,TRUE);
- pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
- SvREFCNT_dec(*svp);
- *svp = NULL;
+ svp = av_fetch(PL_fdpid, fd, FALSE);
+ if (svp) {
+ pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
+ SvREFCNT_dec(*svp);
+ *svp = NULL;
+ } else {
+ pid = -1;
+ }
#if defined(USE_PERLIO)
/* Find out whether the refcount is low enough for us to wait for the
@@ -3238,7 +3242,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
#endif
#ifdef OS2
- if (pid == -1) { /* Opened by popen. */
+ if (pid == -2) { /* Opened by popen. */
return my_syspclose(ptr);
}
#endif