X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/0daa599b568c3d2373a59e6063e86a6f865719a8..85dd75020c14313b276ae5a72e6d7227961a556b:/mg.c diff --git a/mg.c b/mg.c index d298176..245acd7 100644 --- a/mg.c +++ b/mg.c @@ -48,6 +48,14 @@ Signal_t Perl_csighandler(int sig); static void restore_magic(pTHX_ void *p); static void unwind_handler_stack(pTHX_ void *p); +#ifdef __Lynx__ +/* Missing protos on LynxOS */ +void setruid(uid_t id); +void seteuid(uid_t id); +void setrgid(uid_t id); +void setegid(uid_t id); +#endif + /* * Use the "DESTRUCTOR" scope cleanup to reinstate magic. */ @@ -547,7 +555,7 @@ int Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { register I32 paren; - register char *s; + register char *s = NULL; register I32 i; register REGEXP *rx; @@ -2232,9 +2240,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_SETRESUID (void)setresuid((Uid_t)PL_uid, (Uid_t)-1, (Uid_t)-1); #else - if (PL_uid == PL_euid) /* special case $< = $> */ + if (PL_uid == PL_euid) { /* special case $< = $> */ +#ifdef PERL_DARWIN + /* workaround for Darwin's setuid peculiarity, cf [perl #24122] */ + if (PL_uid != 0 && PerlProc_getuid() == 0) + (void)PerlProc_setuid(0); +#endif (void)PerlProc_setuid(PL_uid); - else { + } else { PL_uid = PerlProc_getuid(); Perl_croak(aTHX_ "setruid() not implemented"); } @@ -2387,10 +2400,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #endif /* PL_origalen is set in perl_parse(). */ s = SvPV_force(sv,len); - if (len >= (STRLEN)PL_origalen) { - /* Longer than original, will be truncated. */ - Copy(s, PL_origargv[0], PL_origalen, char); - PL_origargv[0][PL_origalen - 1] = 0; + if (len >= (STRLEN)PL_origalen-1) { + /* Longer than original, will be truncated. We assume that + * PL_origalen bytes are available. */ + Copy(s, PL_origargv[0], PL_origalen-1, char); + PL_origargv[0][PL_origalen-1] = 0; } else { /* Shorter than original, will be padded. */