Remove gete?[ug]id caching
authorÆvar Arnfjörð Bjarmason <avar@cpan.org>
Sun, 12 Feb 2012 18:56:35 +0000 (18:56 +0000)
committerÆvar Arnfjörð Bjarmason <avar@cpan.org>
Sat, 18 Feb 2012 23:39:38 +0000 (23:39 +0000)
Currently we cache the UID/GID and effective UID/GID similarly to how
we used to cache getpid() before v5.14.0-251-g0e21945. Remove this
magical behavior in favor of always calling getpid(), getgid()
etc. This resolves RT #96208.

A minimal testcase for this is the following by Leon Timmermans
attached to RT #96208:

    eval { require 'syscall.ph'; 1 } or eval { require 'sys/syscall.ph'; 1 } or die $@;

    if (syscall(&SYS_setuid, $ARGV[0] + 0 || 1000) >= 0 or die "$!") {
            printf "\$< = %d, getuid = %d\n", $<, syscall(&SYS_getuid);
    }

I.e. if we call the sete?[ug]id() functions unbeknownst to perl the
$<, $>, $( and $) variables won't be updated. This results in the same
sort of issues we had with $$ before v5.14.0-251-g0e21945, and
getppid() before my v5.15.7-407-gd7c042c patch.

I'm completely eliminating the PL_egid, PL_euid, PL_gid and PL_uid
variables as part of this patch, this will break some CPAN modules,
but it'll be really easy before the v5.16.0 final to reinstate
them. I'd like to remove them to see what breaks, and how easy it is
to fix it.

These variables are not part of the public API, and the modules using
them could either use the Perl_gete?[ug]id() functions or are working
around the bug I'm fixing with this commit.

The new PL_delaymagic_(egid|euid|gid|uid) variables I'm adding are
*only* intended to be used internally in the interpreter to facilitate
the delaymagic in Perl_pp_sassign. There's probably some way not to
export these to programs that embed perl, but I haven't found out how
to do that.

12 files changed:
doio.c
embedvar.h
ext/POSIX/POSIX.xs
intrpvar.h
mg.c
perl.c
perlio.c
pod/perldelta.pod
pp_hot.c
pp_sys.c
sv.c
taint.c

diff --git a/doio.c b/doio.c
index 081fdf2..5d54a9b 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1771,7 +1771,7 @@ nothing in the core.
        while (++mark <= sp) {
            s = SvPV_nolen_const(*mark);
            APPLY_TAINT_PROPER();
-           if (PL_euid || PL_unsafe) {
+           if (PerlProc_geteuid() || PL_unsafe) {
                if (UNLINK(s))
                    tot--;
            }
@@ -1909,7 +1909,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
 # ifdef __CYGWIN__
     if (ingroup(544,effective)) {     /* member of Administrators */
 # else
-    if ((effective ? PL_euid : PL_uid) == 0) { /* root is special */
+    if ((effective ? PerlProc_geteuid() : PerlProc_getuid()) == 0) {   /* root is special */
 # endif
        if (mode == S_IXUSR) {
            if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
@@ -1919,7 +1919,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
            return TRUE;                /* root reads and writes anything */
        return FALSE;
     }
-    if (statbufp->st_uid == (effective ? PL_euid : PL_uid) ) {
+    if (statbufp->st_uid == (effective ? PerlProc_geteuid() : PerlProc_getuid()) ) {
        if (statbufp->st_mode & mode)
            return TRUE;        /* ok as "user" */
     }
@@ -1938,7 +1938,7 @@ static bool
 S_ingroup(pTHX_ Gid_t testgid, bool effective)
 {
     dVAR;
-    if (testgid == (effective ? PL_egid : PL_gid))
+    if (testgid == (effective ? PerlProc_getegid() : PerlProc_getgid()))
        return TRUE;
 #ifdef HAS_GETGROUPS
     {
index 81d28e7..24d99e9 100644 (file)
 #define PL_defoutgv            (vTHX->Idefoutgv)
 #define PL_defstash            (vTHX->Idefstash)
 #define PL_delaymagic          (vTHX->Idelaymagic)
+#define PL_delaymagic_egid     (vTHX->Idelaymagic_egid)
+#define PL_delaymagic_euid     (vTHX->Idelaymagic_euid)
+#define PL_delaymagic_gid      (vTHX->Idelaymagic_gid)
+#define PL_delaymagic_uid      (vTHX->Idelaymagic_uid)
 #define PL_destroyhook         (vTHX->Idestroyhook)
 #define PL_diehook             (vTHX->Idiehook)
 #define PL_doswitches          (vTHX->Idoswitches)
 #define PL_e_script            (vTHX->Ie_script)
 #define PL_efloatbuf           (vTHX->Iefloatbuf)
 #define PL_efloatsize          (vTHX->Iefloatsize)
-#define PL_egid                        (vTHX->Iegid)
 #define PL_encoding            (vTHX->Iencoding)
 #define PL_endav               (vTHX->Iendav)
 #define PL_envgv               (vTHX->Ienvgv)
 #define PL_errgv               (vTHX->Ierrgv)
 #define PL_errors              (vTHX->Ierrors)
-#define PL_euid                        (vTHX->Ieuid)
 #define PL_eval_root           (vTHX->Ieval_root)
 #define PL_eval_start          (vTHX->Ieval_start)
 #define PL_evalseq             (vTHX->Ievalseq)
 #define PL_formtarget          (vTHX->Iformtarget)
 #define PL_generation          (vTHX->Igeneration)
 #define PL_gensym              (vTHX->Igensym)
-#define PL_gid                 (vTHX->Igid)
 #define PL_glob_index          (vTHX->Iglob_index)
 #define PL_globalstash         (vTHX->Iglobalstash)
 #define PL_globhook            (vTHX->Iglobhook)
 #define PL_tmps_stack          (vTHX->Itmps_stack)
 #define PL_top_env             (vTHX->Itop_env)
 #define PL_toptarget           (vTHX->Itoptarget)
-#define PL_uid                 (vTHX->Iuid)
 #define PL_unicode             (vTHX->Iunicode)
 #define PL_unitcheckav         (vTHX->Iunitcheckav)
 #define PL_unitcheckav_save    (vTHX->Iunitcheckav_save)
index 7e30a82..681532c 100644 (file)
@@ -1907,24 +1907,10 @@ sleep(seconds)
 SysRet
 setgid(gid)
        Gid_t           gid
-    CLEANUP:
-#ifndef WIN32
-       if (RETVAL >= 0) {
-           PL_gid  = getgid();
-           PL_egid = getegid();
-       }
-#endif
 
 SysRet
 setuid(uid)
        Uid_t           uid
-    CLEANUP:
-#ifndef WIN32
-       if (RETVAL >= 0) {
-           PL_uid  = getuid();
-           PL_euid = geteuid();
-       }
-#endif
 
 SysRetLong
 sysconf(name)
index 273da46..cc9e46e 100644 (file)
@@ -464,10 +464,10 @@ PERLVARI(I, in_clean_all, bool,    FALSE) /* ptrs to freed SVs now legal */
 PERLVAR(I, nomemok,    bool)           /* let malloc context handle nomem */
 PERLVARI(I, savebegin, bool,   FALSE)  /* save BEGINs for compiler     */
 
-PERLVAR(I, uid,                Uid_t)          /* current real user id */
-PERLVAR(I, euid,       Uid_t)          /* current effective user id */
-PERLVAR(I, gid,                Gid_t)          /* current real group id */
-PERLVAR(I, egid,       Gid_t)          /* current effective group id */
+PERLVAR(I, delaymagic_uid,     Uid_t)  /* current real user id, only for delaymagic */
+PERLVAR(I, delaymagic_euid,    Uid_t)  /* current effective user id, only for delaymagic */
+PERLVAR(I, delaymagic_gid,     Gid_t)  /* current real group id, only for delaymagic */
+PERLVAR(I, delaymagic_egid,    Gid_t)  /* current effective group id, only for delaymagic */
 PERLVARI(I, an,                U32,    0)      /* malloc sequence number */
 
 #ifdef DEBUGGING
diff --git a/mg.c b/mg.c
index 14e9705..b8ef4cc 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1109,16 +1109,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        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
        {
@@ -2795,89 +2795,94 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
        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(my_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);
@@ -2893,7 +2898,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
             while (isSPACE(*p))
                 ++p;
-            PL_egid = Atol(p);
+            new_egid = Atol(p);
             for (i = 0; i < maxgrp; ++i) {
                 while (*p && !isSPACE(*p))
                     ++p;
@@ -2912,32 +2917,32 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            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;
diff --git a/perl.c b/perl.c
index c384e6d..b238d04 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3754,13 +3754,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp)
 {
     PERL_ARGS_ASSERT_VALIDATE_SUID;
 
-    if (PL_euid != PL_uid || PL_egid != PL_gid) {      /* (suidperl doesn't exist, in fact) */
+    const UV  my_uid = PerlProc_getuid();
+    const UV my_euid = PerlProc_geteuid();
+    const UV  my_gid = PerlProc_getgid();
+    const UV my_egid = PerlProc_getegid();
+
+    if (my_euid != my_uid || my_egid != my_gid) {      /* (suidperl doesn't exist, in fact) */
        dVAR;
 
        PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
-       if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
+       if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
            ||
-           (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
+           (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
           )
            if (!PL_do_undump)
                Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
@@ -3804,17 +3809,14 @@ STATIC void
 S_init_ids(pTHX)
 {
     dVAR;
-    PL_uid = PerlProc_getuid();
-    PL_euid = PerlProc_geteuid();
-    PL_gid = PerlProc_getgid();
-    PL_egid = PerlProc_getegid();
-#ifdef VMS
-    PL_uid |= PL_gid << 16;
-    PL_euid |= PL_egid << 16;
-#endif
+    const UV my_uid = PerlProc_getuid();
+    const UV my_euid = PerlProc_geteuid();
+    const UV my_gid = PerlProc_getgid();
+    const UV my_egid = PerlProc_getegid();
+
     /* Should not happen: */
-    CHECK_MALLOC_TAINT(PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
-    PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
+    CHECK_MALLOC_TAINT(my_uid && (my_euid != my_uid || my_egid != my_gid));
+    PL_tainting |= (my_uid && (my_euid != my_uid || my_egid != my_gid));
     /* BUG */
     /* PSz 27 Feb 04
      * Should go by suidscript, not uid!=euid: why disallow
@@ -3880,9 +3882,9 @@ S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */
     }
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-    if (PL_euid != PL_uid)
+    if (PerlProc_getuid() != PerlProc_geteuid())
         Perl_croak(aTHX_ "No %s allowed while running setuid", message);
-    if (PL_egid != PL_gid)
+    if (PerlProc_getgid() != PerlProc_getegid())
         Perl_croak(aTHX_ "No %s allowed while running setgid", message);
 #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
     if (suidscript)
@@ -4566,7 +4568,8 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags)
                    /* And this is the new libdir.  */
                    libdir = tempsv;
                    if (PL_tainting &&
-                       (PL_uid != PL_euid || PL_gid != PL_egid)) {
+                       (PerlProc_getuid() != PerlProc_geteuid() ||
+                        PerlProc_getgid() != PerlProc_getegid())) {
                        /* Need to taint relocated paths if running set ID  */
                        SvTAINTED_on(libdir);
                    }
index 592a094..7782728 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -458,7 +458,9 @@ PerlIO_debug(const char *fmt, ...)
     dSYS;
     va_start(ap, fmt);
     if (!PL_perlio_debug_fd) {
-       if (!PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
+       if (!PL_tainting &&
+           PerlProc_getuid() == PerlProc_geteuid() &&
+           PerlProc_getgid() == PerlProc_getegid()) {
            const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
            if (s && *s)
                PL_perlio_debug_fd
index aaf6027..7c26831 100644 (file)
@@ -226,6 +226,26 @@ cached version of it.
 
 See the documentation for L<$$|perlvar/$$> for details.
 
+=head2 C<< $< >>, C<< $> >>, C<$(> and C<$)> are no longer cached
+
+Similarly to the changes to C<$$> and C<getppid()> the internal
+caching of C<< $< >>, C<< $> >>, C<$(> and C<$)> has been removed.
+
+When we cached these values our idea of what they were would drift out
+of sync with reality if someone (e.g. someone embedding perl) called
+sete?[ug]id() without updating C<PL_e?[ug]id>. Having to deal with
+this complexity wasn't worth it given how cheap the C<gete?[ug]id()>
+system call is.
+
+This change will break a handful of CPAN modules that use the XS-level
+C<PL_uid>, C<PL_gid>, C<PL_euid> or C<PL_egid> variables.
+
+The fix for those breakages is to use C<PerlProc_gete?[ug]id()> to
+retrieve them (e.g. C<PerlProc_getuid()>), and not to assign to
+C<PL_e?[ug]id> if you change the UID/GID/EUID/EGID. There is no longer
+any need to do so since perl will always retrieve the up-to-date
+version of those values from the OS.
+
 =head2 Which Non-ASCII characters get quoted by C<quotemeta> and C<\Q> has changed
 
 This is unlikely to result in a real problem, as Perl does not attach
index f631640..6bf5a74 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1091,71 +1091,77 @@ PP(pp_aassign)
        }
     }
     if (PL_delaymagic & ~DM_DELAY) {
+       /* Will be used to set PL_tainting below */
+       UV tmp_uid  = PerlProc_getuid();
+       UV tmp_euid = PerlProc_geteuid();
+       UV tmp_gid  = PerlProc_getgid();
+       UV tmp_egid = PerlProc_getegid();
+
        if (PL_delaymagic & DM_UID) {
 #ifdef HAS_SETRESUID
-           (void)setresuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
-                           (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1,
+           (void)setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid  : (Uid_t)-1,
+                           (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1,
                            (Uid_t)-1);
 #else
 #  ifdef HAS_SETREUID
-           (void)setreuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
-                          (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1);
+           (void)setreuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid  : (Uid_t)-1,
+                          (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1);
 #  else
 #    ifdef HAS_SETRUID
            if ((PL_delaymagic & DM_UID) == DM_RUID) {
-               (void)setruid(PL_uid);
+               (void)setruid(PL_delaymagic_uid);
                PL_delaymagic &= ~DM_RUID;
            }
 #    endif /* HAS_SETRUID */
 #    ifdef HAS_SETEUID
            if ((PL_delaymagic & DM_UID) == DM_EUID) {
-               (void)seteuid(PL_euid);
+               (void)seteuid(PL_delaymagic_euid);
                PL_delaymagic &= ~DM_EUID;
            }
 #    endif /* HAS_SETEUID */
            if (PL_delaymagic & DM_UID) {
-               if (PL_uid != PL_euid)
+               if (PL_delaymagic_uid != PL_delaymagic_euid)
                    DIE(aTHX_ "No setreuid available");
-               (void)PerlProc_setuid(PL_uid);
+               (void)PerlProc_setuid(PL_delaymagic_uid);
            }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
-           PL_uid = PerlProc_getuid();
-           PL_euid = PerlProc_geteuid();
+           tmp_uid  = PerlProc_getuid();
+           tmp_euid = PerlProc_geteuid();
        }
        if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
-           (void)setresgid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
-                           (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1,
+           (void)setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid  : (Gid_t)-1,
+                           (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1,
                            (Gid_t)-1);
 #else
 #  ifdef HAS_SETREGID
-           (void)setregid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
-                          (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1);
+           (void)setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid  : (Gid_t)-1,
+                          (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1);
 #  else
 #    ifdef HAS_SETRGID
            if ((PL_delaymagic & DM_GID) == DM_RGID) {
-               (void)setrgid(PL_gid);
+               (void)setrgid(PL_delaymagic_gid);
                PL_delaymagic &= ~DM_RGID;
            }
 #    endif /* HAS_SETRGID */
 #    ifdef HAS_SETEGID
            if ((PL_delaymagic & DM_GID) == DM_EGID) {
-               (void)setegid(PL_egid);
+               (void)setegid(PL_delaymagic_egid);
                PL_delaymagic &= ~DM_EGID;
            }
 #    endif /* HAS_SETEGID */
            if (PL_delaymagic & DM_GID) {
-               if (PL_gid != PL_egid)
+               if (PL_delaymagic_gid != PL_delaymagic_egid)
                    DIE(aTHX_ "No setregid available");
-               (void)PerlProc_setgid(PL_gid);
+               (void)PerlProc_setgid(PL_delaymagic_gid);
            }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
-           PL_gid = PerlProc_getgid();
-           PL_egid = PerlProc_getegid();
+           tmp_gid  = PerlProc_getgid();
+           tmp_egid = PerlProc_getegid();
        }
-       PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
+       PL_tainting |= (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid));
     }
     PL_delaymagic = 0;
 
index 33b86ab..63fbd05 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3197,11 +3197,11 @@ PP(pp_ftrowned)
        FT_RETURNUNDEF;
     switch (PL_op->op_type) {
     case OP_FTROWNED:
-       if (PL_statcache.st_uid == PL_uid)
+       if (PL_statcache.st_uid == PerlProc_getuid())
            FT_RETURNYES;
        break;
     case OP_FTEOWNED:
-       if (PL_statcache.st_uid == PL_euid)
+       if (PL_statcache.st_uid == PerlProc_geteuid())
            FT_RETURNYES;
        break;
     case OP_FTZERO:
@@ -3585,7 +3585,7 @@ PP(pp_rename)
        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {
-           if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
+           if (PerlProc_geteuid() || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
                (void)UNLINK(tmps2);
            if (!(anum = link(tmps, tmps2)))
                anum = UNLINK(tmps);
diff --git a/sv.c b/sv.c
index 821376e..ec08780 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13043,10 +13043,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_in_clean_objs   = proto_perl->Iin_clean_objs;
     PL_in_clean_all    = proto_perl->Iin_clean_all;
 
-    PL_uid             = proto_perl->Iuid;
-    PL_euid            = proto_perl->Ieuid;
-    PL_gid             = proto_perl->Igid;
-    PL_egid            = proto_perl->Iegid;
+    PL_delaymagic_uid  = proto_perl->Idelaymagic_uid;
+    PL_delaymagic_euid = proto_perl->Idelaymagic_euid;
+    PL_delaymagic_gid  = proto_perl->Idelaymagic_gid;
+    PL_delaymagic_egid = proto_perl->Idelaymagic_egid;
     PL_nomemok         = proto_perl->Inomemok;
     PL_an              = proto_perl->Ian;
     PL_evalseq         = proto_perl->Ievalseq;
diff --git a/taint.c b/taint.c
index fa1366f..72bb979 100644 (file)
--- a/taint.c
+++ b/taint.c
@@ -33,8 +33,8 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s)
 
 #   if Uid_t_size == 1
     {
-       const UV  uid = PL_uid;
-       const UV euid = PL_euid;
+       const UV  uid = PerlProc_getuid();
+       const UV euid = PerlProc_geteuid();
 
        DEBUG_u(PerlIO_printf(Perl_debug_log,
                               "%s %d %"UVuf" %"UVuf"\n",
@@ -42,8 +42,8 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s)
     }
 #   else
     {
-       const IV  uid = PL_uid;
-       const IV euid = PL_euid;
+       const IV  uid = PerlProc_getuid();
+       const IV euid = PerlProc_geteuid();
 
        DEBUG_u(PerlIO_printf(Perl_debug_log,
                               "%s %d %"IVdf" %"IVdf"\n",
@@ -57,9 +57,9 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s)
 
        if (!f)
            f = PL_no_security;
-       if (PL_euid != PL_uid)
+       if (PerlProc_getuid() != PerlProc_geteuid())
            ug = " while running setuid";
-       else if (PL_egid != PL_gid)
+       else if (PerlProc_getgid() != PerlProc_getegid())
            ug = " while running setgid";
        else if (PL_taint_warn)
             ug = " while running with -t switch";