This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix stack corruption by unsupported filetests
authorJan Dubois <jand@activestate.com>
Fri, 20 Aug 2010 01:43:59 +0000 (18:43 -0700)
committerJan Dubois <jand@activestate.com>
Fri, 20 Aug 2010 01:45:57 +0000 (18:45 -0700)
Commit c410dd6ad7 indiscriminately pops elements from the stack
even when nothing has been pushed: file tests without arguments
(testing $_) and stacked filetests don't have anything on the
stack that needs to be removed.

The general idea is that we need to have the same side effects
as if we had called my_stat_flags(), so we shall only call POPs
under the same conditions as the code in my_stat_flags().

pp_sys.c

index ec82610..0f5a3fd 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3216,29 +3216,32 @@ PP(pp_ftrowned)
     }
     tryAMAGICftest_MG(opchar);
 
+    STACKED_FTEST_CHECK;
+
     /* I believe that all these three are likely to be defined on most every
        system these days.  */
 #ifndef S_ISUID
     if(PL_op->op_type == OP_FTSUID) {
-       (void) POPs;
+       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
+           (void) POPs;
        RETPUSHNO;
     }
 #endif
 #ifndef S_ISGID
     if(PL_op->op_type == OP_FTSGID) {
-       (void) POPs;
+       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
+           (void) POPs;
        RETPUSHNO;
     }
 #endif
 #ifndef S_ISVTX
     if(PL_op->op_type == OP_FTSVTX) {
-       (void) POPs;
+       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
+           (void) POPs;
        RETPUSHNO;
     }
 #endif
 
-    STACKED_FTEST_CHECK;
-
     result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)