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