silence -Wformat-nonliteral compiler warnings

Due to the security risks associated with user-supplied formats
being passed to C-level printf() style functions (eg %n),
gcc has a -Wformat-nonliteral warning that complains whenever such a
function is passed a non-literal format string.

This commit silences all such warnings in core and ext/.

The main changes are

1) the 'f' (format) flag in embed.fnc is now handled slightly more
cleverly. Rather than just applying to functions whose last arg is '...'
(and where the format arg is assumed to be the previous arg), it
can now handle non-'...' functions: arg checking is disabled, but format
checking is sill done: it works by assuming that an arg called 'fmt',
'pat' or 'f' is the format string (and dies if fails to find exactly one
such arg).

2) with the new embed.fnc functionally, more functions have been marked
with the 'f' flag. When such a function passes its fmt arg onto an inner
printf-like function, we simply disable the warning for that call using
GCC_DIAG_IGNORE(-Wformat-nonliteral), since we know that the caller must
have already checked it.

3) In quite a few places the format string isn't literal, but it *is*
constant (e.g. PL_warn_uninit_sv). For those cases, again disable the
warning.

4) In pp_formline(), a particular format was was one of several different
literal strings depending on circumstances. Rather than assigning this
string to a temporary variable, incorporate the ?: branches directly in
the function call arg. gcc is clever enough to decide the arg is then
always literal.

diff --git a/doio.c b/doio.c
index 3ee975d..4c929b1 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -545,7 +545,11 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
            && strchr(oname, '\n')
            
        )
+        {
+            GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+            GCC_DIAG_RESTORE;
+        }
        goto say_false;
     }
 
@@ -1324,8 +1328,11 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
        PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_stat(s, &PL_statcache);
-       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
+       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n')) {
+            GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
+            GCC_DIAG_RESTORE;
+        }
        return PL_laststatval;
     }
 }
@@ -1384,8 +1391,11 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
     file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
-       Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n')) {
+        GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
+        Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+        GCC_DIAG_RESTORE;
+    }
     return PL_laststatval;
 }
 

diff --git a/embed.fnc b/embed.fnc
index abb2b1b..c0fd92d 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1502,7 +1502,7 @@ EXMp      |void   |_invlist_dump  |NN PerlIO *file|I32 level   \
                                |NN SV* const invlist
 #endif
 Ap     |void   |taint_env
-Ap     |void   |taint_proper   |NULLOK const char* f|NN const char *const s
+Afp    |void   |taint_proper   |NULLOK const char* f|NN const char *const s
 Apd    |UV     |to_utf8_case   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp \
                                |NN SV **swashp|NN const char *normal|NULLOK const char *special
 Abmd   |UV     |to_utf8_lower  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
@@ -2319,7 +2319,7 @@ s |void   |strip_return   |NN SV *sv
 #  endif
 #  if defined(DEBUGGING)
 s      |int    |tokereport     |I32 rv|NN const YYSTYPE* lvalp
-s      |void   |printbuf       |NN const char *const fmt|NN const char *const s
+sf     |void   |printbuf       |NN const char *const fmt|NN const char *const s
 #  endif
 #endif
 EXMp   |bool   |validate_proto |NN SV *name|NULLOK SV *proto|bool warn

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 6caea48..3e77eb4 100644 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1686,7 +1686,14 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
        int             isdst
     CODE:
        {
-           char *buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
+           char *buf;
+
+            /* allowing user-supplied (rather than literal) formats
+             * is normally frowned upon as a potential security risk;
+             * but this is part of the API so we have to allow it */
+            GCC_DIAG_IGNORE(-Wformat-nonliteral);
+           buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
+            GCC_DIAG_RESTORE;
            if (buf) {
                SV *const sv = sv_newmortal();
                sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);

diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index 68c0688..0dd8475 100644 (file)
--- a/ext/POSIX/lib/POSIX.pm
+++ b/ext/POSIX/lib/POSIX.pm
@@ -4,7 +4,7 @@ use warnings;
 
 our ($AUTOLOAD, %SIGRT);
 
-our $VERSION = '1.36';
+our $VERSION = '1.37';
 
 require XSLoader;
 

diff --git a/pp_ctl.c b/pp_ctl.c
index 95727f2..01b3b9c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -479,7 +479,6 @@ PP(pp_formline)
     STRLEN linemax;        /* estimate of output size in bytes */
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
-    const char *fmt;
     MAGIC *mg = NULL;
     U8 *source;                    /* source of bytes to append */
     STRLEN to_copy;        /* how may bytes to append */
@@ -795,28 +794,13 @@ PP(pp_formline)
            }
 
        case FF_0DECIMAL: /* like FF_DECIMAL but for 0### */
-           arg = *fpc++;
-#if defined(USE_LONG_DOUBLE)
-           fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ?
-                "%#0*.*" PERL_PRIfldbl : "%0*.*" PERL_PRIfldbl);
-#else
-           fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ?
-                "%#0*.*f"              : "%0*.*f");
-#endif
-           goto ff_dec;
-
        case FF_DECIMAL: /* do @##, ^##, where <arg>=(precision|flags) */
+        {
+            I32 form_num_point;
+
            arg = *fpc++;
-#if defined(USE_LONG_DOUBLE)
-           fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ? "%#*.*" PERL_PRIfldbl : "%*.*" PERL_PRIfldbl);
-#else
-            fmt = (const char *)
-               ((arg & FORM_NUM_POINT) ? "%#*.*f"              : "%*.*f");
-#endif
-       ff_dec:
+            form_num_point = (arg & FORM_NUM_POINT);
+
            /* If the field is marked with ^ and the value is undefined,
               blank it out. */
            if ((arg & FORM_NUM_BLANK) && !SvOK(sv)) {
@@ -838,11 +822,34 @@ PP(pp_formline)
            {
                STORE_NUMERIC_STANDARD_SET_LOCAL();
                arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
-               my_snprintf(t, SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)), fmt, (int) fieldsize, (int) arg, value);
+               my_snprintf(t,
+                            SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)),
+                            (fpc[-2] == FF_0DECIMAL)
+                            ?
+                                form_num_point
+#if defined(USE_LONG_DOUBLE)
+                                    ? "%#0*.*" PERL_PRIfldbl
+                                    : "%0*.*" PERL_PRIfldbl
+#else
+                                   ? "%#0*.*f"
+                                    : "%0*.*f"
+#endif
+                            :
+                                form_num_point
+#if defined(USE_LONG_DOUBLE)
+                                    ? "%#*.*" PERL_PRIfldbl
+                                    : "%*.*" PERL_PRIfldbl
+#else
+                                    ? "%#*.*f"
+                                    : "%*.*f"
+#endif
+                            , (int) fieldsize, (int) arg, value);
+
                RESTORE_NUMERIC_STANDARD();
            }
            t += fieldsize;
            break;
+        }
 
        case FF_NEWLINE: /* delete trailing spaces, then append \n */
            f++;

diff --git a/pp_sys.c b/pp_sys.c
index 78308f4..6f4c198 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2814,8 +2814,14 @@ PP(pp_stat)
        else
            PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
        if (PL_laststatval < 0) {
-           if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
+           if (ckWARN(WARN_NEWLINE) &&
+                    strchr(SvPV_nolen_const(PL_statname), '\n'))
+            {
+                /* PL_warn_nl is constant */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
+                GCC_DIAG_RESTORE;
+            }
            max = 0;
        }
     }
@@ -3357,7 +3363,12 @@ PP(pp_fttext)
            }
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
                                               '\n'))
+            {
+                /* PL_warn_nl is constant */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+                GCC_DIAG_RESTORE;
+            }
            FT_RETURNUNDEF;
        }
        PL_laststype = OP_STAT;

diff --git a/proto.h b/proto.h
index 80dfa5a..83a99e1 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2681,7 +2681,7 @@ PERL_CALLCONV int Perl_my_socketpair(int family, int type, int protocol, int fd[
 /* PERL_CALLCONV I32   Perl_my_stat(pTHX); */
 PERL_CALLCONV I32      Perl_my_stat_flags(pTHX_ const U32 flags);
 PERL_CALLCONV char *   Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, int mon, int year, int wday, int yday, int isdst)
-                       __attribute__format__null_ok__(__strftime__,pTHX_1,0)
+                       __attribute__format__(__strftime__,pTHX_1,0)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_MY_STRFTIME   \
        assert(fmt)
@@ -4647,6 +4647,7 @@ PERL_CALLCONV void        Perl_sys_init3(int* argc, char*** argv, char*** env)
 PERL_CALLCONV void     Perl_sys_term(void);
 PERL_CALLCONV void     Perl_taint_env(pTHX);
 PERL_CALLCONV void     Perl_taint_proper(pTHX_ const char* f, const char *const s)
+                       __attribute__format__null_ok__(__printf__,pTHX_1,0)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_TAINT_PROPER  \
        assert(s)
@@ -5343,6 +5344,7 @@ STATIC void       S_del_sv(pTHX_ SV *p)
 #  endif
 #  if defined(PERL_IN_TOKE_C)
 STATIC void    S_printbuf(pTHX_ const char *const fmt, const char *const s)
+                       __attribute__format__(__printf__,pTHX_1,0)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_PRINTBUF      \

diff --git a/regen/embed.pl b/regen/embed.pl
index 6571aec..07438de 100755 (executable)
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -179,17 +179,31 @@ my ($embed, $core, $ext, $api) = setup_embed();
        }
        if( $flags =~ /f/ ) {
            my $prefix  = $has_context ? 'pTHX_' : '';
-           my $args    = scalar @args;
-           my $pat     = $args - 1;
-           my $macro   = @nonnull && $nonnull[-1] == $pat  
+           my ($args, $pat);
+           if ($args[-1] eq '...') {
+               $args   = scalar @args;
+               $pat    = $args - 1;
+               $args   = $prefix . $args;
+           }
+           else {
+               # don't check args, and guess which arg is the pattern
+               # (one of 'fmt', 'pat', 'f'),
+               $args = 0;
+               my @fmts = grep $args[$_] =~ /\b(f|pat|fmt)$/, 0..$#args;
+               if (@fmts != 1) {
+                   die "embed.pl: '$plain_func': can't determine pattern arg\n";
+               }
+               $pat = $fmts[0] + 1;
+           }
+           my $macro   = grep($_ == $pat, @nonnull)
                                ? '__attribute__format__'
                                : '__attribute__format__null_ok__';
            if ($plain_func =~ /strftime/) {
                push @attrs, sprintf "%s(__strftime__,%s1,0)", $macro, $prefix;
            }
            else {
-               push @attrs, sprintf "%s(__printf__,%s%d,%s%d)", $macro,
-                                   $prefix, $pat, $prefix, $args;
+               push @attrs, sprintf "%s(__printf__,%s%d,%s)", $macro,
+                                   $prefix, $pat, $args;
            }
        }
        if ( @nonnull ) {

diff --git a/sv.c b/sv.c
index 7507056..b873110 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -11390,6 +11390,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 }
 #endif
 
+                /* hopefully the above makes ptr a very constrained format
+                 * that is safe to use, even though it's not literal */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);
 #if defined(HAS_LONG_DOUBLE)
                elen = ((intsize == 'q')
                        ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
@@ -11397,6 +11400,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 #else
                elen = my_sprintf(PL_efloatbuf, ptr, nv);
 #endif
+                GCC_DIAG_RESTORE;
            }
        float_converted:
            eptr = PL_efloatbuf;
@@ -14810,14 +14814,21 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv)
            if (varname)
                sv_insert(varname, 0, 0, " ", 1);
        }
+        /* PL_warn_uninit_sv is constant */
+        GCC_DIAG_IGNORE(-Wformat-nonliteral);
        /* diag_listed_as: Use of uninitialized value%s */
        Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit_sv,
                SVfARG(varname ? varname : &PL_sv_no),
                " in ", OP_DESC(PL_op));
+        GCC_DIAG_RESTORE;
     }
-    else
+    else {
+        /* PL_warn_uninit is constant */
+        GCC_DIAG_IGNORE(-Wformat-nonliteral);
        Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit,
                    "", "", "");
+        GCC_DIAG_RESTORE;
+    }
 }
 
 /*

diff --git a/taint.c b/taint.c
index e24f4f9..63f0dfc 100644 (file)
--- a/taint.c
+++ b/taint.c
@@ -54,12 +54,16 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s)
             ug = " while running with -t switch";
         else
            ug = " while running with -T switch";
+
+        GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
        if (PL_unsafe || TAINT_WARN_get) {
            Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug);
         }
         else {
             Perl_croak(aTHX_ f, s, ug);
         }
+        GCC_DIAG_RESTORE;
+
     }
 }
 

diff --git a/toke.c b/toke.c
index 8a53596..6e30000 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -482,7 +482,9 @@ S_printbuf(pTHX_ const char *const fmt, const char *const s)
 
     PERL_ARGS_ASSERT_PRINTBUF;
 
+    GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
     PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
+    GCC_DIAG_RESTORE;
     SvREFCNT_dec(tmp);
 }
 
@@ -7606,8 +7608,13 @@ Perl_yylex(pTHX)
                            while (isLOWER(*d))
                                d++;
                            if (!*d && !gv_stashpv(PL_tokenbuf, UTF ? SVf_UTF8 : 0))
+                            {
+                                /* PL_warn_reserved is constant */
+                                GCC_DIAG_IGNORE(-Wformat-nonliteral);
                                Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
                                       PL_tokenbuf);
+                                GCC_DIAG_RESTORE;
+                            }
                        }
                    }
                }
@@ -9040,10 +9047,14 @@ S_pending_ident(pTHX)
             tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
         }
         else {
-            if (has_colon)
+            if (has_colon) {
+                /* PL_no_myglob is constant */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);
                 yyerror_pv(Perl_form(aTHX_ PL_no_myglob,
                            PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf),
                             UTF ? SVf_UTF8 : 0);
+                GCC_DIAG_RESTORE;
+            }
 
             pl_yylval.opval = newOP(OP_PADANY, 0);
             pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,

diff --git a/util.c b/util.c
index fd053cd..2b075c9 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3686,7 +3686,11 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in
 #endif
   buflen = 64;
   Newx(buf, buflen, char);
+
+  GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
   len = strftime(buf, buflen, fmt, &mytm);
+  GCC_DIAG_RESTORE;
+
   /*
   ** The following is needed to handle to the situation where
   ** tmpbuf overflows.  Basically we want to allocate a buffer
@@ -3710,7 +3714,11 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in
 
     Renew(buf, bufsize, char);
     while (buf) {
+
+      GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
       buflen = strftime(buf, bufsize, fmt, &mytm);
+      GCC_DIAG_RESTORE;
+
       if (buflen > 0 && buflen < bufsize)
        break;
       /* heuristic to prevent out-of-memory errors */