This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Not all sbrks return zeroed memory.
[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);
188ea221 355 sv_setiv(sv, (IV)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
188ea221 363 sv_setiv(sv, (IV)Perl_rc);
88e89b8a
PP
364 sv_setpv(sv, os2error(Perl_rc));
365#else
188ea221 366 sv_setiv(sv, (IV)errno);
28f23441
PP
367 sv_setpv(sv, errno ? Strerror(errno) : "");
368#endif
88e89b8a 369#endif
188ea221 370 SvIOK_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
188ea221 509 sv_setiv(sv, (IV)((errno == EVMSERR) ? vaxc$errno : errno));
88e89b8a 510 sv_setpv(sv, errno ? Strerror(errno) : "");
a5f75d66 511#else
88e89b8a
PP
512 {
513 int saveerrno = errno;
188ea221 514 sv_setiv(sv, (IV)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
188ea221 523 SvIOK_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);
188ea221 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
a0d0e21e
LW
818static int
819magic_methpack(sv,mg,meth)
820SV* sv;
821MAGIC* mg;
822char *meth;
823{
824 dSP;
463ee0b2 825
a0d0e21e
LW
826 ENTER;
827 SAVETMPS;
828 PUSHMARK(sp);
829 EXTEND(sp, 2);
830 PUSHs(mg->mg_obj);
88e89b8a
PP
831 if (mg->mg_ptr) {
832 if (mg->mg_len >= 0)
833 PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
834 else if (mg->mg_len == HEf_SVKEY)
835 PUSHs((SV*)mg->mg_ptr);
836 }
a0d0e21e
LW
837 else if (mg->mg_type == 'p')
838 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
463ee0b2
LW
839 PUTBACK;
840
a0d0e21e
LW
841 if (perl_call_method(meth, G_SCALAR))
842 sv_setsv(sv, *stack_sp--);
463ee0b2 843
a0d0e21e
LW
844 FREETMPS;
845 LEAVE;
846 return 0;
847}
463ee0b2 848
a0d0e21e
LW
849int
850magic_getpack(sv,mg)
851SV* sv;
852MAGIC* mg;
853{
854 magic_methpack(sv,mg,"FETCH");
855 if (mg->mg_ptr)
856 mg->mg_flags |= MGf_GSKIP;
463ee0b2
LW
857 return 0;
858}
859
860int
861magic_setpack(sv,mg)
862SV* sv;
863MAGIC* mg;
864{
463ee0b2 865 dSP;
463ee0b2 866
a0d0e21e
LW
867 PUSHMARK(sp);
868 EXTEND(sp, 3);
869 PUSHs(mg->mg_obj);
88e89b8a
PP
870 if (mg->mg_ptr) {
871 if (mg->mg_len >= 0)
872 PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
873 else if (mg->mg_len == HEf_SVKEY)
874 PUSHs((SV*)mg->mg_ptr);
875 }
a0d0e21e
LW
876 else if (mg->mg_type == 'p')
877 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
463ee0b2
LW
878 PUSHs(sv);
879 PUTBACK;
880
a0d0e21e 881 perl_call_method("STORE", G_SCALAR|G_DISCARD);
463ee0b2
LW
882
883 return 0;
884}
885
886int
887magic_clearpack(sv,mg)
888SV* sv;
889MAGIC* mg;
890{
a0d0e21e
LW
891 return magic_methpack(sv,mg,"DELETE");
892}
463ee0b2 893
a0d0e21e
LW
894int magic_wipepack(sv,mg)
895SV* sv;
896MAGIC* mg;
897{
898 dSP;
463ee0b2 899
a0d0e21e
LW
900 PUSHMARK(sp);
901 XPUSHs(mg->mg_obj);
463ee0b2 902 PUTBACK;
463ee0b2 903
a0d0e21e 904 perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
463ee0b2
LW
905
906 return 0;
907}
908
909int
910magic_nextpack(sv,mg,key)
911SV* sv;
912MAGIC* mg;
913SV* key;
914{
463ee0b2 915 dSP;
a0d0e21e 916 char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
463ee0b2
LW
917
918 ENTER;
a0d0e21e
LW
919 SAVETMPS;
920 PUSHMARK(sp);
921 EXTEND(sp, 2);
922 PUSHs(mg->mg_obj);
463ee0b2
LW
923 if (SvOK(key))
924 PUSHs(key);
925 PUTBACK;
926
a0d0e21e
LW
927 if (perl_call_method(meth, G_SCALAR))
928 sv_setsv(key, *stack_sp--);
463ee0b2 929
a0d0e21e
LW
930 FREETMPS;
931 LEAVE;
79072805
LW
932 return 0;
933}
934
935int
a0d0e21e
LW
936magic_existspack(sv,mg)
937SV* sv;
938MAGIC* mg;
939{
940 return magic_methpack(sv,mg,"EXISTS");
941}
942
943int
79072805
LW
944magic_setdbline(sv,mg)
945SV* sv;
946MAGIC* mg;
947{
948 OP *o;
949 I32 i;
950 GV* gv;
951 SV** svp;
952
953 gv = DBline;
954 i = SvTRUE(sv);
188ea221
CS
955 svp = av_fetch(GvAV(gv),
956 atoi(MgPV(mg)), FALSE);
8990e307 957 if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
93a17b20 958 o->op_private = i;
79072805
LW
959 else
960 warn("Can't break at that line\n");
961 return 0;
962}
963
964int
965magic_getarylen(sv,mg)
966SV* sv;
967MAGIC* mg;
968{
a0d0e21e 969 sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
79072805
LW
970 return 0;
971}
972
973int
974magic_setarylen(sv,mg)
975SV* sv;
976MAGIC* mg;
977{
a0d0e21e
LW
978 av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
979 return 0;
980}
981
982int
983magic_getpos(sv,mg)
984SV* sv;
985MAGIC* mg;
986{
987 SV* lsv = LvTARG(sv);
988
989 if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
990 mg = mg_find(lsv, 'g');
991 if (mg && mg->mg_len >= 0) {
992 sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
993 return 0;
994 }
995 }
996 (void)SvOK_off(sv);
997 return 0;
998}
999
1000int
1001magic_setpos(sv,mg)
1002SV* sv;
1003MAGIC* mg;
1004{
1005 SV* lsv = LvTARG(sv);
1006 SSize_t pos;
1007 STRLEN len;
1008
1009 mg = 0;
1010
1011 if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
1012 mg = mg_find(lsv, 'g');
1013 if (!mg) {
1014 if (!SvOK(sv))
1015 return 0;
1016 sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
1017 mg = mg_find(lsv, 'g');
1018 }
1019 else if (!SvOK(sv)) {
1020 mg->mg_len = -1;
1021 return 0;
1022 }
1023 len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
1024
1025 pos = SvIV(sv) - curcop->cop_arybase;
1026 if (pos < 0) {
1027 pos += len;
1028 if (pos < 0)
1029 pos = 0;
1030 }
1031 else if (pos > len)
1032 pos = len;
1033 mg->mg_len = pos;
1034
79072805
LW
1035 return 0;
1036}
1037
1038int
1039magic_getglob(sv,mg)
1040SV* sv;
1041MAGIC* mg;
1042{
8646b087
PP
1043 if (SvFAKE(sv)) { /* FAKE globs can get coerced */
1044 SvFAKE_off(sv);
1045 gv_efullname(sv,((GV*)sv), "*");
1046 SvFAKE_on(sv);
1047 }
1048 else
1049 gv_efullname(sv,((GV*)sv), "*"); /* a gv value, be nice */
79072805
LW
1050 return 0;
1051}
1052
1053int
1054magic_setglob(sv,mg)
1055SV* sv;
1056MAGIC* mg;
1057{
1058 register char *s;
1059 GV* gv;
1060
1061 if (!SvOK(sv))
1062 return 0;
463ee0b2 1063 s = SvPV(sv, na);
79072805
LW
1064 if (*s == '*' && s[1])
1065 s++;
85e6fe83 1066 gv = gv_fetchpv(s,TRUE, SVt_PVGV);
79072805
LW
1067 if (sv == (SV*)gv)
1068 return 0;
1069 if (GvGP(sv))
88e89b8a 1070 gp_free((GV*)sv);
79072805
LW
1071 GvGP(sv) = gp_ref(GvGP(gv));
1072 if (!GvAV(gv))
1073 gv_AVadd(gv);
1074 if (!GvHV(gv))
1075 gv_HVadd(gv);
a0d0e21e
LW
1076 if (!GvIOp(gv))
1077 GvIOp(gv) = newIO();
79072805
LW
1078 return 0;
1079}
1080
1081int
1082magic_setsubstr(sv,mg)
1083SV* sv;
1084MAGIC* mg;
1085{
8990e307
LW
1086 STRLEN len;
1087 char *tmps = SvPV(sv,len);
1088 sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
79072805
LW
1089 return 0;
1090}
1091
1092int
463ee0b2
LW
1093magic_gettaint(sv,mg)
1094SV* sv;
1095MAGIC* mg;
1096{
748a9306
LW
1097 if (mg->mg_len & 1)
1098 tainted = TRUE;
1099 else if (mg->mg_len & 2 && mg->mg_obj == sv) /* kludge */
1100 tainted = TRUE;
463ee0b2
LW
1101 return 0;
1102}
1103
1104int
1105magic_settaint(sv,mg)
1106SV* sv;
1107MAGIC* mg;
1108{
748a9306
LW
1109 if (localizing) {
1110 if (localizing == 1)
1111 mg->mg_len <<= 1;
1112 else
1113 mg->mg_len >>= 1;
a0d0e21e 1114 }
748a9306
LW
1115 else if (tainted)
1116 mg->mg_len |= 1;
1117 else
1118 mg->mg_len &= ~1;
463ee0b2
LW
1119 return 0;
1120}
1121
1122int
79072805
LW
1123magic_setvec(sv,mg)
1124SV* sv;
1125MAGIC* mg;
1126{
1127 do_vecset(sv); /* XXX slurp this routine */
1128 return 0;
1129}
1130
1131int
93a17b20
LW
1132magic_setmglob(sv,mg)
1133SV* sv;
1134MAGIC* mg;
1135{
a0d0e21e 1136 mg->mg_len = -1;
c6496cc7 1137 SvSCREAM_off(sv);
93a17b20
LW
1138 return 0;
1139}
1140
1141int
79072805
LW
1142magic_setbm(sv,mg)
1143SV* sv;
1144MAGIC* mg;
1145{
463ee0b2 1146 sv_unmagic(sv, 'B');
79072805
LW
1147 SvVALID_off(sv);
1148 return 0;
1149}
1150
1151int
1152magic_setuvar(sv,mg)
1153SV* sv;
1154MAGIC* mg;
1155{
1156 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
1157
1158 if (uf && uf->uf_set)
1159 (*uf->uf_set)(uf->uf_index, sv);
1160 return 0;
1161}
1162
1163int
1164magic_set(sv,mg)
1165SV* sv;
1166MAGIC* mg;
1167{
1168 register char *s;
1169 I32 i;
8990e307 1170 STRLEN len;
79072805 1171 switch (*mg->mg_ptr) {
748a9306
LW
1172 case '\001': /* ^A */
1173 sv_setsv(bodytarget, sv);
1174 break;
79072805 1175 case '\004': /* ^D */
8990e307 1176 debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
79072805
LW
1177 DEBUG_x(dump_all());
1178 break;
28f23441
PP
1179 case '\005': /* ^E */
1180#ifdef VMS
1181 set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1182#else
1183 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4); /* will anyone ever use this? */
1184#endif
1185 break;
79072805 1186 case '\006': /* ^F */
463ee0b2 1187 maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805 1188 break;
a0d0e21e
LW
1189 case '\010': /* ^H */
1190 hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1191 break;
79072805
LW
1192 case '\t': /* ^I */
1193 if (inplace)
1194 Safefree(inplace);
1195 if (SvOK(sv))
a0d0e21e 1196 inplace = savepv(SvPV(sv,na));
79072805
LW
1197 else
1198 inplace = Nullch;
1199 break;
28f23441
PP
1200 case '\017': /* ^O */
1201 if (osname)
1202 Safefree(osname);
1203 if (SvOK(sv))
1204 osname = savepv(SvPV(sv,na));
1205 else
1206 osname = Nullch;
1207 break;
79072805 1208 case '\020': /* ^P */
463ee0b2 1209 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1210 if (i != perldb) {
1211 if (perldb)
1212 oldlastpm = curpm;
1213 else
1214 curpm = oldlastpm;
1215 }
1216 perldb = i;
1217 break;
1218 case '\024': /* ^T */
88e89b8a
PP
1219#ifdef BIG_TIME
1220 basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
1221#else
85e6fe83 1222 basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
88e89b8a 1223#endif
79072805
LW
1224 break;
1225 case '\027': /* ^W */
463ee0b2 1226 dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1227 break;
1228 case '.':
748a9306
LW
1229 if (localizing) {
1230 if (localizing == 1)
1231 save_sptr((SV**)&last_in_gv);
1232 }
88e89b8a 1233 else if (SvOK(sv) && GvIO(last_in_gv))
a0d0e21e 1234 IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
79072805
LW
1235 break;
1236 case '^':
a0d0e21e
LW
1237 Safefree(IoTOP_NAME(GvIOp(defoutgv)));
1238 IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
1239 IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
79072805
LW
1240 break;
1241 case '~':
a0d0e21e
LW
1242 Safefree(IoFMT_NAME(GvIOp(defoutgv)));
1243 IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
1244 IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
79072805
LW
1245 break;
1246 case '=':
a0d0e21e 1247 IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1248 break;
1249 case '-':
a0d0e21e
LW
1250 IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1251 if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
1252 IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
79072805
LW
1253 break;
1254 case '%':
a0d0e21e 1255 IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1256 break;
1257 case '|':
a0d0e21e 1258 IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
463ee0b2 1259 if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
a0d0e21e 1260 IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
79072805
LW
1261 }
1262 break;
1263 case '*':
463ee0b2 1264 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1265 multiline = (i != 0);
1266 break;
1267 case '/':
c07a80fd
PP
1268 SvREFCNT_dec(nrs);
1269 nrs = newSVsv(sv);
1270 SvREFCNT_dec(rs);
1271 rs = SvREFCNT_inc(nrs);
79072805
LW
1272 break;
1273 case '\\':
1274 if (ors)
1275 Safefree(ors);
a0d0e21e 1276 ors = savepv(SvPV(sv,orslen));
79072805
LW
1277 break;
1278 case ',':
1279 if (ofs)
1280 Safefree(ofs);
a0d0e21e 1281 ofs = savepv(SvPV(sv, ofslen));
79072805
LW
1282 break;
1283 case '#':
1284 if (ofmt)
1285 Safefree(ofmt);
a0d0e21e 1286 ofmt = savepv(SvPV(sv,na));
79072805
LW
1287 break;
1288 case '[':
a0d0e21e 1289 compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1290 break;
1291 case '?':
748a9306 1292 statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1293 break;
1294 case '!':
28f23441 1295 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno); /* will anyone ever use this? */
79072805
LW
1296 break;
1297 case '<':
463ee0b2 1298 uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1299 if (delaymagic) {
1300 delaymagic |= DM_RUID;
1301 break; /* don't do magic till later */
1302 }
1303#ifdef HAS_SETRUID
85e6fe83 1304 (void)setruid((Uid_t)uid);
79072805
LW
1305#else
1306#ifdef HAS_SETREUID
85e6fe83 1307 (void)setreuid((Uid_t)uid, (Uid_t)-1);
748a9306 1308#else
85e6fe83
LW
1309#ifdef HAS_SETRESUID
1310 (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
79072805
LW
1311#else
1312 if (uid == euid) /* special case $< = $> */
1313 (void)setuid(uid);
a0d0e21e
LW
1314 else {
1315 uid = (I32)getuid();
463ee0b2 1316 croak("setruid() not implemented");
a0d0e21e 1317 }
79072805
LW
1318#endif
1319#endif
85e6fe83 1320#endif
748a9306 1321 uid = (I32)getuid();
4633a7c4 1322 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1323 break;
1324 case '>':
463ee0b2 1325 euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1326 if (delaymagic) {
1327 delaymagic |= DM_EUID;
1328 break; /* don't do magic till later */
1329 }
1330#ifdef HAS_SETEUID
85e6fe83 1331 (void)seteuid((Uid_t)euid);
79072805
LW
1332#else
1333#ifdef HAS_SETREUID
85e6fe83
LW
1334 (void)setreuid((Uid_t)-1, (Uid_t)euid);
1335#else
1336#ifdef HAS_SETRESUID
1337 (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
79072805
LW
1338#else
1339 if (euid == uid) /* special case $> = $< */
1340 setuid(euid);
a0d0e21e
LW
1341 else {
1342 euid = (I32)geteuid();
463ee0b2 1343 croak("seteuid() not implemented");
a0d0e21e 1344 }
79072805
LW
1345#endif
1346#endif
85e6fe83 1347#endif
79072805 1348 euid = (I32)geteuid();
4633a7c4 1349 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1350 break;
1351 case '(':
463ee0b2 1352 gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1353 if (delaymagic) {
1354 delaymagic |= DM_RGID;
1355 break; /* don't do magic till later */
1356 }
1357#ifdef HAS_SETRGID
85e6fe83 1358 (void)setrgid((Gid_t)gid);
79072805
LW
1359#else
1360#ifdef HAS_SETREGID
85e6fe83
LW
1361 (void)setregid((Gid_t)gid, (Gid_t)-1);
1362#else
1363#ifdef HAS_SETRESGID
1364 (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
79072805
LW
1365#else
1366 if (gid == egid) /* special case $( = $) */
1367 (void)setgid(gid);
748a9306
LW
1368 else {
1369 gid = (I32)getgid();
463ee0b2 1370 croak("setrgid() not implemented");
748a9306 1371 }
79072805
LW
1372#endif
1373#endif
85e6fe83 1374#endif
79072805 1375 gid = (I32)getgid();
4633a7c4 1376 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1377 break;
1378 case ')':
463ee0b2 1379 egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1380 if (delaymagic) {
1381 delaymagic |= DM_EGID;
1382 break; /* don't do magic till later */
1383 }
1384#ifdef HAS_SETEGID
85e6fe83 1385 (void)setegid((Gid_t)egid);
79072805
LW
1386#else
1387#ifdef HAS_SETREGID
85e6fe83
LW
1388 (void)setregid((Gid_t)-1, (Gid_t)egid);
1389#else
1390#ifdef HAS_SETRESGID
1391 (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
79072805
LW
1392#else
1393 if (egid == gid) /* special case $) = $( */
1394 (void)setgid(egid);
748a9306
LW
1395 else {
1396 egid = (I32)getegid();
463ee0b2 1397 croak("setegid() not implemented");
748a9306 1398 }
79072805
LW
1399#endif
1400#endif
85e6fe83 1401#endif
79072805 1402 egid = (I32)getegid();
4633a7c4 1403 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1404 break;
1405 case ':':
a0d0e21e 1406 chopset = SvPV_force(sv,na);
79072805
LW
1407 break;
1408 case '0':
1409 if (!origalen) {
1410 s = origargv[0];
1411 s += strlen(s);
1412 /* See if all the arguments are contiguous in memory */
1413 for (i = 1; i < origargc; i++) {
1414 if (origargv[i] == s + 1)
1415 s += strlen(++s); /* this one is ok too */
1416 }
1417 if (origenviron[0] == s + 1) { /* can grab env area too? */
1418 my_setenv("NoNeSuCh", Nullch);
1419 /* force copy of environment */
1420 for (i = 0; origenviron[i]; i++)
1421 if (origenviron[i] == s + 1)
1422 s += strlen(++s);
1423 }
1424 origalen = s - origargv[0];
1425 }
a0d0e21e 1426 s = SvPV_force(sv,len);
8990e307 1427 i = len;
79072805
LW
1428 if (i >= origalen) {
1429 i = origalen;
1430 SvCUR_set(sv, i);
1431 *SvEND(sv) = '\0';
1432 Copy(s, origargv[0], i, char);
1433 }
1434 else {
1435 Copy(s, origargv[0], i, char);
1436 s = origargv[0]+i;
1437 *s++ = '\0';
1438 while (++i < origalen)
8990e307
LW
1439 *s++ = ' ';
1440 s = origargv[0]+i;
ed6116ce 1441 for (i = 1; i < origargc; i++)
8990e307 1442 origargv[i] = Nullch;
79072805
LW
1443 }
1444 break;
1445 }
1446 return 0;
1447}
1448
1449I32
1450whichsig(sig)
1451char *sig;
1452{
1453 register char **sigv;
1454
1455 for (sigv = sig_name+1; *sigv; sigv++)
1456 if (strEQ(sig,*sigv))
8e07c86e 1457 return sig_num[sigv - sig_name];
79072805
LW
1458#ifdef SIGCLD
1459 if (strEQ(sig,"CHLD"))
1460 return SIGCLD;
1461#endif
1462#ifdef SIGCHLD
1463 if (strEQ(sig,"CLD"))
1464 return SIGCHLD;
1465#endif
1466 return 0;
1467}
1468
ecfc5424 1469Signal_t
79072805 1470sighandler(sig)
a0d0e21e 1471int sig;
79072805
LW
1472{
1473 dSP;
1474 GV *gv;
a0d0e21e 1475 HV *st;
79072805
LW
1476 SV *sv;
1477 CV *cv;
79072805 1478 AV *oldstack;
760ac839
LW
1479
1480 if(!psig_ptr[sig])
1481 die("Signal SIG%s received, but no signal handler set.\n",
1482 sig_name[sig]);
79072805 1483
88e89b8a 1484 cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
a0d0e21e 1485 if (!cv || !CvROOT(cv)) {
79072805
LW
1486 if (dowarn)
1487 warn("SIG%s handler \"%s\" not defined.\n",
88e89b8a 1488 sig_name[sig], GvENAME(gv) );
79072805
LW
1489 return;
1490 }
1491
88e89b8a
PP
1492 oldstack = curstack;
1493 if (curstack != signalstack)
a0d0e21e 1494 AvFILL(signalstack) = 0;
88e89b8a 1495 SWITCHSTACK(curstack, signalstack);
79072805 1496
88e89b8a
PP
1497 if(psig_name[sig])
1498 sv = SvREFCNT_inc(psig_name[sig]);
1499 else {
1500 sv = sv_newmortal();
1501 sv_setpv(sv,sig_name[sig]);
1502 }
a0d0e21e 1503 PUSHMARK(sp);
79072805 1504 PUSHs(sv);
79072805 1505 PUTBACK;
a0d0e21e
LW
1506
1507 perl_call_sv((SV*)cv, G_DISCARD);
79072805
LW
1508
1509 SWITCHSTACK(signalstack, oldstack);
79072805
LW
1510
1511 return;
1512}