void
Perl_taint_proper(pTHX_ const char *f, const char *const s)
{
#if defined(HAS_SETEUID) && defined(DEBUGGING)
dVAR;
PERL_ARGS_ASSERT_TAINT_PROPER;
# if Uid_t_size == 1
{
const UV uid = PerlProc_getuid();
const UV euid = PerlProc_geteuid();
DEBUG_u(PerlIO_printf(Perl_debug_log,
"%s %d %"UVuf" %"UVuf"\n",
s, PL_tainted, uid, euid));
}
# else
{
const IV uid = PerlProc_getuid();
const IV euid = PerlProc_geteuid();
DEBUG_u(PerlIO_printf(Perl_debug_log,
"%s %d %"IVdf" %"IVdf"\n",
s, PL_tainted, uid, euid));
}
# endif
#endif
if (PL_tainted) {
const char *ug;
if (!f)
f = PL_no_security;
if (PerlProc_getuid() != PerlProc_geteuid())
ug = " while running setuid";
else if (PerlProc_getgid() != PerlProc_getegid())
ug = " while running setgid";
else if (PL_taint_warn)
ug = " while running with -t switch";
else
ug = " while running with -T switch";
if (PL_unsafe || PL_taint_warn) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug);
}
else {
Perl_croak(aTHX_ f, s, ug);
}
}
}
void
Perl_taint_proper(pTHX_ const char *f, const char *const s)
{
#if defined(HAS_SETEUID) && defined(DEBUGGING)
PERL_ARGS_ASSERT_TAINT_PROPER;
{
const Uid_t uid = PerlProc_getuid();
const Uid_t euid = PerlProc_geteuid();
#if Uid_t_sign == 1 /* uid_t is unsigned. */
DEBUG_u(PerlIO_printf(Perl_debug_log,
"%s %d %"UVuf" %"UVuf"\n",
s, TAINT_get, (UV)uid, (UV)euid));
#else /* uid_t is signed (Uid_t_sign == -1), or don't know. */
DEBUG_u(PerlIO_printf(Perl_debug_log,
"%s %d %"IVdf" %"IVdf"\n",
s, TAINT_get, (IV)uid, (IV)euid));
#endif
}
#endif
if (TAINT_get) {
const char *ug;
if (!f)
f = PL_no_security;
if (PerlProc_getuid() != PerlProc_geteuid())
ug = " while running setuid";
else if (PerlProc_getgid() != PerlProc_getegid())
ug = " while running setgid";
else if (TAINT_WARN_get)
ug = " while running with -t switch";
else
ug = " while running with -T switch";
/* XXX because taint_proper adds extra format args, we can't
* get the caller to check properly; o we just silence the warning
* and hope the callers aren't naughty */
GCC_DIAG_IGNORE(-Wformat-nonliteral);
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;
}
}
