In perl.git, the branch maint-5.28 has been updated <https://perl5.git.perl.org/perl.git/commitdiff/5aacb4d4c7f0410dfb10e7f5990a07c3c9b42ab8?hp=e79f200a0fa5b104ea05a94ab43ef766da58b484>
- Log ----------------------------------------------------------------- commit 5aacb4d4c7f0410dfb10e7f5990a07c3c9b42ab8 Author: Leon Timmermans <[email protected]> Date: Sun Dec 16 01:05:06 2018 +0100 Always mark pipe in list pipe-open as inherit-on-exec This is the my_popen_list counterpart of c6fe5b981b942ddabb23ed4b7602067e906e6d88 (cherry picked from commit 30c869b87739b56280daca3cd44b0588144747b7) commit 006557cbd3f3734cde81220d12882e8857f272cd Author: Leon Timmermans <[email protected]> Date: Sat Dec 15 19:08:41 2018 +0100 Always mark pipe in pipe-open as inherit-on-exec Since 2cdf406a a lot of file descriptors are opened close-on-exec, including the pipe that is passed to the child process in a pipe-open. This is usually fine because a dup2 follows to rename that handle to stdin/stdout that will set the inherit-on-exec. However, if the pipe descriptor already has the right value, for example because stdin was closed, then no dup2 happens and hence it's still marked as close-on-exec right when we want to perform an exec. This patch explicitly marks such a handle as inherit-on-exec, to ensure it will be open for the child process. (cherry picked from commit c6fe5b981b942ddabb23ed4b7602067e906e6d88) commit d55db98728969e2511ea6326ebd691b70770b5c3 Author: Tony Cook <[email protected]> Date: Wed Nov 21 10:05:27 2018 +1100 (perl #133659) make an in-place edit successful if the exit status is zero during global destruction. This means that code like: perl -i -ne '...; last' will replace the input file with the in-place edit output of the file, but: perl -i -ne '...; die' or perl -i -ne '...; exit 1' won't. (cherry picked from commit 85d2f7cacba4b0088ae0c67cc6d4c9b7495355c0) commit 58de2cb7da0a36b48ef0078396c8c6208813dfa2 Author: Tony Cook <[email protected]> Date: Tue Nov 20 16:43:43 2018 +1100 (perl #133659) tests for global destruction handling of inplace editing (cherry picked from commit 640e129d0fc499d24a759cacae9240a32c66fa51) commit 0c819f43d46a874d0ee49586954c72b1b1a67543 Author: Tony Cook <[email protected]> Date: Tue Nov 20 15:30:20 2018 +1100 (perl #133659) move argvout cleanup to a new function (cherry picked from commit 404395d24bc87890c7d978622296b9925a347aa0) ----------------------------------------------------------------------- Summary of changes: doio.c | 107 ++++++++++++++++++++++++++++++++----------------------- embed.fnc | 1 + embed.h | 1 + proto.h | 3 ++ t/io/inplace.t | 28 ++++++++++++++- t/run/switches.t | 4 +-- util.c | 8 +++-- 7 files changed, 103 insertions(+), 49 deletions(-) diff --git a/doio.c b/doio.c index 16daf9fd11..e6a05b8c6d 100644 --- a/doio.c +++ b/doio.c @@ -1173,34 +1173,39 @@ S_argvout_free(pTHX_ SV *io, MAGIC *mg) { dir = INT2PTR(DIR *, SvIV(*dir_psv)); #endif if (IoIFP(io)) { - SV **pid_psv; - PerlIO *iop = IoIFP(io); + if (PL_phase == PERL_PHASE_DESTRUCT && PL_statusvalue == 0) { + (void)argvout_final(mg, (IO*)io, FALSE); + } + else { + SV **pid_psv; + PerlIO *iop = IoIFP(io); - assert(SvTYPE(mg->mg_obj) == SVt_PVAV); + assert(SvTYPE(mg->mg_obj) == SVt_PVAV); - pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE); + pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE); - assert(pid_psv && *pid_psv); + assert(pid_psv && *pid_psv); - if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) { - /* if we get here the file hasn't been closed explicitly by the - user and hadn't been closed implicitly by nextargv(), so - abandon the edit */ - SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE); - const char *temp_pv = SvPVX(*temp_psv); + if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) { + /* if we get here the file hasn't been closed explicitly by the + user and hadn't been closed implicitly by nextargv(), so + abandon the edit */ + SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE); + const char *temp_pv = SvPVX(*temp_psv); - assert(temp_psv && *temp_psv && SvPOK(*temp_psv)); - (void)PerlIO_close(iop); - IoIFP(io) = IoOFP(io) = NULL; + assert(temp_psv && *temp_psv && SvPOK(*temp_psv)); + (void)PerlIO_close(iop); + IoIFP(io) = IoOFP(io) = NULL; #ifdef ARGV_USE_ATFUNCTIONS - if (dir) { - if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 && - NotSupported(errno)) - (void)UNLINK(temp_pv); - } + if (dir) { + if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 && + NotSupported(errno)) + (void)UNLINK(temp_pv); + } #else - (void)UNLINK(temp_pv); + (void)UNLINK(temp_pv); #endif + } } } #ifdef ARGV_USE_ATFUNCTIONS @@ -1526,31 +1531,14 @@ S_dir_unchanged(pTHX_ const char *orig_pv, MAGIC *mg) { #define dir_unchanged(orig_psv, mg) \ S_dir_unchanged(aTHX_ (orig_psv), (mg)) -/* explicit renamed to avoid C++ conflict -- kja */ -bool -Perl_do_close(pTHX_ GV *gv, bool not_implicit) -{ +STATIC bool +S_argvout_final(pTHX_ MAGIC *mg, IO *io, bool not_implicit) { bool retval; - IO *io; - MAGIC *mg; - if (!gv) - gv = PL_argvgv; - if (!gv || !isGV_with_GP(gv)) { - if (not_implicit) - SETERRNO(EBADF,SS_IVCHAN); - return FALSE; - } - io = GvIO(gv); - if (!io) { /* never opened */ - if (not_implicit) { - report_evil_fh(gv); - SETERRNO(EBADF,SS_IVCHAN); - } - return FALSE; - } - if ((mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl)) - && mg->mg_obj) { + /* ensure args are checked before we start using them */ + PERL_ARGS_ASSERT_ARGVOUT_FINAL; + + { /* handle to an in-place edit work file */ SV **back_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_BACKUP_NAME, FALSE); SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE); @@ -1717,7 +1705,38 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) SvPVX(*temp_psv), Strerror(errno)); } } - freext: + freext: + ; + } + return retval; +} + +/* explicit renamed to avoid C++ conflict -- kja */ +bool +Perl_do_close(pTHX_ GV *gv, bool not_implicit) +{ + bool retval; + IO *io; + MAGIC *mg; + + if (!gv) + gv = PL_argvgv; + if (!gv || !isGV_with_GP(gv)) { + if (not_implicit) + SETERRNO(EBADF,SS_IVCHAN); + return FALSE; + } + io = GvIO(gv); + if (!io) { /* never opened */ + if (not_implicit) { + report_evil_fh(gv); + SETERRNO(EBADF,SS_IVCHAN); + } + return FALSE; + } + if ((mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl)) + && mg->mg_obj) { + retval = argvout_final(mg, io, not_implicit); mg_freeext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl); } else { diff --git a/embed.fnc b/embed.fnc index 454a380e4c..e762fe1eec 100644 --- a/embed.fnc +++ b/embed.fnc @@ -440,6 +440,7 @@ p |bool|do_exec3 |NN const char *incmd|int fd|int do_report #endif #if defined(PERL_IN_DOIO_C) s |void |exec_failed |NN const char *cmd|int fd|int do_report +s |bool |argvout_final |NN MAGIC *mg|NN IO *io|bool not_implicit #endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) : Defined in doio.c, used only in pp_sys.c diff --git a/embed.h b/embed.h index fb93ebc1cb..a5416a1148 100644 --- a/embed.h +++ b/embed.h @@ -1746,6 +1746,7 @@ #define deb_stack_n(a,b,c,d,e) S_deb_stack_n(aTHX_ a,b,c,d,e) # endif # if defined(PERL_IN_DOIO_C) +#define argvout_final(a,b,c) S_argvout_final(aTHX_ a,b,c) #define exec_failed(a,b,c) S_exec_failed(aTHX_ a,b,c) #define ingroup(a,b) S_ingroup(aTHX_ a,b) #define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l,m) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l,m) diff --git a/proto.h b/proto.h index c91141b9e8..66bb29b132 100644 --- a/proto.h +++ b/proto.h @@ -4723,6 +4723,9 @@ STATIC void S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, I assert(stack_base) #endif #if defined(PERL_IN_DOIO_C) +STATIC bool S_argvout_final(pTHX_ MAGIC *mg, IO *io, bool not_implicit); +#define PERL_ARGS_ASSERT_ARGVOUT_FINAL \ + assert(mg); assert(io) STATIC void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report); #define PERL_ARGS_ASSERT_EXEC_FAILED \ assert(cmd) diff --git a/t/io/inplace.t b/t/io/inplace.t index 98159e06bf..0403cd9250 100644 --- a/t/io/inplace.t +++ b/t/io/inplace.t @@ -5,7 +5,7 @@ require './test.pl'; $^I = $^O eq 'VMS' ? '_bak' : '.bak'; -plan( tests => 6 ); +plan( tests => 8 ); my @tfiles = (tempfile(), tempfile(), tempfile()); my @tfiles_bak = map "$_$^I", @tfiles; @@ -91,3 +91,29 @@ SKIP: END { unlink_all(@ifiles); } } + +{ + my @tests = + ( # opts, code, result, name, $TODO + [ "-n", "die", "bar\n", "die shouldn't touch file" ], + [ "-n", "last", "", "last should update file" ], + ); + our $file = tempfile() ; + + for my $test (@tests) { + (my ($opts, $code, $result, $name), our $TODO) = @$test; + open my $fh, ">", $file or die; + print $fh "bar\n"; + close $fh; + + runperl( prog => $code, + switches => [ grep length, "-i", $opts ], + args => [ $file ], + stderr => 1, # discarded + ); + open $fh, "<", $file or die; + my $data = do { local $/; <$fh>; }; + close $fh; + is($data, $result, $name); + } +} diff --git a/t/run/switches.t b/t/run/switches.t index 7ccef1e063..594cad6e7f 100644 --- a/t/run/switches.t +++ b/t/run/switches.t @@ -429,7 +429,7 @@ __EOF__ # exit or die should leave original content in file for my $inplace (qw/-i -i.bak/) { - for my $prog (qw/die exit/) { + for my $prog ("die", "exit 1") { open my $fh, ">", $work or die "$0: failed to open '$work': $!"; print $fh $yada; close $fh or die "Failed to close: $!"; @@ -443,7 +443,7 @@ __EOF__ my $data = do { local $/; <$in> }; close $in; is ($data, $yada, "check original content still in file"); - unlink $work; + unlink $work, "$work.bak"; } } diff --git a/util.c b/util.c index 842cc953e2..25b5c6601e 100644 --- a/util.c +++ b/util.c @@ -2302,8 +2302,10 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) if (p[THAT] != (*mode == 'r')) /* if dup2() didn't close it */ PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */ } - else + else { + setfd_cloexec_or_inhexec_by_sysfdness(p[THIS]); PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */ + } #if !defined(HAS_FCNTL) || !defined(F_SETFD) /* No automatic close - do it by hand */ # ifndef NOFILE @@ -2441,8 +2443,10 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (p[THAT] != (*mode == 'r')) /* if dup2() didn't close it */ PerlLIO_close(p[THAT]); } - else + else { + setfd_cloexec_or_inhexec_by_sysfdness(p[THIS]); PerlLIO_close(p[THAT]); + } #ifndef OS2 if (doexec) { #if !defined(HAS_FCNTL) || !defined(F_SETFD) -- Perl5 Master Repository
