From: Nick Ing-Simmons Date: Sat, 18 Jul 1998 20:56:58 +0000 (+0000) Subject: PL_ scheme Builds under Minw32 - some SEGFAULT snags X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b28d0864af067162e2d26cc66b6b8acb6d3cddc8;p=p5sagit%2Fp5-mst-13.2.git PL_ scheme Builds under Minw32 - some SEGFAULT snags p4raw-id: //depot/ansiperl@1537 --- diff --git a/doio.c b/doio.c index e13b99a..1d852d3 100644 --- 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 --- 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 --- 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)); } diff --git a/pp_hot.c b/pp_hot.c index 62a4ef7..e7b7ae0 100644 --- 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 */ diff --git a/pp_sys.c b/pp_sys.c index 82cc932..0d8f539 100644 --- 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 --- 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 diff --git a/win32/perllib.c b/win32/perllib.c index ab613bd..d1d942c 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -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) { diff --git a/win32/win32.c b/win32/win32.c index 4891c2e..1f7883b 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -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); } diff --git a/win32/win32.h b/win32/win32.h index 76052ed..184372d 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -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 /*