PL_ scheme Builds under Minw32 - some SEGFAULT snags
Nick Ing-Simmons [Sat, 18 Jul 1998 20:56:58 +0000 (20:56 +0000)]
p4raw-id: //depot/ansiperl@1537

doio.c
mg.c
perl.c
pp_hot.c
pp_sys.c
util.c
win32/perllib.c
win32/win32.c
win32/win32.h

diff --git a/doio.c b/doio.c
index e13b99a..1d852d3 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -301,7 +301,7 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
 #ifdef S_IFMT
            !(PL_statbuf.st_mode & S_IFMT)
 #else
-           !statbuf.st_mode
+           !PL_statbuf.st_mode
 #endif
        ) {
            char tmpbuf[256];
@@ -388,7 +388,7 @@ nextargv(register GV *gv)
 #ifdef HAS_FCHMOD
        (void)fchmod(PL_lastfd,PL_filemode);
 #else
-       (void)PerlLIO_chmod(oldname,filemode);
+       (void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #endif
     }
     PL_filemode = 0;
@@ -408,8 +408,8 @@ nextargv(register GV *gv)
                    return IoIFP(GvIOp(gv));
                }
 #ifndef FLEXFILENAMES
-               filedev = statbuf.st_dev;
-               fileino = statbuf.st_ino;
+               filedev = PL_statbuf.st_dev;
+               fileino = PL_statbuf.st_ino;
 #endif
                PL_filemode = PL_statbuf.st_mode;
                fileuid = PL_statbuf.st_uid;
@@ -437,9 +437,9 @@ nextargv(register GV *gv)
                        sv_catpv(sv,PL_inplace);
                    }
 #ifndef FLEXFILENAMES
-                   if (PerlLIO_stat(SvPVX(sv),&statbuf) >= 0
-                     && statbuf.st_dev == filedev
-                     && statbuf.st_ino == fileino
+                   if (PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
+                     && PL_statbuf.st_dev == filedev
+                     && PL_statbuf.st_ino == fileino
 #ifdef DJGPP
                       || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
 #endif
@@ -461,18 +461,18 @@ nextargv(register GV *gv)
 #else
                    do_close(gv,FALSE);
                    (void)PerlLIO_unlink(SvPVX(sv));
-                   (void)PerlLIO_rename(oldname,SvPVX(sv));
-                   do_open(gv,SvPVX(sv),SvCUR(sv),inplace!=0,0,0,Nullfp);
+                   (void)PerlLIO_rename(PL_oldname,SvPVX(sv));
+                   do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,0,0,Nullfp);
 #endif /* DOSISH */
 #else
                    (void)UNLINK(SvPVX(sv));
-                   if (link(oldname,SvPVX(sv)) < 0) {
+                   if (link(PL_oldname,SvPVX(sv)) < 0) {
                        warn("Can't rename %s to %s: %s, skipping file",
-                         oldname, SvPVX(sv), Strerror(errno) );
+                         PL_oldname, SvPVX(sv), Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
-                   (void)UNLINK(oldname);
+                   (void)UNLINK(PL_oldname);
 #endif
                }
                else {
@@ -508,7 +508,7 @@ nextargv(register GV *gv)
 #else
 #  if !(defined(WIN32) && defined(__BORLANDC__))
                /* Borland runtime creates a readonly file! */
-               (void)PerlLIO_chmod(oldname,filemode);
+               (void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #  endif
 #endif
                if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
@@ -516,7 +516,7 @@ nextargv(register GV *gv)
                    (void)fchown(PL_lastfd,fileuid,filegid);
 #else
 #ifdef HAS_CHOWN
-                   (void)PerlLIO_chown(oldname,fileuid,filegid);
+                   (void)PerlLIO_chown(PL_oldname,fileuid,filegid);
 #endif
 #endif
                }
@@ -944,7 +944,7 @@ my_lstat(ARGSproto)
 #ifdef HAS_LSTAT
     PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache);
 #else
-    laststatval = PerlLIO_stat(SvPV(sv, na),&statcache);
+    PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
 #endif
     if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
        warn(warn_nl, "lstat");
@@ -1238,7 +1238,7 @@ nothing in the core.
 #ifdef HAS_LSTAT
                if (PerlLIO_lstat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
 #else
-               if (PerlLIO_stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+               if (PerlLIO_stat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
 #endif
                    tot--;
                else {
diff --git a/mg.c b/mg.c
index 24b20c4..443d97a 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1653,18 +1653,18 @@ magic_set(SV *sv, MAGIC *mg)
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRUID
-       (void)setruid((Uid_t)uid);
+       (void)setruid((Uid_t)PL_uid);
 #else
 #ifdef HAS_SETREUID
        (void)setreuid((Uid_t)PL_uid, (Uid_t)-1);
 #else
 #ifdef HAS_SETRESUID
-      (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
+      (void)setresuid((Uid_t)PL_uid, (Uid_t)-1, (Uid_t)-1);
 #else
-       if (uid == euid)                /* special case $< = $> */
-           (void)PerlProc_setuid(uid);
+       if (PL_uid == PL_euid)          /* special case $< = $> */
+           (void)PerlProc_setuid(PL_uid);
        else {
-           uid = (I32)PerlProc_getuid();
+           PL_uid = (I32)PerlProc_getuid();
            croak("setruid() not implemented");
        }
 #endif
@@ -1683,15 +1683,15 @@ magic_set(SV *sv, MAGIC *mg)
        (void)seteuid((Uid_t)PL_euid);
 #else
 #ifdef HAS_SETREUID
-       (void)setreuid((Uid_t)-1, (Uid_t)euid);
+       (void)setreuid((Uid_t)-1, (Uid_t)PL_euid);
 #else
 #ifdef HAS_SETRESUID
        (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
 #else
-       if (euid == uid)                /* special case $> = $< */
-           PerlProc_setuid(euid);
+       if (PL_euid == PL_uid)          /* special case $> = $< */
+           PerlProc_setuid(PL_euid);
        else {
-           euid = (I32)PerlProc_geteuid();
+           PL_euid = (I32)PerlProc_geteuid();
            croak("seteuid() not implemented");
        }
 #endif
@@ -1707,18 +1707,18 @@ magic_set(SV *sv, MAGIC *mg)
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRGID
-       (void)setrgid((Gid_t)gid);
+       (void)setrgid((Gid_t)PL_gid);
 #else
 #ifdef HAS_SETREGID
        (void)setregid((Gid_t)PL_gid, (Gid_t)-1);
 #else
 #ifdef HAS_SETRESGID
-      (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
+      (void)setresgid((Gid_t)PL_gid, (Gid_t)-1, (Gid_t) 1);
 #else
-       if (gid == egid)                        /* special case $( = $) */
-           (void)PerlProc_setgid(gid);
+       if (PL_gid == PL_egid)                  /* special case $( = $) */
+           (void)PerlProc_setgid(PL_gid);
        else {
-           gid = (I32)PerlProc_getgid();
+           PL_gid = (I32)PerlProc_getgid();
            croak("setrgid() not implemented");
        }
 #endif
@@ -1750,7 +1750,7 @@ magic_set(SV *sv, MAGIC *mg)
                (void)setgroups(i, gary);
        }
 #else  /* HAS_SETGROUPS */
-       egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 #endif /* HAS_SETGROUPS */
        if (PL_delaymagic) {
            PL_delaymagic |= DM_EGID;
@@ -1760,15 +1760,15 @@ magic_set(SV *sv, MAGIC *mg)
        (void)setegid((Gid_t)PL_egid);
 #else
 #ifdef HAS_SETREGID
-       (void)setregid((Gid_t)-1, (Gid_t)egid);
+       (void)setregid((Gid_t)-1, (Gid_t)PL_egid);
 #else
 #ifdef HAS_SETRESGID
-       (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
+       (void)setresgid((Gid_t)-1, (Gid_t)PL_egid, (Gid_t)-1);
 #else
-       if (egid == gid)                        /* special case $) = $( */
-           (void)PerlProc_setgid(egid);
+       if (PL_egid == PL_gid)                  /* special case $) = $( */
+           (void)PerlProc_setgid(PL_egid);
        else {
-           egid = (I32)PerlProc_getegid();
+           PL_egid = (I32)PerlProc_getegid();
            croak("setegid() not implemented");
        }
 #endif
diff --git a/perl.c b/perl.c
index aa07b0d..f644c80 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1995,21 +1995,21 @@ sed %s -e \"/^[^#]/b\" \
          scriptname, cpp, sv, CPPMINUS);
        PL_doextract = FALSE;
 #ifdef IAMSUID                         /* actually, this is caught earlier */
-       if (euid != uid && !euid) {     /* if running suidperl */
+       if (PL_euid != PL_uid && !PL_euid) {    /* if running suidperl */
 #ifdef HAS_SETEUID
-           (void)seteuid(uid);         /* musn't stay setuid root */
+           (void)seteuid(PL_uid);              /* musn't stay setuid root */
 #else
 #ifdef HAS_SETREUID
-           (void)setreuid((Uid_t)-1, uid);
+           (void)setreuid((Uid_t)-1, PL_uid);
 #else
 #ifdef HAS_SETRESUID
-           (void)setresuid((Uid_t)-1, uid, (Uid_t)-1);
+           (void)setresuid((Uid_t)-1, PL_uid, (Uid_t)-1);
 #else
-           PerlProc_setuid(uid);
+           PerlProc_setuid(PL_uid);
 #endif
 #endif
 #endif
-           if (PerlProc_geteuid() != uid)
+           if (PerlProc_geteuid() != PL_uid)
                croak("Can't do seteuid!\n");
        }
 #endif /* IAMSUID */
@@ -2031,8 +2031,8 @@ sed %s -e \"/^[^#]/b\" \
     if (!PL_rsfp) {
 #ifdef DOSUID
 #ifndef IAMSUID                /* in case script is not readable before setuid */
-       if (euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
-         statbuf.st_mode & (S_ISUID|S_ISGID)) {
+       if (PL_euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&PL_statbuf) >= 0 &&
+         PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
            /* try again */
            PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
            croak("Can't do setuid\n");
@@ -2073,9 +2073,9 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
     dTHR;
     char *s, *s2;
 
-    if (PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf) < 0)       /* normal stat is insecure */
+    if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */
        croak("Can't stat script \"%s\"",origfilename);
-    if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
+    if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
        I32 len;
 
 #ifdef IAMSUID
@@ -2101,54 +2101,54 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
 
            if (
 #ifdef HAS_SETREUID
-               setreuid(euid,uid) < 0
+               setreuid(PL_euid,PL_uid) < 0
 #else
 # if HAS_SETRESUID
-               setresuid(euid,uid,(Uid_t)-1) < 0
+               setresuid(PL_euid,PL_uid,(Uid_t)-1) < 0
 # endif
 #endif
-               || PerlProc_getuid() != euid || PerlProc_geteuid() != uid)
+               || PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
                croak("Can't swap uid and euid");       /* really paranoid */
            if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
                croak("Permission denied");     /* testing full pathname here */
-           if (tmpstatbuf.st_dev != statbuf.st_dev ||
-               tmpstatbuf.st_ino != statbuf.st_ino) {
-               (void)PerlIO_close(rsfp);
-               if (rsfp = PerlProc_popen("/bin/mail root","w")) {      /* heh, heh */
-                   PerlIO_printf(rsfp,
+           if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
+               tmpstatbuf.st_ino != PL_statbuf.st_ino) {
+               (void)PerlIO_close(PL_rsfp);
+               if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) {   /* heh, heh */
+                   PerlIO_printf(PL_rsfp,
 "User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
 (Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n",
-                       (long)uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
-                       (long)statbuf.st_dev, (long)statbuf.st_ino,
+                       (long)PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
+                       (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
                        SvPVX(GvSV(curcop->cop_filegv)),
-                       (long)statbuf.st_uid, (long)statbuf.st_gid);
-                   (void)PerlProc_pclose(rsfp);
+                       (long)PL_statbuf.st_uid, (long)PL_statbuf.st_gid);
+                   (void)PerlProc_pclose(PL_rsfp);
                }
                croak("Permission denied\n");
            }
            if (
 #ifdef HAS_SETREUID
-              setreuid(uid,euid) < 0
+              setreuid(PL_uid,PL_euid) < 0
 #else
 # if defined(HAS_SETRESUID)
-              setresuid(uid,euid,(Uid_t)-1) < 0
+              setresuid(PL_uid,PL_euid,(Uid_t)-1) < 0
 # endif
 #endif
-              || PerlProc_getuid() != uid || PerlProc_geteuid() != euid)
+              || PerlProc_getuid() != PL_uid || PerlProc_geteuid() != PL_euid)
                croak("Can't reswap uid and euid");
-           if (!cando(S_IXUSR,FALSE,&statbuf))         /* can real uid exec? */
+           if (!cando(S_IXUSR,FALSE,&PL_statbuf))              /* can real uid exec? */
                croak("Permission denied\n");
        }
 #endif /* HAS_SETREUID */
 #endif /* IAMSUID */
 
-       if (!S_ISREG(statbuf.st_mode))
+       if (!S_ISREG(PL_statbuf.st_mode))
            croak("Permission denied");
-       if (statbuf.st_mode & S_IWOTH)
+       if (PL_statbuf.st_mode & S_IWOTH)
            croak("Setuid/gid script is writable by world");
        doswitches = FALSE;             /* -s is insecure in suid */
        curcop->cop_line++;
-       if (sv_gets(linestr, rsfp, 0) == Nullch ||
+       if (sv_gets(linestr, PL_rsfp, 0) == Nullch ||
          strnNE(SvPV(linestr,na),"#!",2) )     /* required even on Sys V */
            croak("No #! line");
        s = SvPV(linestr,na)+2;
@@ -2170,15 +2170,15 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
            croak("Args must match #! line");
 
 #ifndef IAMSUID
-       if (euid != uid && (statbuf.st_mode & S_ISUID) &&
-           euid == statbuf.st_uid)
-           if (!do_undump)
+       if (PL_euid != PL_uid && (PL_statbuf.st_mode & S_ISUID) &&
+           PL_euid == PL_statbuf.st_uid)
+           if (!PL_do_undump)
                croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif /* IAMSUID */
 
-       if (euid) {     /* oops, we're not the setuid root perl */
-           (void)PerlIO_close(rsfp);
+       if (PL_euid) {  /* oops, we're not the setuid root perl */
+           (void)PerlIO_close(PL_rsfp);
 #ifndef IAMSUID
            /* try again */
            PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
@@ -2186,60 +2186,60 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
            croak("Can't do setuid\n");
        }
 
-       if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) {
+       if (PL_statbuf.st_mode & S_ISGID && PL_statbuf.st_gid != PL_egid) {
 #ifdef HAS_SETEGID
-           (void)setegid(statbuf.st_gid);
+           (void)setegid(PL_statbuf.st_gid);
 #else
 #ifdef HAS_SETREGID
-           (void)setregid((Gid_t)-1,statbuf.st_gid);
+           (void)setregid((Gid_t)-1,PL_statbuf.st_gid);
 #else
 #ifdef HAS_SETRESGID
-           (void)setresgid((Gid_t)-1,statbuf.st_gid,(Gid_t)-1);
+           (void)setresgid((Gid_t)-1,PL_statbuf.st_gid,(Gid_t)-1);
 #else
-           PerlProc_setgid(statbuf.st_gid);
+           PerlProc_setgid(PL_statbuf.st_gid);
 #endif
 #endif
 #endif
-           if (PerlProc_getegid() != statbuf.st_gid)
+           if (PerlProc_getegid() != PL_statbuf.st_gid)
                croak("Can't do setegid!\n");
        }
-       if (statbuf.st_mode & S_ISUID) {
-           if (statbuf.st_uid != euid)
+       if (PL_statbuf.st_mode & S_ISUID) {
+           if (PL_statbuf.st_uid != PL_euid)
 #ifdef HAS_SETEUID
-               (void)seteuid(statbuf.st_uid);  /* all that for this */
+               (void)seteuid(PL_statbuf.st_uid);       /* all that for this */
 #else
 #ifdef HAS_SETREUID
-                (void)setreuid((Uid_t)-1,statbuf.st_uid);
+                (void)setreuid((Uid_t)-1,PL_statbuf.st_uid);
 #else
 #ifdef HAS_SETRESUID
-                (void)setresuid((Uid_t)-1,statbuf.st_uid,(Uid_t)-1);
+                (void)setresuid((Uid_t)-1,PL_statbuf.st_uid,(Uid_t)-1);
 #else
-               PerlProc_setuid(statbuf.st_uid);
+               PerlProc_setuid(PL_statbuf.st_uid);
 #endif
 #endif
 #endif
-           if (PerlProc_geteuid() != statbuf.st_uid)
+           if (PerlProc_geteuid() != PL_statbuf.st_uid)
                croak("Can't do seteuid!\n");
        }
-       else if (uid) {                 /* oops, mustn't run as root */
+       else if (PL_uid) {                      /* oops, mustn't run as root */
 #ifdef HAS_SETEUID
-          (void)seteuid((Uid_t)uid);
+          (void)seteuid((Uid_t)PL_uid);
 #else
 #ifdef HAS_SETREUID
-          (void)setreuid((Uid_t)-1,(Uid_t)uid);
+          (void)setreuid((Uid_t)-1,(Uid_t)PL_uid);
 #else
 #ifdef HAS_SETRESUID
-          (void)setresuid((Uid_t)-1,(Uid_t)uid,(Uid_t)-1);
+          (void)setresuid((Uid_t)-1,(Uid_t)PL_uid,(Uid_t)-1);
 #else
-          PerlProc_setuid((Uid_t)uid);
+          PerlProc_setuid((Uid_t)PL_uid);
 #endif
 #endif
 #endif
-           if (PerlProc_geteuid() != uid)
+           if (PerlProc_geteuid() != PL_uid)
                croak("Can't do seteuid!\n");
        }
        init_ids();
-       if (!cando(S_IXUSR,TRUE,&statbuf))
+       if (!cando(S_IXUSR,TRUE,&PL_statbuf))
            croak("Permission denied\n");       /* they can't do this */
     }
 #ifdef IAMSUID
@@ -2253,15 +2253,15 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     /* We absolutely must clear out any saved ids here, so we */
     /* exec the real perl, substituting fd script for scriptname. */
     /* (We pass script name as "subdir" of fd, which perl will grok.) */
-    PerlIO_rewind(rsfp);
-    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
+    PerlIO_rewind(PL_rsfp);
+    PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
     for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
     if (!origargv[which])
        croak("Permission denied");
     origargv[which] = savepv(form("/dev/fd/%d/%s",
-                                 PerlIO_fileno(rsfp), origargv[which]));
+                                 PerlIO_fileno(PL_rsfp), origargv[which]));
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(PerlIO_fileno(rsfp),F_SETFD,0);      /* ensure no close-on-exec */
+    fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);   /* ensure no close-on-exec */
 #endif
     PerlProc_execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv);  /* try again */
     croak("Can't do setuid\n");
@@ -2270,12 +2270,12 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     if (PL_euid != PL_uid || PL_egid != PL_gid) {      /* (suidperl doesn't exist, in fact) */
 #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
        dTHR;
-       PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf);    /* may be either wrapped or real suid */
-       if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
+       PerlLIO_fstat(PerlIO_fileno(PL_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)
            ||
-           (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
+           (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
           )
-           if (!do_undump)
+           if (!PL_do_undump)
                croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
@@ -2322,8 +2322,8 @@ init_ids(void)
     PL_gid = (int)PerlProc_getgid();
     PL_egid = (int)PerlProc_getegid();
 #ifdef VMS
-    uid |= gid << 16;
-    euid |= egid << 16;
+    PL_uid |= PL_gid << 16;
+    PL_euid |= PL_egid << 16;
 #endif
     PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
 }
index 62a4ef7..e7b7ae0 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -700,27 +700,27 @@ PP(pp_aassign)
     if (PL_delaymagic & ~DM_DELAY) {
        if (PL_delaymagic & DM_UID) {
 #ifdef HAS_SETRESUID
-           (void)setresuid(uid,euid,(Uid_t)-1);
+           (void)setresuid(PL_uid,PL_euid,(Uid_t)-1);
 #else
 #  ifdef HAS_SETREUID
            (void)setreuid(PL_uid,PL_euid);
 #  else
 #    ifdef HAS_SETRUID
-           if ((delaymagic & DM_UID) == DM_RUID) {
-               (void)setruid(uid);
-               delaymagic &= ~DM_RUID;
+           if ((PL_delaymagic & DM_UID) == DM_RUID) {
+               (void)setruid(PL_uid);
+               PL_delaymagic &= ~DM_RUID;
            }
 #    endif /* HAS_SETRUID */
 #    ifdef HAS_SETEUID
-           if ((delaymagic & DM_UID) == DM_EUID) {
-               (void)seteuid(uid);
-               delaymagic &= ~DM_EUID;
+           if ((PL_delaymagic & DM_UID) == DM_EUID) {
+               (void)seteuid(PL_uid);
+               PL_delaymagic &= ~DM_EUID;
            }
 #    endif /* HAS_SETEUID */
-           if (delaymagic & DM_UID) {
-               if (uid != euid)
+           if (PL_delaymagic & DM_UID) {
+               if (PL_uid != PL_euid)
                    DIE("No setreuid available");
-               (void)PerlProc_setuid(uid);
+               (void)PerlProc_setuid(PL_uid);
            }
 #  endif /* HAS_SETREUID */
 #endif /* HAS_SETRESUID */
@@ -729,27 +729,27 @@ PP(pp_aassign)
        }
        if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
-           (void)setresgid(gid,egid,(Gid_t)-1);
+           (void)setresgid(PL_gid,PL_egid,(Gid_t)-1);
 #else
 #  ifdef HAS_SETREGID
            (void)setregid(PL_gid,PL_egid);
 #  else
 #    ifdef HAS_SETRGID
-           if ((delaymagic & DM_GID) == DM_RGID) {
-               (void)setrgid(gid);
-               delaymagic &= ~DM_RGID;
+           if ((PL_delaymagic & DM_GID) == DM_RGID) {
+               (void)setrgid(PL_gid);
+               PL_delaymagic &= ~DM_RGID;
            }
 #    endif /* HAS_SETRGID */
 #    ifdef HAS_SETEGID
-           if ((delaymagic & DM_GID) == DM_EGID) {
-               (void)setegid(gid);
-               delaymagic &= ~DM_EGID;
+           if ((PL_delaymagic & DM_GID) == DM_EGID) {
+               (void)setegid(PL_gid);
+               PL_delaymagic &= ~DM_EGID;
            }
 #    endif /* HAS_SETEGID */
-           if (delaymagic & DM_GID) {
-               if (gid != egid)
+           if (PL_delaymagic & DM_GID) {
+               if (PL_gid != PL_egid)
                    DIE("No setregid available");
-               (void)PerlProc_setgid(gid);
+               (void)PerlProc_setgid(PL_gid);
            }
 #  endif /* HAS_SETREGID */
 #endif /* HAS_SETRESGID */
index 82cc932..0d8f539 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -271,7 +271,7 @@ PP(pp_glob)
 #if 0          /* XXX never used! */
 PP(pp_indread)
 {
-    last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
+    last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), PL_na), TRUE,SVt_PVIO);
     return do_readline();
 }
 #endif
@@ -2579,7 +2579,7 @@ PP(pp_fttext)
 #ifdef HAS_OPEN3
        i = PerlLIO_open3(SvPV(sv, PL_na), O_RDONLY, 0);
 #else
-       i = PerlLIO_open(SvPV(sv, na), 0);
+       i = PerlLIO_open(SvPV(sv, PL_na), 0);
 #endif
        if (i < 0) {
            if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
@@ -2652,7 +2652,7 @@ PP(pp_chdir)
     if (!tmps || !*tmps) {
        svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE);
        if (svp)
-           tmps = SvPV(*svp, na);
+           tmps = SvPV(*svp, PL_na);
     }
 #endif
     TAINT_PROPER("chdir");
@@ -3227,7 +3227,7 @@ PP(pp_system)
     else if (SP - MARK != 1)
        value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
     else {
-       value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
+       value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na));
     }
     STATUS_NATIVE_SET(value);
     do_execfree();
@@ -3259,7 +3259,7 @@ PP(pp_exec)
            TAINT_PROPER("exec");
        }
 #ifdef VMS
-       value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
+       value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
 #else
        value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
 #endif
diff --git a/util.c b/util.c
index 19487d3..2a140ee 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2477,7 +2477,7 @@ find_script(char *scriptname, bool dosearch, char **search_ext, I32 flags)
 #endif
            DEBUG_p(PerlIO_printf(Perl_debug_log,
                                  "Looking for %s\n",cur));
-           if (PerlLIO_stat(cur,&statbuf) >= 0) {
+           if (PerlLIO_stat(cur,&PL_statbuf) >= 0) {
                dosearch = 0;
                scriptname = cur;
 #ifdef SEARCH_EXTS
index ab613bd..d1d942c 100644 (file)
@@ -32,7 +32,7 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem)
     if (!(my_perl = perl_alloc()))
        return (1);
     perl_construct( my_perl );
-    perl_destruct_level = 0;
+    PL_perl_destruct_level = 0;
 
     exitstatus = perl_parse( my_perl, xs_init, argc, argv, env);
     if (!exitstatus) {
index 4891c2e..1f7883b 100644 (file)
@@ -501,13 +501,13 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
 
     if (flag != P_NOWAIT) {
        if (status < 0) {
-           if (dowarn)
+           if (PL_dowarn)
                warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
            status = 255 * 256;
        }
        else
            status *= 256;
-       statusvalue = status;
+       PL_statusvalue = status;
     }
     Safefree(argv);
     return (status);
@@ -588,7 +588,7 @@ do_spawn2(char *cmd, int exectype)
     }
     if (exectype != EXECF_SPAWN_NOWAIT) {
        if (status < 0) {
-           if (dowarn)
+           if (PL_dowarn)
                warn("Can't %s \"%s\": %s",
                     (exectype == EXECF_EXEC ? "exec" : "spawn"),
                     cmd, strerror(errno));
@@ -596,7 +596,7 @@ do_spawn2(char *cmd, int exectype)
        }
        else
            status *= 256;
-       statusvalue = status;
+       PL_statusvalue = status;
     }
     return (status);
 }
index 76052ed..184372d 100644 (file)
@@ -315,14 +315,14 @@ struct interp_intern {
 #endif
 };
 
-#define w32_perlshell_tokens   (sys_intern.w32_perlshell_tokens)
-#define w32_perlshell_vec      (sys_intern.w32_perlshell_vec)
-#define w32_perlshell_items    (sys_intern.w32_perlshell_items)
-#define w32_fdpid              (sys_intern.w32_fdpid)
+#define w32_perlshell_tokens   (PL_sys_intern.w32_perlshell_tokens)
+#define w32_perlshell_vec      (PL_sys_intern.w32_perlshell_vec)
+#define w32_perlshell_items    (PL_sys_intern.w32_perlshell_items)
+#define w32_fdpid              (PL_sys_intern.w32_fdpid)
 
 #ifndef USE_RTL_WAIT
-#  define w32_num_children     (sys_intern.w32_num_children)
-#  define w32_child_pids       (sys_intern.w32_child_pids)
+#  define w32_num_children     (PL_sys_intern.w32_num_children)
+#  define w32_child_pids       (PL_sys_intern.w32_child_pids)
 #endif
 
 /*