X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=eb5888605f8243e1fdf2a91ff87116c60a5bc6d9;hb=64f14228217abb04a437553319642d6e7a82a3e8;hp=7fba763920ebe8ddda69e1ac0860c65c9de69d2c;hpb=9607fc9c489d4095e3baa795d7ead7acba96137d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 7fba763..eb58886 100644 --- a/mg.c +++ b/mg.c @@ -20,7 +20,7 @@ # include #endif -#ifdef HAS_GETGROUPS +#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) # ifndef NGROUPS # define NGROUPS 32 # endif @@ -286,7 +286,6 @@ MAGIC *mg; } } return 0; - break; case '+': if (curpm && (rx = curpm->op_pmregexp)) { paren = rx->lastparen; @@ -294,7 +293,6 @@ MAGIC *mg; goto getparen; } return 0; - break; case '`': if (curpm && (rx = curpm->op_pmregexp)) { if ((s = rx->subbeg) && rx->startp[0]) { @@ -309,7 +307,7 @@ MAGIC *mg; if (rx->subend && (s = rx->endp[0])) { i = rx->subend - s; if (i >= 0) - return 0; + return i; } } return 0; @@ -533,27 +531,20 @@ MAGIC *mg; break; case '(': sv_setiv(sv, (IV)gid); - s = buf; - (void)sprintf(s,"%d",(int)gid); + sv_setpvf(sv, "%Vd", (IV)gid); goto add_groups; case ')': sv_setiv(sv, (IV)egid); - s = buf; - (void)sprintf(s,"%d",(int)egid); + sv_setpvf(sv, "%Vd", (IV)egid); add_groups: - while (*s) s++; #ifdef HAS_GETGROUPS { Groups_t gary[NGROUPS]; - i = getgroups(NGROUPS,gary); - while (--i >= 0) { - (void)sprintf(s," %d", (int)gary[i]); - while (*s) s++; - } + while (--i >= 0) + sv_catpvf(sv, " %Vd", (IV)gary[i]); } #endif - sv_setpv(sv,buf); SvIOK_on(sv); /* what a wonderful hack! */ break; case '*': @@ -583,37 +574,30 @@ MAGIC* mg; { register char *s; char *ptr; - STRLEN len; + STRLEN len, klen; I32 i; s = SvPV(sv,len); - ptr = MgPV(mg); + ptr = MgPV(mg,klen); my_setenv(ptr, s); #ifdef DYNAMIC_ENV_FETCH /* We just undefd an environment var. Is a replacement */ /* waiting in the wings? */ if (!len) { - HE *envhe; - SV *keysv; - if (mg->mg_len == HEf_SVKEY) - keysv = (SV *)mg->mg_ptr; - else - keysv = newSVpv(mg->mg_ptr, mg->mg_len); - if ((envhe = hv_fetch_ent(GvHVn(envgv), keysv, FALSE, 0))) - s = SvPV(HeVAL(envhe), len); - if (mg->mg_len != HEf_SVKEY) - SvREFCNT_dec(keysv); + SV **valp; + if ((valp = hv_fetch(GvHVn(envgv), ptr, klen, FALSE))) + s = SvPV(*valp, len); } #endif -#if !defined(OS2) && !defined(AMIGAOS) +#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) /* And you'll never guess what the dog had */ /* in its mouth... */ if (tainting) { MgTAINTEDDIR_off(mg); #ifdef VMS - if (s && strnEQ(ptr, "DCL$PATH", 8)) { + if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) { char pathbuf[256], eltbuf[256], *cp, *elt = s; struct stat sbuf; int i = 0, j = 0; @@ -638,14 +622,16 @@ MAGIC* mg; } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf)); } #endif /* VMS */ - if (s && strEQ(ptr,"PATH")) { + if (s && klen == 4 && strEQ(ptr,"PATH")) { char *strend = s + len; while (s < strend) { struct stat st; - s = cpytill(tokenbuf, s, strend, ':', &i); + s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, + s, strend, ':', &i); s++; - if (*tokenbuf != '/' + if (i >= sizeof tokenbuf /* too long -- assume the worst */ + || *tokenbuf != '/' || (Stat(tokenbuf, &st) == 0 && (st.st_mode & 2)) ) { MgTAINTEDDIR_on(mg); return 0; @@ -653,7 +639,7 @@ MAGIC* mg; } } } -#endif /* neither OS2 nor AMIGAOS */ +#endif /* neither OS2 nor AMIGAOS nor WIN32 */ return 0; } @@ -663,7 +649,46 @@ magic_clearenv(sv,mg) SV* sv; MAGIC* mg; { - my_setenv(MgPV(mg),Nullch); + my_setenv(MgPV(mg,na),Nullch); + return 0; +} + +int +magic_clear_all_env(sv,mg) +SV* sv; +MAGIC* mg; +{ +#if defined(VMS) + die("Can't make list assignment to %%ENV on this system"); +#else +#ifdef WIN32 + char *envv = GetEnvironmentStrings(); + char *cur = envv; + STRLEN len; + while (*cur) { + char *end = strchr(cur,'='); + if (end && end != cur) { + *end = '\0'; + my_setenv(cur,Nullch); + *end = '='; + cur += strlen(end+1)+1; + } + else if ((len = strlen(cur))) + cur += len+1; + } + FreeEnvironmentStrings(envv); +#else + I32 i; + + if (environ == origenviron) + New(901, environ, 1, char*); + else + for (i = 0; environ[i]; i++) + Safefree(environ[i]); + environ[0] = Nullch; + +#endif +#endif return 0; } @@ -674,7 +699,7 @@ MAGIC* mg; { I32 i; /* Are we fetching a signal entry? */ - i = whichsig(MgPV(mg)); + i = whichsig(MgPV(mg,na)); if (i) { if(psig_ptr[i]) sv_setsv(sv,psig_ptr[i]); @@ -699,7 +724,7 @@ MAGIC* mg; { I32 i; /* Are we clearing a signal entry? */ - i = whichsig(MgPV(mg)); + i = whichsig(MgPV(mg,na)); if (i) { if(psig_ptr[i]) { SvREFCNT_dec(psig_ptr[i]); @@ -722,7 +747,7 @@ MAGIC* mg; I32 i; SV** svp; - s = MgPV(mg); + s = MgPV(mg,na); if (*s == '_') { if (strEQ(s,"__DIE__")) svp = &diehook; @@ -773,12 +798,13 @@ MAGIC* mg; *svp = 0; } else { - if(hints & HINT_STRICT_REFS) - die(no_symref,s,"a subroutine"); - if (!strchr(s,':') && !strchr(s,'\'')) { - sprintf(tokenbuf, "main::%s",s); - sv_setpv(sv,tokenbuf); - } + /* + * We should warn if HINT_STRICT_REFS, but without + * access to a known hint bit in a known OP, we can't + * tell whether HINT_STRICT_REFS is in force or not. + */ + if (!strchr(s,':') && !strchr(s,'\'')) + sv_setpv(sv, form("main::%s", s)); if (i) (void)rsignal(i, sighandler); else @@ -960,7 +986,7 @@ MAGIC* mg; gv = DBline; i = SvTRUE(sv); svp = av_fetch(GvAV(gv), - atoi(MgPV(mg)), FALSE); + atoi(MgPV(mg,na)), FALSE); if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp))) o->op_private = i; else @@ -1129,15 +1155,32 @@ MAGIC* mg; } int -magic_getitervar(sv,mg) +magic_getdefelem(sv,mg) SV* sv; MAGIC* mg; { SV *targ = Nullsv; if (LvTARGLEN(sv)) { - AV* av = (AV*)LvTARG(sv); - if (LvTARGOFF(sv) <= AvFILL(av)) - targ = AvARRAY(av)[LvTARGOFF(sv)]; + if (mg->mg_obj) { + HV* hv = (HV*)LvTARG(sv); + HE* he = hv_fetch_ent(hv, mg->mg_obj, FALSE, 0); + if (he) + targ = HeVAL(he); + } + else { + AV* av = (AV*)LvTARG(sv); + if ((I32)LvTARGOFF(sv) <= AvFILL(av)) + targ = AvARRAY(av)[LvTARGOFF(sv)]; + } + if (targ && targ != &sv_undef) { + /* somebody else defined it for us */ + SvREFCNT_dec(LvTARG(sv)); + LvTARG(sv) = SvREFCNT_inc(targ); + LvTARGLEN(sv) = 0; + SvREFCNT_dec(mg->mg_obj); + mg->mg_obj = Nullsv; + mg->mg_flags &= ~MGf_REFCOUNTED; + } } else targ = LvTARG(sv); @@ -1146,19 +1189,21 @@ MAGIC* mg; } int -magic_setitervar(sv,mg) +magic_setdefelem(sv,mg) SV* sv; MAGIC* mg; { if (LvTARGLEN(sv)) - vivify_itervar(sv); - if (LvTARG(sv)) + vivify_defelem(sv); + if (LvTARG(sv)) { sv_setsv(LvTARG(sv), sv); + SvSETMAGIC(LvTARG(sv)); + } return 0; } int -magic_freeitervar(sv,mg) +magic_freedefelem(sv,mg) SV* sv; MAGIC* mg; { @@ -1167,24 +1212,37 @@ MAGIC* mg; } void -vivify_itervar(sv) +vivify_defelem(sv) SV* sv; { - AV* av; + MAGIC* mg; + SV* value; - if (!LvTARGLEN(sv)) + if (!LvTARGLEN(sv) || !(mg = mg_find(sv, 'y'))) return; - av = (AV*)LvTARG(sv); - if (LvTARGOFF(sv) <= AvFILL(av)) { - SV** svp = AvARRAY(av) + LvTARGOFF(sv); - LvTARG(sv) = newSVsv(*svp); - SvREFCNT_dec(*svp); - *svp = SvREFCNT_inc(LvTARG(sv)); + if (mg->mg_obj) { + HV* hv = (HV*)LvTARG(sv); + HE* he = hv_fetch_ent(hv, mg->mg_obj, TRUE, 0); + if (!he || (value = HeVAL(he)) == &sv_undef) + croak(no_helem, SvPV(mg->mg_obj, na)); } - else - LvTARG(sv) = Nullsv; - SvREFCNT_dec(av); + else { + AV* av = (AV*)LvTARG(sv); + if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av)) + LvTARG(sv) = Nullsv; /* array can't be extended */ + else { + SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE); + if (!svp || (value = *svp) == &sv_undef) + croak(no_aelem, (I32)LvTARGOFF(sv)); + } + } + (void)SvREFCNT_inc(value); + SvREFCNT_dec(LvTARG(sv)); + LvTARG(sv) = value; LvTARGLEN(sv) = 0; + SvREFCNT_dec(mg->mg_obj); + mg->mg_obj = Nullsv; + mg->mg_flags &= ~MGf_REFCOUNTED; } int @@ -1344,9 +1402,18 @@ MAGIC* mg; IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '|': - IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH; - if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) { - IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH; + { + IO *io = GvIOp(defoutgv); + if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0) + IoFLAGS(io) &= ~IOf_FLUSH; + else { + if (!(IoFLAGS(io) & IOf_FLUSH)) { + PerlIO *ofp = IoOFP(io); + if (ofp) + (void)PerlIO_flush(ofp); + IoFLAGS(io) |= IOf_FLUSH; + } + } } break; case '*': @@ -1483,7 +1550,30 @@ MAGIC* mg; tainting |= (uid && (euid != uid || egid != gid)); break; case ')': +#ifdef HAS_SETGROUPS + { + char *p = SvPV(sv, na); + Groups_t gary[NGROUPS]; + + SET_NUMERIC_STANDARD(); + while (isSPACE(*p)) + ++p; + egid = I_V(atof(p)); + for (i = 0; i < NGROUPS; ++i) { + while (*p && !isSPACE(*p)) + ++p; + while (isSPACE(*p)) + ++p; + if (!*p) + break; + gary[i] = I_V(atof(p)); + } + if (i) + (void)setgroups(i, gary); + } +#else /* HAS_SETGROUPS */ egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); +#endif /* HAS_SETGROUPS */ if (delaymagic) { delaymagic |= DM_EGID; break; /* don't do magic till later */ @@ -1523,7 +1613,7 @@ MAGIC* mg; } /* can grab env area too? */ if (origenviron && origenviron[0] == s + 1) { - my_setenv("NoNeSuCh", Nullch); + my_setenv("NoNe SuCh", Nullch); /* force copy of environment */ for (i = 0; origenviron[i]; i++) if (origenviron[i] == s + 1)