sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
}
else if (PL_compiling.cop_warnings == pWARN_STD) {
- sv_setpvn(
- sv,
- (PL_dowarn & G_WARN_ON) ? WARN_ALLstring : WARN_NONEstring,
- WARNsize
- );
+ sv_setsv(sv, &PL_sv_undef);
+ break;
}
else if (PL_compiling.cop_warnings == pWARN_ALL) {
/* Get the bit mask for $warnings::Bits{all}, because
case '$': /* $$ */
{
IV const pid = (IV)PerlProc_getpid();
- if (isGV(mg->mg_obj) || SvIV(mg->mg_obj) != pid)
+ if (isGV(mg->mg_obj) || SvIV(mg->mg_obj) != pid) {
/* never set manually, or at least not since last fork */
sv_setiv(sv, pid);
+ /* never unsafe, even if reading in a tainted expression */
+ SvTAINTED_off(sv);
+ }
/* else a value has been assigned manually, so do nothing */
}
break;
SvNOK_on(sv); /* what a wonderful hack! */
break;
case '<':
- sv_setiv(sv, (IV)PL_uid);
+ sv_setiv(sv, (IV)PerlProc_getuid());
break;
case '>':
- sv_setiv(sv, (IV)PL_euid);
+ sv_setiv(sv, (IV)PerlProc_geteuid());
break;
case '(':
- sv_setiv(sv, (IV)PL_gid);
+ sv_setiv(sv, (IV)PerlProc_getgid());
goto add_groups;
case ')':
- sv_setiv(sv, (IV)PL_egid);
+ sv_setiv(sv, (IV)PerlProc_getegid());
add_groups:
#ifdef HAS_GETGROUPS
{
{
PERL_ARGS_ASSERT_MAGIC_CLEARPACK;
+ if (mg->mg_type == PERL_MAGIC_tiedscalar) return 0;
return magic_methpack(sv,mg,"DELETE");
}
}
else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
- if (!SvPOK(sv) && PL_localizing) {
- sv_setpvn(sv, WARN_NONEstring, WARNsize);
- PL_compiling.cop_warnings = pWARN_NONE;
+ if (!SvPOK(sv)) {
+ PL_compiling.cop_warnings = pWARN_STD;
break;
}
{
}
break;
case '<':
- PL_uid = SvIV(sv);
+ {
+ const IV new_uid = SvIV(sv);
+ PL_delaymagic_uid = new_uid;
if (PL_delaymagic) {
PL_delaymagic |= DM_RUID;
break; /* don't do magic till later */
}
#ifdef HAS_SETRUID
- (void)setruid((Uid_t)PL_uid);
+ (void)setruid((Uid_t)new_uid);
#else
#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)PL_uid, (Uid_t)-1);
+ (void)setreuid((Uid_t)new_uid, (Uid_t)-1);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)PL_uid, (Uid_t)-1, (Uid_t)-1);
+ (void)setresuid((Uid_t)new_uid, (Uid_t)-1, (Uid_t)-1);
#else
- if (PL_uid == PL_euid) { /* special case $< = $> */
+ if (new_uid == PerlProc_geteuid()) { /* special case $< = $> */
#ifdef PERL_DARWIN
/* workaround for Darwin's setuid peculiarity, cf [perl #24122] */
- if (PL_uid != 0 && PerlProc_getuid() == 0)
+ if (new_uid != 0 && PerlProc_getuid() == 0)
(void)PerlProc_setuid(0);
#endif
- (void)PerlProc_setuid(PL_uid);
+ (void)PerlProc_setuid(new_uid);
} else {
- PL_uid = PerlProc_getuid();
Perl_croak(aTHX_ "setruid() not implemented");
}
#endif
#endif
#endif
- PL_uid = PerlProc_getuid();
break;
+ }
case '>':
- PL_euid = SvIV(sv);
+ {
+ const UV new_euid = SvIV(sv);
+ PL_delaymagic_euid = new_euid;
if (PL_delaymagic) {
PL_delaymagic |= DM_EUID;
break; /* don't do magic till later */
}
#ifdef HAS_SETEUID
- (void)seteuid((Uid_t)PL_euid);
+ (void)seteuid((Uid_t)new_euid);
#else
#ifdef HAS_SETREUID
- (void)setreuid((Uid_t)-1, (Uid_t)PL_euid);
+ (void)setreuid((Uid_t)-1, (Uid_t)new_euid);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)-1, (Uid_t)PL_euid, (Uid_t)-1);
+ (void)setresuid((Uid_t)-1, (Uid_t)new_euid, (Uid_t)-1);
#else
- if (PL_euid == PL_uid) /* special case $> = $< */
- PerlProc_setuid(PL_euid);
+ if (new_euid == PerlProc_getuid()) /* special case $> = $< */
+ PerlProc_setuid(new_euid);
else {
- PL_euid = PerlProc_geteuid();
Perl_croak(aTHX_ "seteuid() not implemented");
}
#endif
#endif
#endif
- PL_euid = PerlProc_geteuid();
break;
+ }
case '(':
- PL_gid = SvIV(sv);
+ {
+ const UV new_gid = SvIV(sv);
+ PL_delaymagic_gid = new_gid;
if (PL_delaymagic) {
PL_delaymagic |= DM_RGID;
break; /* don't do magic till later */
}
#ifdef HAS_SETRGID
- (void)setrgid((Gid_t)PL_gid);
+ (void)setrgid((Gid_t)new_gid);
#else
#ifdef HAS_SETREGID
- (void)setregid((Gid_t)PL_gid, (Gid_t)-1);
+ (void)setregid((Gid_t)new_gid, (Gid_t)-1);
#else
#ifdef HAS_SETRESGID
- (void)setresgid((Gid_t)PL_gid, (Gid_t)-1, (Gid_t) -1);
+ (void)setresgid((Gid_t)new_gid, (Gid_t)-1, (Gid_t) -1);
#else
- if (PL_gid == PL_egid) /* special case $( = $) */
- (void)PerlProc_setgid(PL_gid);
+ if (new_gid == PerlProc_getegid()) /* special case $( = $) */
+ (void)PerlProc_setgid(new_gid);
else {
- PL_gid = PerlProc_getgid();
Perl_croak(aTHX_ "setrgid() not implemented");
}
#endif
#endif
#endif
- PL_gid = PerlProc_getgid();
break;
+ }
case ')':
+ {
+ UV new_egid;
#ifdef HAS_SETGROUPS
{
const char *p = SvPV_const(sv, len);
while (isSPACE(*p))
++p;
- PL_egid = Atol(p);
+ new_egid = Atol(p);
for (i = 0; i < maxgrp; ++i) {
while (*p && !isSPACE(*p))
++p;
Safefree(gary);
}
#else /* HAS_SETGROUPS */
- PL_egid = SvIV(sv);
+ new_egid = SvIV(sv);
#endif /* HAS_SETGROUPS */
+ PL_delaymagic_egid = new_egid;
if (PL_delaymagic) {
PL_delaymagic |= DM_EGID;
break; /* don't do magic till later */
}
#ifdef HAS_SETEGID
- (void)setegid((Gid_t)PL_egid);
+ (void)setegid((Gid_t)new_egid);
#else
#ifdef HAS_SETREGID
- (void)setregid((Gid_t)-1, (Gid_t)PL_egid);
+ (void)setregid((Gid_t)-1, (Gid_t)new_egid);
#else
#ifdef HAS_SETRESGID
- (void)setresgid((Gid_t)-1, (Gid_t)PL_egid, (Gid_t)-1);
+ (void)setresgid((Gid_t)-1, (Gid_t)new_egid, (Gid_t)-1);
#else
- if (PL_egid == PL_gid) /* special case $) = $( */
- (void)PerlProc_setgid(PL_egid);
+ if (new_egid == PerlProc_getgid()) /* special case $) = $( */
+ (void)PerlProc_setgid(new_egid);
else {
- PL_egid = PerlProc_getegid();
Perl_croak(aTHX_ "setegid() not implemented");
}
#endif
#endif
#endif
- PL_egid = PerlProc_getegid();
break;
+ }
case ':':
PL_chopset = SvPV_force(sv,len);
break;
PERL_ARGS_ASSERT_MAGIC_CLEARHINT;
PERL_UNUSED_ARG(sv);
- assert(mg->mg_len == HEf_SVKEY);
-
- PERL_UNUSED_ARG(sv);
-
PL_hints |= HINT_LOCALIZE_HH;
CopHINTHASH_set(&PL_compiling,
- cophh_delete_sv(CopHINTHASH_get(&PL_compiling),
- MUTABLE_SV(mg->mg_ptr), 0, 0));
+ mg->mg_len == HEf_SVKEY
+ ? cophh_delete_sv(CopHINTHASH_get(&PL_compiling),
+ MUTABLE_SV(mg->mg_ptr), 0, 0)
+ : cophh_delete_pvn(CopHINTHASH_get(&PL_compiling),
+ mg->mg_ptr, mg->mg_len, 0, 0));
return 0;
}
return 0;
}
+int
+Perl_magic_copycallchecker(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
+ const char *name, I32 namlen)
+{
+ MAGIC *nmg;
+
+ PERL_ARGS_ASSERT_MAGIC_COPYCALLCHECKER;
+ PERL_UNUSED_ARG(name);
+ PERL_UNUSED_ARG(namlen);
+
+ sv_magic(nsv, &PL_sv_undef, mg->mg_type, NULL, 0);
+ nmg = mg_find(nsv, mg->mg_type);
+ if (nmg->mg_flags & MGf_REFCOUNTED) SvREFCNT_dec(nmg->mg_obj);
+ nmg->mg_ptr = mg->mg_ptr;
+ nmg->mg_obj = SvREFCNT_inc_simple(mg->mg_obj);
+ nmg->mg_flags |= MGf_REFCOUNTED;
+ return 1;
+}
+
/*
* Local variables:
* c-indentation-style: bsd