rpms/perl
5
0
Fork 0
Code Issues Pull Requests Releases Activity

Fix in-place edit to replace files on a successful perl exit status

Browse Source
This commit is contained in:
Petr Písař 2018-11-30 14:14:11 +01:00
parent 85f1254ef4
commit 45b1f54fc1
4 changed files with 346 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
perl-5.29.5-perl-133659-make-an-in-place-edit-successful-if-the-.patch Normal file
View File

@ -0,0 +1,135 @@
From 85d2f7cacba4b0088ae0c67cc6d4c9b7495355c0 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 21 Nov 2018 10:05:27 +1100
Subject: [PATCH 3/3] (perl #133659) make an in-place edit successful if the
exit status is zero
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doio.c | 45 +++++++++++++++++++++++++--------------------
t/io/inplace.t | 2 +-
t/run/switches.t | 4 ++--
3 files changed, 28 insertions(+), 23 deletions(-)
diff --git a/doio.c b/doio.c
index 77421de1d1..9fe222e082 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
diff --git a/t/io/inplace.t b/t/io/inplace.t
index ac50f1ab77..0403cd9250 100644
--- a/t/io/inplace.t
+++ b/t/io/inplace.t
@@ -96,7 +96,7 @@ SKIP:
my @tests =
( # opts, code, result, name, $TODO
[ "-n", "die", "bar\n", "die shouldn't touch file" ],
- [ "-n", "last", "", "last should update file", "not implemented yet" ],
+ [ "-n", "last", "", "last should update file" ],
);
our $file = tempfile() ;
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";
}
}
--
2.17.2

139
perl-5.29.5-perl-133659-move-argvout-cleanup-to-a-new-function.patch Normal file
View File

@ -0,0 +1,139 @@
From 404395d24bc87890c7d978622296b9925a347aa0 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 20 Nov 2018 15:30:20 +1100
Subject: [PATCH 1/3] (perl #133659) move argvout cleanup to a new function
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
doio.c | 62 ++++++++++++++++++++++++++++++++++---------------------
embed.fnc | 1 +
embed.h | 1 +
proto.h | 3 +++
4 files changed, 43 insertions(+), 24 deletions(-)
diff --git a/doio.c b/doio.c
index 8d9131cc85..77421de1d1 100644
--- a/doio.c
+++ b/doio.c
@@ -1526,31 +1526,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 +1700,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 2ed2cc32b9..408917e0a7 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 4cc97126bd..ffa5b1d581 100644
--- a/embed.h
+++ b/embed.h
@@ -1755,6 +1755,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 e57df2f206..061a9d72a0 100644
--- a/proto.h
+++ b/proto.h
@@ -4752,6 +4752,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)
--
2.17.2

60
perl-5.29.5-perl-133659-tests-for-global-destruction-handling-of.patch Normal file
View File

@ -0,0 +1,60 @@
From 640e129d0fc499d24a759cacae9240a32c66fa51 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 20 Nov 2018 16:43:43 +1100
Subject: [PATCH 2/3] (perl #133659) tests for global destruction handling of
inplace editing
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/io/inplace.t | 28 +++++++++++++++++++++++++++-
1 file changed, 27 insertions(+), 1 deletion(-)
diff --git a/t/io/inplace.t b/t/io/inplace.t
index 98159e06bf..ac50f1ab77 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", "not implemented yet" ],
+ );
+ 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);
+ }
+}
--
2.17.2

12
perl.spec
View File

@ -205,6 +205,12 @@ Patch33: perl-5.29.3-Accept-also-ESTALE-fix-for-RT-133534.patch
# Fix an undefined behaviour in S_hv_delete_common(), in upstream after 5.29.5
Patch34: perl-5.29.5-S_hv_delete_common-avoid-undefined-behaviour.patch
# Fix in-place edit to replace files on a successful perl exit status,
# bug #1650041, RT#133659, in upstream after 5.29.5
Patch35: perl-5.29.5-perl-133659-move-argvout-cleanup-to-a-new-function.patch
Patch36: perl-5.29.5-perl-133659-tests-for-global-destruction-handling-of.patch
Patch37: perl-5.29.5-perl-133659-make-an-in-place-edit-successful-if-the-.patch
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@ -2790,6 +2796,9 @@ Perl extension for Version Objects
%patch32 -p1
%patch33 -p1
%patch34 -p1
%patch35 -p1
%patch36 -p1
%patch37 -p1
%patch200 -p1
%patch201 -p1
@ -2825,6 +2834,7 @@ perl -x patchlevel.h \
'Fedora Patch31: Fix script run matching to allow ASCII digits in scripts that use their own in addition (RT#133547)' \
'Fedora Patch33: Fix PathTools tests to cope with ESTALE error (RT#133534)' \
'Fedora Patch34: Fix an undefined behaviour in S_hv_delete_common()' \
'Fedora Patch35: Fix in-place edit to replace files on a successful perl exit status (bug #1650041)' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@ -5118,6 +5128,8 @@ popd
addition (RT#133547)
- Fix PathTools tests to cope with ESTALE error (RT#133534)
- Fix an undefined behaviour in S_hv_delete_common()
- Fix in-place edit to replace files on a successful perl exit status
(bug #1650041)
* Fri Nov 30 2018 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.28.1-426
- 5.28.1 bump