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