This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003_05: makedepend.SH
[perl5.git] / mg.c
CommitLineData
a0d0e21e 1/* mg.c
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, Larry Wall
79072805
LW
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
a0d0e21e
LW
8 */
9
10/*
11 * "Sam sat on the ground and put his head in his hands. 'I wish I had never
12 * come here, and I don't want to see no more magic,' he said, and fell silent."
79072805
LW
13 */
14
15#include "EXTERN.h"
16#include "perl.h"
17
e6d9441c 18/* XXX If this causes problems, set i_unistd=undef in the hint file. */
a0d0e21e
LW
19#ifdef I_UNISTD
20# include <unistd.h>
21#endif
a0d0e21e 22
c07a80fd
PP
23/*
24 * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
25 */
26
27struct magic_state {
28 SV* mgs_sv;
29 U32 mgs_flags;
30};
31typedef struct magic_state MGS;
32
33static void restore_magic _((void *p));
34
35static MGS *
36save_magic(sv)
37SV* sv;
38{
39 MGS* mgs;
40
41 assert(SvMAGICAL(sv));
42
43 mgs = (MGS*)safemalloc(sizeof(MGS));
44 mgs->mgs_sv = sv;
45 mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
46 SAVEDESTRUCTOR(restore_magic, mgs);
47
48 SvMAGICAL_off(sv);
49 SvREADONLY_off(sv);
50 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
51
52 return mgs;
53}
54
55static void
56restore_magic(p)
57void* p;
58{
59 MGS *mgs = (MGS*)p;
60 SV* sv = mgs->mgs_sv;
61
62 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
63 {
64 if (mgs->mgs_flags)
65 SvFLAGS(sv) |= mgs->mgs_flags;
66 else
67 mg_magical(sv);
68 if (SvGMAGICAL(sv))
69 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
70 }
71
e6d9441c 72 Safefree(mgs);
c07a80fd
PP
73}
74
8e07c86e 75
8990e307
LW
76void
77mg_magical(sv)
78SV* sv;
79{
80 MAGIC* mg;
81 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
82 MGVTBL* vtbl = mg->mg_virtual;
83 if (vtbl) {
a0d0e21e 84 if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
8990e307
LW
85 SvGMAGICAL_on(sv);
86 if (vtbl->svt_set)
87 SvSMAGICAL_on(sv);
88 if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
89 SvRMAGICAL_on(sv);
90 }
91 }
92}
93
79072805
LW
94int
95mg_get(sv)
96SV* sv;
97{
c07a80fd 98 MGS* mgs;
79072805 99 MAGIC* mg;
c6496cc7 100 MAGIC** mgp;
760ac839 101 int mgp_valid = 0;
463ee0b2 102
c07a80fd
PP
103 ENTER;
104 mgs = save_magic(sv);
463ee0b2 105
c6496cc7
PP
106 mgp = &SvMAGIC(sv);
107 while ((mg = *mgp) != 0) {
79072805 108 MGVTBL* vtbl = mg->mg_virtual;
a0d0e21e 109 if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
79072805 110 (*vtbl->svt_get)(sv, mg);
c6496cc7 111 /* Ignore this magic if it's been deleted */
760ac839 112 if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && (mg->mg_flags & MGf_GSKIP))
c07a80fd 113 mgs->mgs_flags = 0;
a0d0e21e 114 }
c6496cc7 115 /* Advance to next magic (complicated by possible deletion) */
760ac839 116 if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
c6496cc7 117 mgp = &mg->mg_moremagic;
760ac839
LW
118 mgp_valid = 1;
119 }
120 else
121 mgp = &SvMAGIC(sv); /* Re-establish pointer after sv_upgrade */
79072805 122 }
463ee0b2 123
c07a80fd 124 LEAVE;
79072805
LW
125 return 0;
126}
127
128int
129mg_set(sv)
130SV* sv;
131{
c07a80fd 132 MGS* mgs;
79072805 133 MAGIC* mg;
463ee0b2
LW
134 MAGIC* nextmg;
135
c07a80fd
PP
136 ENTER;
137 mgs = save_magic(sv);
463ee0b2
LW
138
139 for (mg = SvMAGIC(sv); mg; mg = nextmg) {
79072805 140 MGVTBL* vtbl = mg->mg_virtual;
463ee0b2 141 nextmg = mg->mg_moremagic; /* it may delete itself */
a0d0e21e
LW
142 if (mg->mg_flags & MGf_GSKIP) {
143 mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
c07a80fd 144 mgs->mgs_flags = 0;
a0d0e21e 145 }
79072805
LW
146 if (vtbl && vtbl->svt_set)
147 (*vtbl->svt_set)(sv, mg);
148 }
463ee0b2 149
c07a80fd 150 LEAVE;
79072805
LW
151 return 0;
152}
153
154U32
155mg_len(sv)
156SV* sv;
157{
158 MAGIC* mg;
748a9306 159 char *junk;
463ee0b2 160 STRLEN len;
463ee0b2 161
79072805
LW
162 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
163 MGVTBL* vtbl = mg->mg_virtual;
85e6fe83 164 if (vtbl && vtbl->svt_len) {
c07a80fd
PP
165 ENTER;
166 save_magic(sv);
a0d0e21e 167 /* omit MGf_GSKIP -- not changed here */
85e6fe83 168 len = (*vtbl->svt_len)(sv, mg);
c07a80fd 169 LEAVE;
85e6fe83
LW
170 return len;
171 }
172 }
173
748a9306 174 junk = SvPV(sv, len);
463ee0b2 175 return len;
79072805
LW
176}
177
178int
179mg_clear(sv)
180SV* sv;
181{
182 MAGIC* mg;
463ee0b2 183
c07a80fd
PP
184 ENTER;
185 save_magic(sv);
463ee0b2 186
79072805
LW
187 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
188 MGVTBL* vtbl = mg->mg_virtual;
a0d0e21e
LW
189 /* omit GSKIP -- never set here */
190
79072805
LW
191 if (vtbl && vtbl->svt_clear)
192 (*vtbl->svt_clear)(sv, mg);
193 }
463ee0b2 194
c07a80fd 195 LEAVE;
79072805
LW
196 return 0;
197}
198
93a17b20
LW
199MAGIC*
200mg_find(sv, type)
201SV* sv;
a0d0e21e 202int type;
93a17b20
LW
203{
204 MAGIC* mg;
93a17b20
LW
205 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
206 if (mg->mg_type == type)
207 return mg;
208 }
209 return 0;
210}
211
79072805 212int
463ee0b2 213mg_copy(sv, nsv, key, klen)
79072805 214SV* sv;
463ee0b2
LW
215SV* nsv;
216char *key;
88e89b8a 217I32 klen;
79072805 218{
463ee0b2 219 int count = 0;
79072805 220 MAGIC* mg;
463ee0b2
LW
221 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
222 if (isUPPER(mg->mg_type)) {
a0d0e21e 223 sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
463ee0b2 224 count++;
79072805 225 }
79072805 226 }
463ee0b2 227 return count;
79072805
LW
228}
229
230int
463ee0b2 231mg_free(sv)
79072805
LW
232SV* sv;
233{
234 MAGIC* mg;
235 MAGIC* moremagic;
236 for (mg = SvMAGIC(sv); mg; mg = moremagic) {
237 MGVTBL* vtbl = mg->mg_virtual;
238 moremagic = mg->mg_moremagic;
239 if (vtbl && vtbl->svt_free)
240 (*vtbl->svt_free)(sv, mg);
93a17b20 241 if (mg->mg_ptr && mg->mg_type != 'g')
88e89b8a
PP
242 if (mg->mg_len >= 0)
243 Safefree(mg->mg_ptr);
244 else if (mg->mg_len == HEf_SVKEY)
245 SvREFCNT_dec((SV*)mg->mg_ptr);
85e6fe83 246 if (mg->mg_flags & MGf_REFCOUNTED)
8990e307 247 SvREFCNT_dec(mg->mg_obj);
79072805
LW
248 Safefree(mg);
249 }
250 SvMAGIC(sv) = 0;
251 return 0;
252}
253
254#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
255#include <signal.h>
256#endif
257
93a17b20
LW
258U32
259magic_len(sv, mg)
260SV *sv;
261MAGIC *mg;
262{
263 register I32 paren;
264 register char *s;
265 register I32 i;
748a9306 266 char *t;
93a17b20
LW
267
268 switch (*mg->mg_ptr) {
269 case '1': case '2': case '3': case '4':
270 case '5': case '6': case '7': case '8': case '9': case '&':
271 if (curpm) {
272 paren = atoi(mg->mg_ptr);
273 getparen:
274 if (curpm->op_pmregexp &&
275 paren <= curpm->op_pmregexp->nparens &&
748a9306
LW
276 (s = curpm->op_pmregexp->startp[paren]) &&
277 (t = curpm->op_pmregexp->endp[paren]) ) {
278 i = t - s;
93a17b20
LW
279 if (i >= 0)
280 return i;
93a17b20 281 }
93a17b20 282 }
748a9306 283 return 0;
93a17b20
LW
284 break;
285 case '+':
286 if (curpm) {
287 paren = curpm->op_pmregexp->lastparen;
a0d0e21e
LW
288 if (!paren)
289 return 0;
93a17b20
LW
290 goto getparen;
291 }
748a9306 292 return 0;
93a17b20
LW
293 break;
294 case '`':
295 if (curpm) {
296 if (curpm->op_pmregexp &&
297 (s = curpm->op_pmregexp->subbeg) ) {
298 i = curpm->op_pmregexp->startp[0] - s;
299 if (i >= 0)
300 return i;
93a17b20 301 }
93a17b20 302 }
748a9306 303 return 0;
93a17b20
LW
304 case '\'':
305 if (curpm) {
306 if (curpm->op_pmregexp &&
307 (s = curpm->op_pmregexp->endp[0]) ) {
308 return (STRLEN) (curpm->op_pmregexp->subend - s);
309 }
93a17b20 310 }
748a9306 311 return 0;
93a17b20
LW
312 case ',':
313 return (STRLEN)ofslen;
314 case '\\':
315 return (STRLEN)orslen;
316 }
317 magic_get(sv,mg);
318 if (!SvPOK(sv) && SvNIOK(sv))
463ee0b2 319 sv_2pv(sv, &na);
93a17b20
LW
320 if (SvPOK(sv))
321 return SvCUR(sv);
322 return 0;
323}
324
79072805
LW
325int
326magic_get(sv, mg)
327SV *sv;
328MAGIC *mg;
329{
330 register I32 paren;
331 register char *s;
332 register I32 i;
748a9306 333 char *t;
79072805
LW
334
335 switch (*mg->mg_ptr) {
748a9306
LW
336 case '\001': /* ^A */
337 sv_setsv(sv, bodytarget);
338 break;
79072805
LW
339 case '\004': /* ^D */
340 sv_setiv(sv,(I32)(debug & 32767));
341 break;
28f23441
PP
342 case '\005': /* ^E */
343#ifdef VMS
344 {
345# include <descrip.h>
346# include <starlet.h>
347 char msg[255];
348 $DESCRIPTOR(msgdsc,msg);
349 sv_setnv(sv,(double)vaxc$errno);
350 if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
351 sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
352 else
353 sv_setpv(sv,"");
354 }
355#else
88e89b8a
PP
356#ifdef OS2
357 sv_setnv(sv,(double)Perl_rc);
358 sv_setpv(sv, os2error(Perl_rc));
359#else
28f23441
PP
360 sv_setnv(sv,(double)errno);
361 sv_setpv(sv, errno ? Strerror(errno) : "");
362#endif
88e89b8a 363#endif
28f23441
PP
364 SvNOK_on(sv); /* what a wonderful hack! */
365 break;
79072805
LW
366 case '\006': /* ^F */
367 sv_setiv(sv,(I32)maxsysfd);
368 break;
a0d0e21e
LW
369 case '\010': /* ^H */
370 sv_setiv(sv,(I32)hints);
371 break;
79072805
LW
372 case '\t': /* ^I */
373 if (inplace)
374 sv_setpv(sv, inplace);
375 else
376 sv_setsv(sv,&sv_undef);
377 break;
28f23441
PP
378 case '\017': /* ^O */
379 sv_setpv(sv,osname);
380 break;
79072805
LW
381 case '\020': /* ^P */
382 sv_setiv(sv,(I32)perldb);
383 break;
384 case '\024': /* ^T */
88e89b8a
PP
385#ifdef BIG_TIME
386 sv_setnv(sv,basetime);
387#else
79072805 388 sv_setiv(sv,(I32)basetime);
88e89b8a 389#endif
79072805
LW
390 break;
391 case '\027': /* ^W */
392 sv_setiv(sv,(I32)dowarn);
393 break;
394 case '1': case '2': case '3': case '4':
395 case '5': case '6': case '7': case '8': case '9': case '&':
396 if (curpm) {
88e89b8a 397 paren = atoi(GvENAME((GV*)mg->mg_obj));
79072805
LW
398 getparen:
399 if (curpm->op_pmregexp &&
400 paren <= curpm->op_pmregexp->nparens &&
a0d0e21e 401 (s = curpm->op_pmregexp->startp[paren]) &&
748a9306
LW
402 (t = curpm->op_pmregexp->endp[paren]) ) {
403 i = t - s;
404 if (i >= 0) {
405 MAGIC *tmg;
79072805 406 sv_setpvn(sv,s,i);
748a9306
LW
407 if (tainting && (tmg = mg_find(sv,'t')))
408 tmg->mg_len = 0; /* guarantee $1 untainted */
409 break;
410 }
79072805 411 }
79072805 412 }
748a9306 413 sv_setsv(sv,&sv_undef);
79072805
LW
414 break;
415 case '+':
416 if (curpm) {
417 paren = curpm->op_pmregexp->lastparen;
a0d0e21e
LW
418 if (paren)
419 goto getparen;
79072805 420 }
748a9306 421 sv_setsv(sv,&sv_undef);
79072805
LW
422 break;
423 case '`':
424 if (curpm) {
425 if (curpm->op_pmregexp &&
426 (s = curpm->op_pmregexp->subbeg) ) {
427 i = curpm->op_pmregexp->startp[0] - s;
748a9306 428 if (i >= 0) {
79072805 429 sv_setpvn(sv,s,i);
748a9306
LW
430 break;
431 }
79072805 432 }
79072805 433 }
748a9306 434 sv_setsv(sv,&sv_undef);
79072805
LW
435 break;
436 case '\'':
437 if (curpm) {
438 if (curpm->op_pmregexp &&
439 (s = curpm->op_pmregexp->endp[0]) ) {
440 sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
748a9306 441 break;
79072805 442 }
79072805 443 }
748a9306 444 sv_setsv(sv,&sv_undef);
79072805
LW
445 break;
446 case '.':
447#ifndef lint
a0d0e21e 448 if (GvIO(last_in_gv)) {
8990e307 449 sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
79072805
LW
450 }
451#endif
452 break;
453 case '?':
454 sv_setiv(sv,(I32)statusvalue);
455 break;
456 case '^':
a0d0e21e 457 s = IoTOP_NAME(GvIOp(defoutgv));
79072805
LW
458 if (s)
459 sv_setpv(sv,s);
460 else {
461 sv_setpv(sv,GvENAME(defoutgv));
462 sv_catpv(sv,"_TOP");
463 }
464 break;
465 case '~':
a0d0e21e 466 s = IoFMT_NAME(GvIOp(defoutgv));
79072805
LW
467 if (!s)
468 s = GvENAME(defoutgv);
469 sv_setpv(sv,s);
470 break;
471#ifndef lint
472 case '=':
a0d0e21e 473 sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
79072805
LW
474 break;
475 case '-':
a0d0e21e 476 sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
79072805
LW
477 break;
478 case '%':
a0d0e21e 479 sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
79072805
LW
480 break;
481#endif
482 case ':':
483 break;
484 case '/':
485 break;
486 case '[':
a0d0e21e 487 sv_setiv(sv,(I32)curcop->cop_arybase);
79072805
LW
488 break;
489 case '|':
a0d0e21e 490 sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
79072805
LW
491 break;
492 case ',':
493 sv_setpvn(sv,ofs,ofslen);
494 break;
495 case '\\':
496 sv_setpvn(sv,ors,orslen);
497 break;
498 case '#':
499 sv_setpv(sv,ofmt);
500 break;
501 case '!':
a5f75d66
AD
502#ifdef VMS
503 sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
88e89b8a 504 sv_setpv(sv, errno ? Strerror(errno) : "");
a5f75d66 505#else
88e89b8a
PP
506 {
507 int saveerrno = errno;
79072805 508 sv_setnv(sv,(double)errno);
88e89b8a
PP
509#ifdef OS2
510 if (errno == errno_isOS2) sv_setpv(sv, os2error(Perl_rc));
511 else
a5f75d66 512#endif
2304df62 513 sv_setpv(sv, errno ? Strerror(errno) : "");
88e89b8a
PP
514 errno = saveerrno;
515 }
516#endif
79072805
LW
517 SvNOK_on(sv); /* what a wonderful hack! */
518 break;
519 case '<':
520 sv_setiv(sv,(I32)uid);
521 break;
522 case '>':
523 sv_setiv(sv,(I32)euid);
524 break;
525 case '(':
526 s = buf;
527 (void)sprintf(s,"%d",(int)gid);
528 goto add_groups;
529 case ')':
530 s = buf;
531 (void)sprintf(s,"%d",(int)egid);
532 add_groups:
533 while (*s) s++;
534#ifdef HAS_GETGROUPS
535#ifndef NGROUPS
536#define NGROUPS 32
537#endif
538 {
a0d0e21e 539 Groups_t gary[NGROUPS];
79072805
LW
540
541 i = getgroups(NGROUPS,gary);
542 while (--i >= 0) {
543 (void)sprintf(s," %ld", (long)gary[i]);
544 while (*s) s++;
545 }
546 }
547#endif
548 sv_setpv(sv,buf);
549 break;
550 case '*':
551 break;
552 case '0':
553 break;
554 }
a0d0e21e 555 return 0;
79072805
LW
556}
557
558int
559magic_getuvar(sv, mg)
560SV *sv;
561MAGIC *mg;
562{
563 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
564
565 if (uf && uf->uf_val)
566 (*uf->uf_val)(uf->uf_index, sv);
567 return 0;
568}
569
570int
571magic_setenv(sv,mg)
572SV* sv;
573MAGIC* mg;
574{
575 register char *s;
88e89b8a 576 char *ptr;
a0d0e21e
LW
577 STRLEN len;
578 I32 i;
579 s = SvPV(sv,len);
88e89b8a
PP
580 ptr = (mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr;
581 my_setenv(ptr, s);
a0d0e21e
LW
582#ifdef DYNAMIC_ENV_FETCH
583 /* We just undefd an environment var. Is a replacement */
584 /* waiting in the wings? */
585 if (!len) {
88e89b8a
PP
586 HE *envhe;
587 if (envhe = hv_fetch_ent(GvHVn(envgv),HeSVKEY((HE*)(mg->mg_ptr)),FALSE,0))
588 s = SvPV(HeVAL(envhe),len);
a0d0e21e
LW
589 }
590#endif
79072805
LW
591 /* And you'll never guess what the dog had */
592 /* in its mouth... */
463ee0b2 593 if (tainting) {
88e89b8a 594 if (s && strEQ(ptr,"PATH")) {
a0d0e21e 595 char *strend = s + len;
463ee0b2
LW
596
597 while (s < strend) {
598 s = cpytill(tokenbuf,s,strend,':',&i);
599 s++;
600 if (*tokenbuf != '/'
a0d0e21e 601 || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
8990e307 602 MgTAINTEDDIR_on(mg);
463ee0b2 603 }
79072805
LW
604 }
605 }
79072805
LW
606 return 0;
607}
608
609int
85e6fe83
LW
610magic_clearenv(sv,mg)
611SV* sv;
612MAGIC* mg;
613{
88e89b8a
PP
614 my_setenv(((mg->mg_len == HEf_SVKEY) ?
615 SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr),Nullch);
85e6fe83
LW
616 return 0;
617}
618
3d37d572
PP
619#ifdef HAS_SIGACTION
620/* set up reliable signal() clone */
621
622typedef void (*Sigfunc) _((int));
623
624static
625Sigfunc rsignal(signo,handler)
626int signo;
627Sigfunc handler;
628{
629 struct sigaction act,oact;
630
631 act.sa_handler = handler;
632 sigemptyset(&act.sa_mask);
633 act.sa_flags = 0;
3d37d572 634#ifdef SA_RESTART
88e89b8a 635 act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
3d37d572 636#endif
3d37d572
PP
637 if (sigaction(signo, &act, &oact) < 0)
638 return(SIG_ERR);
639 else
640 return(oact.sa_handler);
641}
642
643#else
644
645/* ah well, so much for reliability */
646
647#define rsignal(x,y) signal(x,y)
648
649#endif
650
88e89b8a
PP
651static sig_trapped;
652static
653Signal_t
654sig_trap(signo)
655int signo;
656{
657 sig_trapped++;
658}
659int
660magic_getsig(sv,mg)
661SV* sv;
662MAGIC* mg;
663{
664 I32 i;
665 /* Are we fetching a signal entry? */
8646b087 666 i = whichsig((mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr);
88e89b8a
PP
667 if (i) {
668 if(psig_ptr[i])
669 sv_setsv(sv,psig_ptr[i]);
670 else {
760ac839 671 void (*origsig) _((int));
88e89b8a
PP
672 /* get signal state without losing signals */
673 sig_trapped=0;
674 origsig = rsignal(i,sig_trap);
675 rsignal(i,origsig);
676 if(sig_trapped)
677 kill(getpid(),i);
678 /* cache state so we don't fetch it again */
679 if(origsig == SIG_IGN)
680 sv_setpv(sv,"IGNORE");
681 else
682 sv_setsv(sv,&sv_undef);
683 psig_ptr[i] = SvREFCNT_inc(sv);
684 SvTEMP_off(sv);
685 }
686 }
687 return 0;
688}
689int
690magic_clearsig(sv,mg)
691SV* sv;
692MAGIC* mg;
693{
694 I32 i;
695 /* Are we clearing a signal entry? */
8646b087 696 i = whichsig((mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr);
88e89b8a
PP
697 if (i) {
698 if(psig_ptr[i]) {
699 SvREFCNT_dec(psig_ptr[i]);
700 psig_ptr[i]=0;
701 }
702 if(psig_name[i]) {
703 SvREFCNT_dec(psig_name[i]);
704 psig_name[i]=0;
705 }
706 }
707 return 0;
708}
3d37d572 709
85e6fe83 710int
79072805
LW
711magic_setsig(sv,mg)
712SV* sv;
713MAGIC* mg;
714{
715 register char *s;
716 I32 i;
748a9306 717 SV** svp;
a0d0e21e 718
88e89b8a 719 s = (mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr;
748a9306
LW
720 if (*s == '_') {
721 if (strEQ(s,"__DIE__"))
722 svp = &diehook;
723 else if (strEQ(s,"__WARN__"))
724 svp = &warnhook;
725 else if (strEQ(s,"__PARSE__"))
726 svp = &parsehook;
727 else
728 croak("No such hook: %s", s);
729 i = 0;
4633a7c4
LW
730 if (*svp) {
731 SvREFCNT_dec(*svp);
732 *svp = 0;
733 }
748a9306
LW
734 }
735 else {
736 i = whichsig(s); /* ...no, a brick */
737 if (!i) {
738 if (dowarn || strEQ(s,"ALARM"))
739 warn("No such signal: SIG%s", s);
740 return 0;
741 }
88e89b8a
PP
742 if(psig_ptr[i])
743 SvREFCNT_dec(psig_ptr[i]);
744 psig_ptr[i] = SvREFCNT_inc(sv);
745 if(psig_name[i])
746 SvREFCNT_dec(psig_name[i]);
8646b087 747 psig_name[i] = newSVpv(s,strlen(s));
88e89b8a
PP
748 SvTEMP_off(sv); /* Make sure it doesn't go away on us */
749 SvREADONLY_on(psig_name[i]);
748a9306 750 }
a0d0e21e 751 if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
748a9306 752 if (i)
3d37d572 753 (void)rsignal(i,sighandler);
748a9306
LW
754 else
755 *svp = SvREFCNT_inc(sv);
a0d0e21e
LW
756 return 0;
757 }
758 s = SvPV_force(sv,na);
748a9306
LW
759 if (strEQ(s,"IGNORE")) {
760 if (i)
3d37d572 761 (void)rsignal(i,SIG_IGN);
748a9306
LW
762 else
763 *svp = 0;
764 }
765 else if (strEQ(s,"DEFAULT") || !*s) {
766 if (i)
3d37d572 767 (void)rsignal(i,SIG_DFL);
748a9306
LW
768 else
769 *svp = 0;
770 }
79072805 771 else {
760ac839
LW
772 if(hints & HINT_STRICT_REFS)
773 die(no_symref,s,"a subroutine");
2304df62
AD
774 if (!strchr(s,':') && !strchr(s,'\'')) {
775 sprintf(tokenbuf, "main::%s",s);
79072805
LW
776 sv_setpv(sv,tokenbuf);
777 }
748a9306 778 if (i)
3d37d572 779 (void)rsignal(i,sighandler);
748a9306
LW
780 else
781 *svp = SvREFCNT_inc(sv);
79072805
LW
782 }
783 return 0;
784}
785
786int
463ee0b2 787magic_setisa(sv,mg)
79072805
LW
788SV* sv;
789MAGIC* mg;
790{
463ee0b2
LW
791 sub_generation++;
792 return 0;
793}
794
a0d0e21e
LW
795#ifdef OVERLOAD
796
463ee0b2 797int
a0d0e21e 798magic_setamagic(sv,mg)
463ee0b2
LW
799SV* sv;
800MAGIC* mg;
801{
a0d0e21e
LW
802 /* HV_badAMAGIC_on(Sv_STASH(sv)); */
803 amagic_generation++;
463ee0b2 804
a0d0e21e
LW
805 return 0;
806}
807#endif /* OVERLOAD */
463ee0b2 808
a0d0e21e
LW
809static int
810magic_methpack(sv,mg,meth)
811SV* sv;
812MAGIC* mg;
813char *meth;
814{
815 dSP;
463ee0b2 816
a0d0e21e
LW
817 ENTER;
818 SAVETMPS;
819 PUSHMARK(sp);
820 EXTEND(sp, 2);
821 PUSHs(mg->mg_obj);
88e89b8a
PP
822 if (mg->mg_ptr) {
823 if (mg->mg_len >= 0)
824 PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
825 else if (mg->mg_len == HEf_SVKEY)
826 PUSHs((SV*)mg->mg_ptr);
827 }
a0d0e21e
LW
828 else if (mg->mg_type == 'p')
829 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
463ee0b2
LW
830 PUTBACK;
831
a0d0e21e
LW
832 if (perl_call_method(meth, G_SCALAR))
833 sv_setsv(sv, *stack_sp--);
463ee0b2 834
a0d0e21e
LW
835 FREETMPS;
836 LEAVE;
837 return 0;
838}
463ee0b2 839
a0d0e21e
LW
840int
841magic_getpack(sv,mg)
842SV* sv;
843MAGIC* mg;
844{
845 magic_methpack(sv,mg,"FETCH");
846 if (mg->mg_ptr)
847 mg->mg_flags |= MGf_GSKIP;
463ee0b2
LW
848 return 0;
849}
850
851int
852magic_setpack(sv,mg)
853SV* sv;
854MAGIC* mg;
855{
463ee0b2 856 dSP;
463ee0b2 857
a0d0e21e
LW
858 PUSHMARK(sp);
859 EXTEND(sp, 3);
860 PUSHs(mg->mg_obj);
88e89b8a
PP
861 if (mg->mg_ptr) {
862 if (mg->mg_len >= 0)
863 PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
864 else if (mg->mg_len == HEf_SVKEY)
865 PUSHs((SV*)mg->mg_ptr);
866 }
a0d0e21e
LW
867 else if (mg->mg_type == 'p')
868 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
463ee0b2
LW
869 PUSHs(sv);
870 PUTBACK;
871
a0d0e21e 872 perl_call_method("STORE", G_SCALAR|G_DISCARD);
463ee0b2
LW
873
874 return 0;
875}
876
877int
878magic_clearpack(sv,mg)
879SV* sv;
880MAGIC* mg;
881{
a0d0e21e
LW
882 return magic_methpack(sv,mg,"DELETE");
883}
463ee0b2 884
a0d0e21e
LW
885int magic_wipepack(sv,mg)
886SV* sv;
887MAGIC* mg;
888{
889 dSP;
463ee0b2 890
a0d0e21e
LW
891 PUSHMARK(sp);
892 XPUSHs(mg->mg_obj);
463ee0b2 893 PUTBACK;
463ee0b2 894
a0d0e21e 895 perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
463ee0b2
LW
896
897 return 0;
898}
899
900int
901magic_nextpack(sv,mg,key)
902SV* sv;
903MAGIC* mg;
904SV* key;
905{
463ee0b2 906 dSP;
a0d0e21e 907 char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
463ee0b2
LW
908
909 ENTER;
a0d0e21e
LW
910 SAVETMPS;
911 PUSHMARK(sp);
912 EXTEND(sp, 2);
913 PUSHs(mg->mg_obj);
463ee0b2
LW
914 if (SvOK(key))
915 PUSHs(key);
916 PUTBACK;
917
a0d0e21e
LW
918 if (perl_call_method(meth, G_SCALAR))
919 sv_setsv(key, *stack_sp--);
463ee0b2 920
a0d0e21e
LW
921 FREETMPS;
922 LEAVE;
79072805
LW
923 return 0;
924}
925
926int
a0d0e21e
LW
927magic_existspack(sv,mg)
928SV* sv;
929MAGIC* mg;
930{
931 return magic_methpack(sv,mg,"EXISTS");
932}
933
934int
79072805
LW
935magic_setdbline(sv,mg)
936SV* sv;
937MAGIC* mg;
938{
939 OP *o;
940 I32 i;
941 GV* gv;
942 SV** svp;
943
944 gv = DBline;
945 i = SvTRUE(sv);
946 svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
8990e307 947 if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
93a17b20 948 o->op_private = i;
79072805
LW
949 else
950 warn("Can't break at that line\n");
951 return 0;
952}
953
954int
955magic_getarylen(sv,mg)
956SV* sv;
957MAGIC* mg;
958{
a0d0e21e 959 sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
79072805
LW
960 return 0;
961}
962
963int
964magic_setarylen(sv,mg)
965SV* sv;
966MAGIC* mg;
967{
a0d0e21e
LW
968 av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
969 return 0;
970}
971
972int
973magic_getpos(sv,mg)
974SV* sv;
975MAGIC* mg;
976{
977 SV* lsv = LvTARG(sv);
978
979 if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
980 mg = mg_find(lsv, 'g');
981 if (mg && mg->mg_len >= 0) {
982 sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
983 return 0;
984 }
985 }
986 (void)SvOK_off(sv);
987 return 0;
988}
989
990int
991magic_setpos(sv,mg)
992SV* sv;
993MAGIC* mg;
994{
995 SV* lsv = LvTARG(sv);
996 SSize_t pos;
997 STRLEN len;
998
999 mg = 0;
1000
1001 if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
1002 mg = mg_find(lsv, 'g');
1003 if (!mg) {
1004 if (!SvOK(sv))
1005 return 0;
1006 sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
1007 mg = mg_find(lsv, 'g');
1008 }
1009 else if (!SvOK(sv)) {
1010 mg->mg_len = -1;
1011 return 0;
1012 }
1013 len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
1014
1015 pos = SvIV(sv) - curcop->cop_arybase;
1016 if (pos < 0) {
1017 pos += len;
1018 if (pos < 0)
1019 pos = 0;
1020 }
1021 else if (pos > len)
1022 pos = len;
1023 mg->mg_len = pos;
1024
79072805
LW
1025 return 0;
1026}
1027
1028int
1029magic_getglob(sv,mg)
1030SV* sv;
1031MAGIC* mg;
1032{
8646b087
PP
1033 if (SvFAKE(sv)) { /* FAKE globs can get coerced */
1034 SvFAKE_off(sv);
1035 gv_efullname(sv,((GV*)sv), "*");
1036 SvFAKE_on(sv);
1037 }
1038 else
1039 gv_efullname(sv,((GV*)sv), "*"); /* a gv value, be nice */
79072805
LW
1040 return 0;
1041}
1042
1043int
1044magic_setglob(sv,mg)
1045SV* sv;
1046MAGIC* mg;
1047{
1048 register char *s;
1049 GV* gv;
1050
1051 if (!SvOK(sv))
1052 return 0;
463ee0b2 1053 s = SvPV(sv, na);
79072805
LW
1054 if (*s == '*' && s[1])
1055 s++;
85e6fe83 1056 gv = gv_fetchpv(s,TRUE, SVt_PVGV);
79072805
LW
1057 if (sv == (SV*)gv)
1058 return 0;
1059 if (GvGP(sv))
88e89b8a 1060 gp_free((GV*)sv);
79072805
LW
1061 GvGP(sv) = gp_ref(GvGP(gv));
1062 if (!GvAV(gv))
1063 gv_AVadd(gv);
1064 if (!GvHV(gv))
1065 gv_HVadd(gv);
a0d0e21e
LW
1066 if (!GvIOp(gv))
1067 GvIOp(gv) = newIO();
79072805
LW
1068 return 0;
1069}
1070
1071int
1072magic_setsubstr(sv,mg)
1073SV* sv;
1074MAGIC* mg;
1075{
8990e307
LW
1076 STRLEN len;
1077 char *tmps = SvPV(sv,len);
1078 sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
79072805
LW
1079 return 0;
1080}
1081
1082int
463ee0b2
LW
1083magic_gettaint(sv,mg)
1084SV* sv;
1085MAGIC* mg;
1086{
748a9306
LW
1087 if (mg->mg_len & 1)
1088 tainted = TRUE;
1089 else if (mg->mg_len & 2 && mg->mg_obj == sv) /* kludge */
1090 tainted = TRUE;
463ee0b2
LW
1091 return 0;
1092}
1093
1094int
1095magic_settaint(sv,mg)
1096SV* sv;
1097MAGIC* mg;
1098{
748a9306
LW
1099 if (localizing) {
1100 if (localizing == 1)
1101 mg->mg_len <<= 1;
1102 else
1103 mg->mg_len >>= 1;
a0d0e21e 1104 }
748a9306
LW
1105 else if (tainted)
1106 mg->mg_len |= 1;
1107 else
1108 mg->mg_len &= ~1;
463ee0b2
LW
1109 return 0;
1110}
1111
1112int
79072805
LW
1113magic_setvec(sv,mg)
1114SV* sv;
1115MAGIC* mg;
1116{
1117 do_vecset(sv); /* XXX slurp this routine */
1118 return 0;
1119}
1120
1121int
93a17b20
LW
1122magic_setmglob(sv,mg)
1123SV* sv;
1124MAGIC* mg;
1125{
a0d0e21e 1126 mg->mg_len = -1;
c6496cc7 1127 SvSCREAM_off(sv);
93a17b20
LW
1128 return 0;
1129}
1130
1131int
79072805
LW
1132magic_setbm(sv,mg)
1133SV* sv;
1134MAGIC* mg;
1135{
463ee0b2 1136 sv_unmagic(sv, 'B');
79072805
LW
1137 SvVALID_off(sv);
1138 return 0;
1139}
1140
1141int
1142magic_setuvar(sv,mg)
1143SV* sv;
1144MAGIC* mg;
1145{
1146 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
1147
1148 if (uf && uf->uf_set)
1149 (*uf->uf_set)(uf->uf_index, sv);
1150 return 0;
1151}
1152
1153int
1154magic_set(sv,mg)
1155SV* sv;
1156MAGIC* mg;
1157{
1158 register char *s;
1159 I32 i;
8990e307 1160 STRLEN len;
79072805 1161 switch (*mg->mg_ptr) {
748a9306
LW
1162 case '\001': /* ^A */
1163 sv_setsv(bodytarget, sv);
1164 break;
79072805 1165 case '\004': /* ^D */
8990e307 1166 debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
79072805
LW
1167 DEBUG_x(dump_all());
1168 break;
28f23441
PP
1169 case '\005': /* ^E */
1170#ifdef VMS
1171 set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1172#else
1173 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4); /* will anyone ever use this? */
1174#endif
1175 break;
79072805 1176 case '\006': /* ^F */
463ee0b2 1177 maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805 1178 break;
a0d0e21e
LW
1179 case '\010': /* ^H */
1180 hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1181 break;
79072805
LW
1182 case '\t': /* ^I */
1183 if (inplace)
1184 Safefree(inplace);
1185 if (SvOK(sv))
a0d0e21e 1186 inplace = savepv(SvPV(sv,na));
79072805
LW
1187 else
1188 inplace = Nullch;
1189 break;
28f23441
PP
1190 case '\017': /* ^O */
1191 if (osname)
1192 Safefree(osname);
1193 if (SvOK(sv))
1194 osname = savepv(SvPV(sv,na));
1195 else
1196 osname = Nullch;
1197 break;
79072805 1198 case '\020': /* ^P */
463ee0b2 1199 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1200 if (i != perldb) {
1201 if (perldb)
1202 oldlastpm = curpm;
1203 else
1204 curpm = oldlastpm;
1205 }
1206 perldb = i;
1207 break;
1208 case '\024': /* ^T */
88e89b8a
PP
1209#ifdef BIG_TIME
1210 basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
1211#else
85e6fe83 1212 basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
88e89b8a 1213#endif
79072805
LW
1214 break;
1215 case '\027': /* ^W */
463ee0b2 1216 dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1217 break;
1218 case '.':
748a9306
LW
1219 if (localizing) {
1220 if (localizing == 1)
1221 save_sptr((SV**)&last_in_gv);
1222 }
88e89b8a 1223 else if (SvOK(sv) && GvIO(last_in_gv))
a0d0e21e 1224 IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
79072805
LW
1225 break;
1226 case '^':
a0d0e21e
LW
1227 Safefree(IoTOP_NAME(GvIOp(defoutgv)));
1228 IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
1229 IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
79072805
LW
1230 break;
1231 case '~':
a0d0e21e
LW
1232 Safefree(IoFMT_NAME(GvIOp(defoutgv)));
1233 IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
1234 IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
79072805
LW
1235 break;
1236 case '=':
a0d0e21e 1237 IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1238 break;
1239 case '-':
a0d0e21e
LW
1240 IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1241 if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
1242 IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
79072805
LW
1243 break;
1244 case '%':
a0d0e21e 1245 IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1246 break;
1247 case '|':
a0d0e21e 1248 IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
463ee0b2 1249 if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
a0d0e21e 1250 IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
79072805
LW
1251 }
1252 break;
1253 case '*':
463ee0b2 1254 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1255 multiline = (i != 0);
1256 break;
1257 case '/':
c07a80fd
PP
1258 SvREFCNT_dec(nrs);
1259 nrs = newSVsv(sv);
1260 SvREFCNT_dec(rs);
1261 rs = SvREFCNT_inc(nrs);
79072805
LW
1262 break;
1263 case '\\':
1264 if (ors)
1265 Safefree(ors);
a0d0e21e 1266 ors = savepv(SvPV(sv,orslen));
79072805
LW
1267 break;
1268 case ',':
1269 if (ofs)
1270 Safefree(ofs);
a0d0e21e 1271 ofs = savepv(SvPV(sv, ofslen));
79072805
LW
1272 break;
1273 case '#':
1274 if (ofmt)
1275 Safefree(ofmt);
a0d0e21e 1276 ofmt = savepv(SvPV(sv,na));
79072805
LW
1277 break;
1278 case '[':
a0d0e21e 1279 compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1280 break;
1281 case '?':
748a9306 1282 statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1283 break;
1284 case '!':
28f23441 1285 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno); /* will anyone ever use this? */
79072805
LW
1286 break;
1287 case '<':
463ee0b2 1288 uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1289 if (delaymagic) {
1290 delaymagic |= DM_RUID;
1291 break; /* don't do magic till later */
1292 }
1293#ifdef HAS_SETRUID
85e6fe83 1294 (void)setruid((Uid_t)uid);
79072805
LW
1295#else
1296#ifdef HAS_SETREUID
85e6fe83 1297 (void)setreuid((Uid_t)uid, (Uid_t)-1);
748a9306 1298#else
85e6fe83
LW
1299#ifdef HAS_SETRESUID
1300 (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
79072805
LW
1301#else
1302 if (uid == euid) /* special case $< = $> */
1303 (void)setuid(uid);
a0d0e21e
LW
1304 else {
1305 uid = (I32)getuid();
463ee0b2 1306 croak("setruid() not implemented");
a0d0e21e 1307 }
79072805
LW
1308#endif
1309#endif
85e6fe83 1310#endif
748a9306 1311 uid = (I32)getuid();
4633a7c4 1312 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1313 break;
1314 case '>':
463ee0b2 1315 euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1316 if (delaymagic) {
1317 delaymagic |= DM_EUID;
1318 break; /* don't do magic till later */
1319 }
1320#ifdef HAS_SETEUID
85e6fe83 1321 (void)seteuid((Uid_t)euid);
79072805
LW
1322#else
1323#ifdef HAS_SETREUID
85e6fe83
LW
1324 (void)setreuid((Uid_t)-1, (Uid_t)euid);
1325#else
1326#ifdef HAS_SETRESUID
1327 (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
79072805
LW
1328#else
1329 if (euid == uid) /* special case $> = $< */
1330 setuid(euid);
a0d0e21e
LW
1331 else {
1332 euid = (I32)geteuid();
463ee0b2 1333 croak("seteuid() not implemented");
a0d0e21e 1334 }
79072805
LW
1335#endif
1336#endif
85e6fe83 1337#endif
79072805 1338 euid = (I32)geteuid();
4633a7c4 1339 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1340 break;
1341 case '(':
463ee0b2 1342 gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1343 if (delaymagic) {
1344 delaymagic |= DM_RGID;
1345 break; /* don't do magic till later */
1346 }
1347#ifdef HAS_SETRGID
85e6fe83 1348 (void)setrgid((Gid_t)gid);
79072805
LW
1349#else
1350#ifdef HAS_SETREGID
85e6fe83
LW
1351 (void)setregid((Gid_t)gid, (Gid_t)-1);
1352#else
1353#ifdef HAS_SETRESGID
1354 (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
79072805
LW
1355#else
1356 if (gid == egid) /* special case $( = $) */
1357 (void)setgid(gid);
748a9306
LW
1358 else {
1359 gid = (I32)getgid();
463ee0b2 1360 croak("setrgid() not implemented");
748a9306 1361 }
79072805
LW
1362#endif
1363#endif
85e6fe83 1364#endif
79072805 1365 gid = (I32)getgid();
4633a7c4 1366 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1367 break;
1368 case ')':
463ee0b2 1369 egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1370 if (delaymagic) {
1371 delaymagic |= DM_EGID;
1372 break; /* don't do magic till later */
1373 }
1374#ifdef HAS_SETEGID
85e6fe83 1375 (void)setegid((Gid_t)egid);
79072805
LW
1376#else
1377#ifdef HAS_SETREGID
85e6fe83
LW
1378 (void)setregid((Gid_t)-1, (Gid_t)egid);
1379#else
1380#ifdef HAS_SETRESGID
1381 (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
79072805
LW
1382#else
1383 if (egid == gid) /* special case $) = $( */
1384 (void)setgid(egid);
748a9306
LW
1385 else {
1386 egid = (I32)getegid();
463ee0b2 1387 croak("setegid() not implemented");
748a9306 1388 }
79072805
LW
1389#endif
1390#endif
85e6fe83 1391#endif
79072805 1392 egid = (I32)getegid();
4633a7c4 1393 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1394 break;
1395 case ':':
a0d0e21e 1396 chopset = SvPV_force(sv,na);
79072805
LW
1397 break;
1398 case '0':
1399 if (!origalen) {
1400 s = origargv[0];
1401 s += strlen(s);
1402 /* See if all the arguments are contiguous in memory */
1403 for (i = 1; i < origargc; i++) {
1404 if (origargv[i] == s + 1)
1405 s += strlen(++s); /* this one is ok too */
1406 }
1407 if (origenviron[0] == s + 1) { /* can grab env area too? */
1408 my_setenv("NoNeSuCh", Nullch);
1409 /* force copy of environment */
1410 for (i = 0; origenviron[i]; i++)
1411 if (origenviron[i] == s + 1)
1412 s += strlen(++s);
1413 }
1414 origalen = s - origargv[0];
1415 }
a0d0e21e 1416 s = SvPV_force(sv,len);
8990e307 1417 i = len;
79072805
LW
1418 if (i >= origalen) {
1419 i = origalen;
1420 SvCUR_set(sv, i);
1421 *SvEND(sv) = '\0';
1422 Copy(s, origargv[0], i, char);
1423 }
1424 else {
1425 Copy(s, origargv[0], i, char);
1426 s = origargv[0]+i;
1427 *s++ = '\0';
1428 while (++i < origalen)
8990e307
LW
1429 *s++ = ' ';
1430 s = origargv[0]+i;
ed6116ce 1431 for (i = 1; i < origargc; i++)
8990e307 1432 origargv[i] = Nullch;
79072805
LW
1433 }
1434 break;
1435 }
1436 return 0;
1437}
1438
1439I32
1440whichsig(sig)
1441char *sig;
1442{
1443 register char **sigv;
1444
1445 for (sigv = sig_name+1; *sigv; sigv++)
1446 if (strEQ(sig,*sigv))
8e07c86e 1447 return sig_num[sigv - sig_name];
79072805
LW
1448#ifdef SIGCLD
1449 if (strEQ(sig,"CHLD"))
1450 return SIGCLD;
1451#endif
1452#ifdef SIGCHLD
1453 if (strEQ(sig,"CLD"))
1454 return SIGCHLD;
1455#endif
1456 return 0;
1457}
1458
ecfc5424 1459Signal_t
79072805 1460sighandler(sig)
a0d0e21e 1461int sig;
79072805
LW
1462{
1463 dSP;
1464 GV *gv;
a0d0e21e 1465 HV *st;
79072805
LW
1466 SV *sv;
1467 CV *cv;
79072805 1468 AV *oldstack;
760ac839
LW
1469
1470 if(!psig_ptr[sig])
1471 die("Signal SIG%s received, but no signal handler set.\n",
1472 sig_name[sig]);
79072805 1473
88e89b8a 1474 cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
a0d0e21e 1475 if (!cv || !CvROOT(cv)) {
79072805
LW
1476 if (dowarn)
1477 warn("SIG%s handler \"%s\" not defined.\n",
88e89b8a 1478 sig_name[sig], GvENAME(gv) );
79072805
LW
1479 return;
1480 }
1481
88e89b8a
PP
1482 oldstack = curstack;
1483 if (curstack != signalstack)
a0d0e21e 1484 AvFILL(signalstack) = 0;
88e89b8a 1485 SWITCHSTACK(curstack, signalstack);
79072805 1486
88e89b8a
PP
1487 if(psig_name[sig])
1488 sv = SvREFCNT_inc(psig_name[sig]);
1489 else {
1490 sv = sv_newmortal();
1491 sv_setpv(sv,sig_name[sig]);
1492 }
a0d0e21e 1493 PUSHMARK(sp);
79072805 1494 PUSHs(sv);
79072805 1495 PUTBACK;
a0d0e21e
LW
1496
1497 perl_call_sv((SV*)cv, G_DISCARD);
79072805
LW
1498
1499 SWITCHSTACK(signalstack, oldstack);
79072805
LW
1500
1501 return;
1502}