diff options
| -rw-r--r-- | handy.h | 31 | ||||
| -rw-r--r-- | iperlsys.h | 8 | ||||
| -rw-r--r-- | mg.c | 46 | ||||
| -rw-r--r-- | perl.c | 24 | ||||
| -rw-r--r-- | pp_hot.c | 8 | ||||
| -rw-r--r-- | pp_sys.c | 52 | ||||
| -rw-r--r-- | taint.c | 17 |
7 files changed, 86 insertions, 100 deletions
@@ -1782,6 +1782,37 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe # define deprecate(s) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Use of " s " is deprecated") #endif +/* Internal macros to deal with gids and uids */ +#ifdef PERL_CORE + +# if Uid_t_size > IVSIZE +# define sv_setuid(sv, uid) sv_setnv((sv), (NV)(uid)) +# define SvUID(sv) SvNV(sv) +# else +# if Uid_t_sign <= 0 +# define sv_setuid(sv, uid) sv_setiv((sv), (IV)(uid)) +# define SvUID(sv) SvIV(sv) +# else +# define sv_setuid(sv, uid) sv_setuv((sv), (UV)(uid)) +# define SvUID(sv) SvUV(sv) +# endif +# endif /* Uid_t_size */ + +# if Gid_t_size > IVSIZE +# define sv_setgid(sv, gid) sv_setnv((sv), (NV)(gid)) +# define SvGID(sv) SvNV(sv) +# else +# if Gid_t_sign <= 0 +# define sv_setgid(sv, gid) sv_setiv((sv), (IV)(gid)) +# define SvGID(sv) SvIV(sv) +# else +# define sv_setgid(sv, gid) sv_setuv((sv), (UV)(gid)) +# define SvGID(sv) SvUV(sv) +# endif +# endif /* Gid_t_size */ + +#endif + #endif /* HANDY_H */ /* diff --git a/iperlsys.h b/iperlsys.h index b23f4d3eb2..003405f690 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -933,10 +933,10 @@ typedef int (*LPProcExecv)(struct IPerlProc*, const char*, const char*const*); typedef int (*LPProcExecvp)(struct IPerlProc*, const char*, const char*const*); -typedef uid_t (*LPProcGetuid)(struct IPerlProc*); -typedef uid_t (*LPProcGeteuid)(struct IPerlProc*); -typedef gid_t (*LPProcGetgid)(struct IPerlProc*); -typedef gid_t (*LPProcGetegid)(struct IPerlProc*); +typedef Uid_t (*LPProcGetuid)(struct IPerlProc*); +typedef Uid_t (*LPProcGeteuid)(struct IPerlProc*); +typedef Gid_t (*LPProcGetgid)(struct IPerlProc*); +typedef Gid_t (*LPProcGetegid)(struct IPerlProc*); typedef char* (*LPProcGetlogin)(struct IPerlProc*); typedef int (*LPProcKill)(struct IPerlProc*, int, int); typedef int (*LPProcKillpg)(struct IPerlProc*, int, int); @@ -1051,16 +1051,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) SvNOK_on(sv); /* what a wonderful hack! */ break; case '<': - sv_setiv(sv, (IV)PerlProc_getuid()); + sv_setuid(sv, PerlProc_getuid()); break; case '>': - sv_setiv(sv, (IV)PerlProc_geteuid()); + sv_setuid(sv, PerlProc_geteuid()); break; case '(': - sv_setiv(sv, (IV)PerlProc_getgid()); + sv_setgid(sv, PerlProc_getgid()); goto add_groups; case ')': - sv_setiv(sv, (IV)PerlProc_getegid()); + sv_setgid(sv, PerlProc_getegid()); add_groups: #ifdef HAS_GETGROUPS { @@ -2761,20 +2761,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '<': { - const IV new_uid = SvIV(sv); + const Uid_t new_uid = SvUID(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)new_uid); + (void)setruid(new_uid); #else #ifdef HAS_SETREUID - (void)setreuid((Uid_t)new_uid, (Uid_t)-1); + (void)setreuid(new_uid, (Uid_t)-1); #else #ifdef HAS_SETRESUID - (void)setresuid((Uid_t)new_uid, (Uid_t)-1, (Uid_t)-1); + (void)setresuid(new_uid, (Uid_t)-1, (Uid_t)-1); #else if (new_uid == PerlProc_geteuid()) { /* special case $< = $> */ #ifdef PERL_DARWIN @@ -2793,20 +2793,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } case '>': { - const UV new_euid = SvIV(sv); + const Uid_t new_euid = SvUID(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)new_euid); + (void)seteuid(new_euid); #else #ifdef HAS_SETREUID - (void)setreuid((Uid_t)-1, (Uid_t)new_euid); + (void)setreuid((Uid_t)-1, new_euid); #else #ifdef HAS_SETRESUID - (void)setresuid((Uid_t)-1, (Uid_t)new_euid, (Uid_t)-1); + (void)setresuid((Uid_t)-1, new_euid, (Uid_t)-1); #else if (new_euid == PerlProc_getuid()) /* special case $> = $< */ PerlProc_setuid(new_euid); @@ -2820,20 +2820,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } case '(': { - const UV new_gid = SvIV(sv); + const Gid_t new_gid = SvGID(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)new_gid); + (void)setrgid(new_gid); #else #ifdef HAS_SETREGID - (void)setregid((Gid_t)new_gid, (Gid_t)-1); + (void)setregid(new_gid, (Gid_t)-1); #else #ifdef HAS_SETRESGID - (void)setresgid((Gid_t)new_gid, (Gid_t)-1, (Gid_t) -1); + (void)setresgid(new_gid, (Gid_t)-1, (Gid_t) -1); #else if (new_gid == PerlProc_getegid()) /* special case $( = $) */ (void)PerlProc_setgid(new_gid); @@ -2847,7 +2847,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } case ')': { - UV new_egid; + Gid_t new_egid; #ifdef HAS_SETGROUPS { const char *p = SvPV_const(sv, len); @@ -2863,7 +2863,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) while (isSPACE(*p)) ++p; - new_egid = Atol(p); + new_egid = (Gid_t)Atol(p); for (i = 0; i < maxgrp; ++i) { while (*p && !isSPACE(*p)) ++p; @@ -2875,14 +2875,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) Newx(gary, i + 1, Groups_t); else Renew(gary, i + 1, Groups_t); - gary[i] = Atol(p); + gary[i] = (Groups_t)Atol(p); } if (i) (void)setgroups(i, gary); Safefree(gary); } #else /* HAS_SETGROUPS */ - new_egid = SvIV(sv); + new_egid = SvGID(sv); #endif /* HAS_SETGROUPS */ PL_delaymagic_egid = new_egid; if (PL_delaymagic) { @@ -2890,13 +2890,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; /* don't do magic till later */ } #ifdef HAS_SETEGID - (void)setegid((Gid_t)new_egid); + (void)setegid(new_egid); #else #ifdef HAS_SETREGID - (void)setregid((Gid_t)-1, (Gid_t)new_egid); + (void)setregid((Gid_t)-1, new_egid); #else #ifdef HAS_SETRESGID - (void)setresgid((Gid_t)-1, (Gid_t)new_egid, (Gid_t)-1); + (void)setresgid((Gid_t)-1, new_egid, (Gid_t)-1); #else if (new_egid == PerlProc_getgid()) /* special case $) = $( */ (void)PerlProc_setgid(new_egid); @@ -3812,10 +3812,10 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) STATIC void S_validate_suid(pTHX_ PerlIO *rsfp) { - const UV my_uid = PerlProc_getuid(); - const UV my_euid = PerlProc_geteuid(); - const UV my_gid = PerlProc_getgid(); - const UV my_egid = PerlProc_getegid(); + const Uid_t my_uid = PerlProc_getuid(); + const Uid_t my_euid = PerlProc_geteuid(); + const Gid_t my_gid = PerlProc_getgid(); + const Gid_t my_egid = PerlProc_getegid(); PERL_ARGS_ASSERT_VALIDATE_SUID; @@ -3872,10 +3872,10 @@ S_init_ids(pTHX) * do tainting. */ #if !NO_TAINT_SUPPORT dVAR; - const UV my_uid = PerlProc_getuid(); - const UV my_euid = PerlProc_geteuid(); - const UV my_gid = PerlProc_getgid(); - const UV my_egid = PerlProc_getegid(); + const Uid_t my_uid = PerlProc_getuid(); + const Uid_t my_euid = PerlProc_geteuid(); + const Gid_t my_gid = PerlProc_getgid(); + const Gid_t my_egid = PerlProc_getegid(); /* Should not happen: */ CHECK_MALLOC_TAINT(my_uid && (my_euid != my_uid || my_egid != my_gid)); @@ -3907,10 +3907,10 @@ Perl_doing_taint(int argc, char *argv[], char *envp[]) * have to add your own checks somewhere in here. The two most * known samples of 'implicitness' are Win32 and NetWare, neither * of which has much of concept of 'uids'. */ - int uid = PerlProc_getuid(); - int euid = PerlProc_geteuid(); - int gid = PerlProc_getgid(); - int egid = PerlProc_getegid(); + Uid_t uid = PerlProc_getuid(); + Uid_t euid = PerlProc_geteuid(); + Gid_t gid = PerlProc_getgid(); + Gid_t egid = PerlProc_getegid(); (void)envp; #ifdef VMS @@ -1173,10 +1173,10 @@ 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(); + Uid_t tmp_uid = PerlProc_getuid(); + Uid_t tmp_euid = PerlProc_geteuid(); + Gid_t tmp_gid = PerlProc_getgid(); + Gid_t tmp_egid = PerlProc_getegid(); if (PL_delaymagic & DM_UID) { #ifdef HAS_SETRESUID @@ -2843,24 +2843,10 @@ PP(pp_stat) #endif mPUSHu(PL_statcache.st_mode); mPUSHu(PL_statcache.st_nlink); -#if Uid_t_size > IVSIZE - mPUSHn(PL_statcache.st_uid); -#else -# if Uid_t_sign <= 0 - mPUSHi(PL_statcache.st_uid); -# else - mPUSHu(PL_statcache.st_uid); -# endif -#endif -#if Gid_t_size > IVSIZE - mPUSHn(PL_statcache.st_gid); -#else -# if Gid_t_sign <= 0 - mPUSHi(PL_statcache.st_gid); -# else - mPUSHu(PL_statcache.st_gid); -# endif -#endif + + sv_setuid(PUSHmortal, PL_statcache.st_uid); + sv_setgid(PUSHmortal, PL_statcache.st_gid); + #ifdef USE_STAT_RDEV mPUSHi(PL_statcache.st_rdev); #else @@ -5186,11 +5172,7 @@ PP(pp_gpwent) PUSHs(sv = sv_newmortal()); if (pwent) { if (which == OP_GPWNAM) -# if Uid_t_sign <= 0 - sv_setiv(sv, (IV)pwent->pw_uid); -# else - sv_setuv(sv, (UV)pwent->pw_uid); -# endif + sv_setuid(sv, pwent->pw_uid); else sv_setpv(sv, pwent->pw_name); } @@ -5244,17 +5226,9 @@ PP(pp_gpwent) SvTAINTED_on(sv); # endif -# if Uid_t_sign <= 0 - mPUSHi(pwent->pw_uid); -# else - mPUSHu(pwent->pw_uid); -# endif + sv_setuid(PUSHmortal, pwent->pw_uid); + sv_setgid(PUSHmortal, pwent->pw_gid); -# if Uid_t_sign <= 0 - mPUSHi(pwent->pw_gid); -# else - mPUSHu(pwent->pw_gid); -# endif /* pw_change, pw_quota, and pw_age are mutually exclusive-- * because of the poor interface of the Perl getpw*(), * not because there's some standard/convention saying so. @@ -5345,11 +5319,7 @@ PP(pp_ggrent) PUSHs(sv); if (grent) { if (which == OP_GGRNAM) -#if Gid_t_sign <= 0 - sv_setiv(sv, (IV)grent->gr_gid); -#else - sv_setuv(sv, (UV)grent->gr_gid); -#endif + sv_setgid(sv, grent->gr_gid); else sv_setpv(sv, grent->gr_name); } @@ -5365,11 +5335,7 @@ PP(pp_ggrent) PUSHs(sv_mortalcopy(&PL_sv_no)); #endif -#if Gid_t_sign <= 0 - mPUSHi(grent->gr_gid); -#else - mPUSHu(grent->gr_gid); -#endif + sv_setgid(PUSHmortal, grent->gr_gid); #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API)) /* In UNICOS/mk (_CRAYMPP) the multithreading @@ -31,25 +31,14 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s) PERL_ARGS_ASSERT_TAINT_PROPER; -# if Uid_t_size == 1 { - const UV uid = PerlProc_getuid(); - const UV euid = PerlProc_geteuid(); + const Uid_t uid = PerlProc_getuid(); + const Uid_t euid = PerlProc_geteuid(); DEBUG_u(PerlIO_printf(Perl_debug_log, - "%s %d %"UVuf" %"UVuf"\n", + "%s %d %"Uid_t_f" %"Uid_t_f"\n", s, TAINT_get, 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, TAINT_get, uid, euid)); - } -# endif #endif if (TAINT_get) { |