diff options
author | Nicholas Clark <nick@ccl4.org> | 2021-07-28 13:01:35 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2021-07-28 13:14:54 +0000 |
commit | 3235da5abd4c96f5ae2ec908dc9c110d2aebf65a (patch) | |
tree | f40ee1bc15d76e6dfb5c66af334ef1791f70a61a /util.c | |
parent | fbc41327d5599cf49e8f0c5a8e5395b52adf7d2c (diff) | |
download | perl-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.c | 16 |
1 files changed, 10 insertions, 6 deletions
@@ -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 |