diff options
| -rw-r--r-- | doio.c | 16 | ||||
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 9 | ||||
| -rw-r--r-- | ext/POSIX/lib/POSIX.pm | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 51 | ||||
| -rw-r--r-- | pp_sys.c | 13 | ||||
| -rw-r--r-- | proto.h | 4 | ||||
| -rwxr-xr-x | regen/embed.pl | 24 | ||||
| -rw-r--r-- | sv.c | 13 | ||||
| -rw-r--r-- | taint.c | 4 | ||||
| -rw-r--r-- | toke.c | 13 | ||||
| -rw-r--r-- | util.c | 8 |
12 files changed, 123 insertions, 38 deletions
@@ -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; } @@ -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 6caea489bf..3e77eb4483 100644 --- 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 68c0688164..0dd8475eaf 100644 --- 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; @@ -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++; @@ -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; @@ -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 6571aecd45..07438de43d 100755 --- 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 ) { @@ -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; + } } /* @@ -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; + } } @@ -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, @@ -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 */ |