Commit | Line | Data |
9ef589d8 |
1 | /* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $ |
a687059c |
2 | * |
9ef589d8 |
3 | * Copyright (c) 1991, Larry Wall |
a687059c |
4 | * |
9ef589d8 |
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. |
8d063cd8 |
7 | * |
8 | * $Log: stab.c,v $ |
9ef589d8 |
9 | * Revision 4.0.1.2 91/06/07 11:55:53 lwall |
10 | * patch4: new copyright notice |
11 | * patch4: added $^P variable to control calling of perldb routines |
12 | * patch4: added $^F variable to specify maximum system fd, default 2 |
13 | * patch4: $` was busted inside s/// |
14 | * patch4: default top-of-form format is now FILEHANDLE_TOP |
15 | * patch4: length($`), length($&), length($') now optimized to avoid string copy |
16 | * patch4: $^D |= 1024 now does syntax tree dump at run-time |
17 | * |
35c8bce7 |
18 | * Revision 4.0.1.1 91/04/12 09:10:24 lwall |
19 | * patch1: Configure now differentiates getgroups() type from getgid() type |
20 | * patch1: you may now use "die" and "caller" in a signal handler |
21 | * |
fe14fcc3 |
22 | * Revision 4.0 91/03/20 01:39:41 lwall |
23 | * 4.0 baseline. |
8d063cd8 |
24 | * |
25 | */ |
26 | |
8d063cd8 |
27 | #include "EXTERN.h" |
8d063cd8 |
28 | #include "perl.h" |
29 | |
6eb13c3b |
30 | #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) |
378cc40b |
31 | #include <signal.h> |
00bf170e |
32 | #endif |
378cc40b |
33 | |
8d063cd8 |
34 | static char *sig_name[] = { |
a687059c |
35 | SIG_NAME,0 |
36 | }; |
8d063cd8 |
37 | |
663a0e37 |
38 | #ifdef VOIDSIG |
39 | #define handlertype void |
40 | #else |
41 | #define handlertype int |
42 | #endif |
2e1b3b7e |
43 | |
34de22dd |
44 | static handlertype sighandler(); |
45 | |
fe14fcc3 |
46 | static int origalen = 0; |
47 | |
8d063cd8 |
48 | STR * |
a687059c |
49 | stab_str(str) |
50 | STR *str; |
8d063cd8 |
51 | { |
a687059c |
52 | STAB *stab = str->str_u.str_stab; |
8d063cd8 |
53 | register int paren; |
54 | register char *s; |
378cc40b |
55 | register int i; |
8d063cd8 |
56 | |
a687059c |
57 | if (str->str_rare) |
58 | return stab_val(stab); |
59 | |
60 | switch (*stab->str_magic->str_ptr) { |
fe14fcc3 |
61 | case '\004': /* ^D */ |
62 | #ifdef DEBUGGING |
63 | str_numset(stab_val(stab),(double)(debug & 32767)); |
64 | #endif |
65 | break; |
9ef589d8 |
66 | case '\006': /* ^F */ |
67 | str_numset(stab_val(stab),(double)maxsysfd); |
68 | break; |
fe14fcc3 |
69 | case '\t': /* ^I */ |
70 | if (inplace) |
71 | str_set(stab_val(stab), inplace); |
72 | else |
73 | str_sset(stab_val(stab),&str_undef); |
74 | break; |
9ef589d8 |
75 | case '\020': /* ^P */ |
76 | str_numset(stab_val(stab),(double)perldb); |
77 | break; |
0a12ae7d |
78 | case '\024': /* ^T */ |
79 | str_numset(stab_val(stab),(double)basetime); |
80 | break; |
fe14fcc3 |
81 | case '\027': /* ^W */ |
82 | str_numset(stab_val(stab),(double)dowarn); |
83 | break; |
9f68db38 |
84 | case '1': case '2': case '3': case '4': |
8d063cd8 |
85 | case '5': case '6': case '7': case '8': case '9': case '&': |
86 | if (curspat) { |
a687059c |
87 | paren = atoi(stab_name(stab)); |
378cc40b |
88 | getparen: |
89 | if (curspat->spat_regexp && |
90 | paren <= curspat->spat_regexp->nparens && |
91 | (s = curspat->spat_regexp->startp[paren]) ) { |
92 | i = curspat->spat_regexp->endp[paren] - s; |
93 | if (i >= 0) |
a687059c |
94 | str_nset(stab_val(stab),s,i); |
378cc40b |
95 | else |
a687059c |
96 | str_sset(stab_val(stab),&str_undef); |
8d063cd8 |
97 | } |
378cc40b |
98 | else |
a687059c |
99 | str_sset(stab_val(stab),&str_undef); |
8d063cd8 |
100 | } |
101 | break; |
102 | case '+': |
103 | if (curspat) { |
378cc40b |
104 | paren = curspat->spat_regexp->lastparen; |
105 | goto getparen; |
8d063cd8 |
106 | } |
107 | break; |
a687059c |
108 | case '`': |
109 | if (curspat) { |
110 | if (curspat->spat_regexp && |
9ef589d8 |
111 | (s = curspat->spat_regexp->subbeg) ) { |
a687059c |
112 | i = curspat->spat_regexp->startp[0] - s; |
113 | if (i >= 0) |
114 | str_nset(stab_val(stab),s,i); |
115 | else |
116 | str_nset(stab_val(stab),"",0); |
117 | } |
118 | else |
119 | str_nset(stab_val(stab),"",0); |
120 | } |
121 | break; |
122 | case '\'': |
123 | if (curspat) { |
124 | if (curspat->spat_regexp && |
125 | (s = curspat->spat_regexp->endp[0]) ) { |
00bf170e |
126 | str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s); |
a687059c |
127 | } |
128 | else |
129 | str_nset(stab_val(stab),"",0); |
130 | } |
131 | break; |
8d063cd8 |
132 | case '.': |
a687059c |
133 | #ifndef lint |
8d063cd8 |
134 | if (last_in_stab) { |
a687059c |
135 | str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines); |
8d063cd8 |
136 | } |
a687059c |
137 | #endif |
8d063cd8 |
138 | break; |
139 | case '?': |
a687059c |
140 | str_numset(stab_val(stab),(double)statusvalue); |
8d063cd8 |
141 | break; |
142 | case '^': |
a687059c |
143 | s = stab_io(curoutstab)->top_name; |
9ef589d8 |
144 | if (s) |
145 | str_set(stab_val(stab),s); |
146 | else { |
147 | str_set(stab_val(stab),stab_name(curoutstab)); |
148 | str_cat(stab_val(stab),"_TOP"); |
149 | } |
8d063cd8 |
150 | break; |
151 | case '~': |
a687059c |
152 | s = stab_io(curoutstab)->fmt_name; |
9ef589d8 |
153 | if (!s) |
154 | s = stab_name(curoutstab); |
a687059c |
155 | str_set(stab_val(stab),s); |
8d063cd8 |
156 | break; |
a687059c |
157 | #ifndef lint |
8d063cd8 |
158 | case '=': |
a687059c |
159 | str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len); |
8d063cd8 |
160 | break; |
161 | case '-': |
a687059c |
162 | str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left); |
8d063cd8 |
163 | break; |
164 | case '%': |
a687059c |
165 | str_numset(stab_val(stab),(double)stab_io(curoutstab)->page); |
8d063cd8 |
166 | break; |
a687059c |
167 | #endif |
8d063cd8 |
168 | case '/': |
8d063cd8 |
169 | break; |
170 | case '[': |
a687059c |
171 | str_numset(stab_val(stab),(double)arybase); |
8d063cd8 |
172 | break; |
173 | case '|': |
00bf170e |
174 | if (!stab_io(curoutstab)) |
175 | stab_io(curoutstab) = stio_new(); |
a687059c |
176 | str_numset(stab_val(stab), |
177 | (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) ); |
8d063cd8 |
178 | break; |
179 | case ',': |
a687059c |
180 | str_nset(stab_val(stab),ofs,ofslen); |
8d063cd8 |
181 | break; |
182 | case '\\': |
a687059c |
183 | str_nset(stab_val(stab),ors,orslen); |
8d063cd8 |
184 | break; |
185 | case '#': |
a687059c |
186 | str_set(stab_val(stab),ofmt); |
8d063cd8 |
187 | break; |
188 | case '!': |
a687059c |
189 | str_numset(stab_val(stab), (double)errno); |
00bf170e |
190 | str_set(stab_val(stab), errno ? strerror(errno) : ""); |
a687059c |
191 | stab_val(stab)->str_nok = 1; /* what a wonderful hack! */ |
378cc40b |
192 | break; |
193 | case '<': |
a687059c |
194 | str_numset(stab_val(stab),(double)uid); |
378cc40b |
195 | break; |
196 | case '>': |
a687059c |
197 | str_numset(stab_val(stab),(double)euid); |
378cc40b |
198 | break; |
199 | case '(': |
a687059c |
200 | s = buf; |
201 | (void)sprintf(s,"%d",(int)gid); |
378cc40b |
202 | goto add_groups; |
203 | case ')': |
a687059c |
204 | s = buf; |
205 | (void)sprintf(s,"%d",(int)egid); |
378cc40b |
206 | add_groups: |
207 | while (*s) s++; |
fe14fcc3 |
208 | #ifdef HAS_GETGROUPS |
378cc40b |
209 | #ifndef NGROUPS |
210 | #define NGROUPS 32 |
211 | #endif |
212 | { |
35c8bce7 |
213 | GROUPSTYPE gary[NGROUPS]; |
378cc40b |
214 | |
215 | i = getgroups(NGROUPS,gary); |
216 | while (--i >= 0) { |
a687059c |
217 | (void)sprintf(s," %ld", (long)gary[i]); |
378cc40b |
218 | while (*s) s++; |
219 | } |
220 | } |
221 | #endif |
a687059c |
222 | str_set(stab_val(stab),buf); |
8d063cd8 |
223 | break; |
fe14fcc3 |
224 | case '*': |
225 | break; |
226 | case '0': |
227 | break; |
00bf170e |
228 | default: |
229 | { |
230 | struct ufuncs *uf = (struct ufuncs *)str->str_ptr; |
231 | |
232 | if (uf && uf->uf_val) |
0a12ae7d |
233 | (*uf->uf_val)(uf->uf_index, stab_val(stab)); |
00bf170e |
234 | } |
235 | break; |
8d063cd8 |
236 | } |
a687059c |
237 | return stab_val(stab); |
8d063cd8 |
238 | } |
239 | |
9ef589d8 |
240 | STRLEN |
241 | stab_len(str) |
242 | STR *str; |
243 | { |
244 | STAB *stab = str->str_u.str_stab; |
245 | int paren; |
246 | int i; |
247 | char *s; |
248 | |
249 | if (str->str_rare) |
250 | return stab_val(stab)->str_cur; |
251 | |
252 | switch (*stab->str_magic->str_ptr) { |
253 | case '1': case '2': case '3': case '4': |
254 | case '5': case '6': case '7': case '8': case '9': case '&': |
255 | if (curspat) { |
256 | paren = atoi(stab_name(stab)); |
257 | getparen: |
258 | if (curspat->spat_regexp && |
259 | paren <= curspat->spat_regexp->nparens && |
260 | (s = curspat->spat_regexp->startp[paren]) ) { |
261 | i = curspat->spat_regexp->endp[paren] - s; |
262 | if (i >= 0) |
263 | return i; |
264 | else |
265 | return 0; |
266 | } |
267 | else |
268 | return 0; |
269 | } |
270 | break; |
271 | case '+': |
272 | if (curspat) { |
273 | paren = curspat->spat_regexp->lastparen; |
274 | goto getparen; |
275 | } |
276 | break; |
277 | case '`': |
278 | if (curspat) { |
279 | if (curspat->spat_regexp && |
280 | (s = curspat->spat_regexp->subbeg) ) { |
281 | i = curspat->spat_regexp->startp[0] - s; |
282 | if (i >= 0) |
283 | return i; |
284 | else |
285 | return 0; |
286 | } |
287 | else |
288 | return 0; |
289 | } |
290 | break; |
291 | case '\'': |
292 | if (curspat) { |
293 | if (curspat->spat_regexp && |
294 | (s = curspat->spat_regexp->endp[0]) ) { |
295 | return (STRLEN) (curspat->spat_regexp->subend - s); |
296 | } |
297 | else |
298 | return 0; |
299 | } |
300 | break; |
301 | case ',': |
302 | return (STRLEN)ofslen; |
303 | case '\\': |
304 | return (STRLEN)orslen; |
305 | default: |
306 | return stab_str(str)->str_cur; |
307 | } |
308 | } |
309 | |
a687059c |
310 | stabset(mstr,str) |
311 | register STR *mstr; |
8d063cd8 |
312 | STR *str; |
313 | { |
a687059c |
314 | STAB *stab = mstr->str_u.str_stab; |
fe14fcc3 |
315 | register char *s; |
8d063cd8 |
316 | int i; |
8d063cd8 |
317 | |
a687059c |
318 | switch (mstr->str_rare) { |
319 | case 'E': |
320 | setenv(mstr->str_ptr,str_get(str)); |
321 | /* And you'll never guess what the dog had */ |
0a12ae7d |
322 | /* in its mouth... */ |
323 | #ifdef TAINT |
324 | if (strEQ(mstr->str_ptr,"PATH")) { |
325 | char *strend = str->str_ptr + str->str_cur; |
326 | |
327 | s = str->str_ptr; |
328 | while (s < strend) { |
329 | s = cpytill(tokenbuf,s,strend,':',&i); |
330 | s++; |
331 | if (*tokenbuf != '/' |
332 | || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) |
333 | str->str_tainted = 2; |
334 | } |
335 | } |
336 | #endif |
337 | break; |
a687059c |
338 | case 'S': |
339 | s = str_get(str); |
340 | i = whichsig(mstr->str_ptr); /* ...no, a brick */ |
341 | if (strEQ(s,"IGNORE")) |
342 | #ifndef lint |
343 | (void)signal(i,SIG_IGN); |
344 | #else |
345 | ; |
346 | #endif |
347 | else if (strEQ(s,"DEFAULT") || !*s) |
348 | (void)signal(i,SIG_DFL); |
0a12ae7d |
349 | else { |
a687059c |
350 | (void)signal(i,sighandler); |
0a12ae7d |
351 | if (!index(s,'\'')) { |
352 | sprintf(tokenbuf, "main'%s",s); |
353 | str_set(str,tokenbuf); |
354 | } |
355 | } |
a687059c |
356 | break; |
357 | #ifdef SOME_DBM |
358 | case 'D': |
359 | hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str); |
360 | break; |
361 | #endif |
0a12ae7d |
362 | case 'L': |
363 | { |
364 | CMD *cmd; |
365 | |
366 | i = str_true(str); |
34de22dd |
367 | str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE); |
0a12ae7d |
368 | cmd = str->str_magic->str_u.str_cmd; |
369 | cmd->c_flags &= ~CF_OPTIMIZE; |
370 | cmd->c_flags |= i? CFT_D1 : CFT_D0; |
371 | } |
372 | break; |
a687059c |
373 | case '#': |
374 | afill(stab_array(stab), (int)str_gnum(str) - arybase); |
375 | break; |
376 | case 'X': /* merely a copy of a * string */ |
377 | break; |
378 | case '*': |
379 | s = str_get(str); |
9f68db38 |
380 | if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) { |
a687059c |
381 | if (!*s) { |
382 | STBP *stbp; |
383 | |
384 | (void)savenostab(stab); /* schedule a free of this stab */ |
385 | if (stab->str_len) |
386 | Safefree(stab->str_ptr); |
387 | Newz(601,stbp, 1, STBP); |
388 | stab->str_ptr = stbp; |
389 | stab->str_len = stab->str_cur = sizeof(STBP); |
390 | stab->str_pok = 1; |
9f68db38 |
391 | strcpy(stab_magic(stab),"StB"); |
a687059c |
392 | stab_val(stab) = Str_new(70,0); |
00bf170e |
393 | stab_line(stab) = curcmd->c_line; |
fe14fcc3 |
394 | stab_stash(stab) = curcmd->c_stash; |
a687059c |
395 | } |
00bf170e |
396 | else { |
a687059c |
397 | stab = stabent(s,TRUE); |
00bf170e |
398 | if (!stab_xarray(stab)) |
399 | aadd(stab); |
400 | if (!stab_xhash(stab)) |
401 | hadd(stab); |
402 | if (!stab_io(stab)) |
403 | stab_io(stab) = stio_new(); |
404 | } |
a687059c |
405 | str_sset(str,stab); |
406 | } |
407 | break; |
408 | case 's': { |
409 | struct lstring *lstr = (struct lstring*)str; |
fe14fcc3 |
410 | char *tmps; |
a687059c |
411 | |
412 | mstr->str_rare = 0; |
413 | str->str_magic = Nullstr; |
fe14fcc3 |
414 | tmps = str_get(str); |
a687059c |
415 | str_insert(mstr,lstr->lstr_offset,lstr->lstr_len, |
fe14fcc3 |
416 | tmps,str->str_cur); |
a687059c |
417 | } |
418 | break; |
419 | |
420 | case 'v': |
421 | do_vecset(mstr,str); |
422 | break; |
423 | |
424 | case 0: |
425 | switch (*stab->str_magic->str_ptr) { |
fe14fcc3 |
426 | case '\004': /* ^D */ |
427 | #ifdef DEBUGGING |
428 | debug = (int)(str_gnum(str)) | 32768; |
9ef589d8 |
429 | if (debug & 1024) |
430 | dump_all(); |
fe14fcc3 |
431 | #endif |
432 | break; |
9ef589d8 |
433 | case '\006': /* ^F */ |
434 | maxsysfd = (int)str_gnum(str); |
435 | break; |
fe14fcc3 |
436 | case '\t': /* ^I */ |
437 | if (inplace) |
438 | Safefree(inplace); |
439 | if (str->str_pok || str->str_nok) |
440 | inplace = savestr(str_get(str)); |
441 | else |
442 | inplace = Nullch; |
443 | break; |
9ef589d8 |
444 | case '\020': /* ^P */ |
445 | perldb = (int)str_gnum(str); |
446 | break; |
0a12ae7d |
447 | case '\024': /* ^T */ |
448 | basetime = (long)str_gnum(str); |
449 | break; |
fe14fcc3 |
450 | case '\027': /* ^W */ |
451 | dowarn = (bool)str_gnum(str); |
452 | break; |
9f68db38 |
453 | case '.': |
454 | if (localizing) |
455 | savesptr((STR**)&last_in_stab); |
456 | break; |
8d063cd8 |
457 | case '^': |
a687059c |
458 | Safefree(stab_io(curoutstab)->top_name); |
459 | stab_io(curoutstab)->top_name = s = savestr(str_get(str)); |
460 | stab_io(curoutstab)->top_stab = stabent(s,TRUE); |
8d063cd8 |
461 | break; |
462 | case '~': |
a687059c |
463 | Safefree(stab_io(curoutstab)->fmt_name); |
464 | stab_io(curoutstab)->fmt_name = s = savestr(str_get(str)); |
465 | stab_io(curoutstab)->fmt_stab = stabent(s,TRUE); |
8d063cd8 |
466 | break; |
467 | case '=': |
a687059c |
468 | stab_io(curoutstab)->page_len = (long)str_gnum(str); |
8d063cd8 |
469 | break; |
470 | case '-': |
a687059c |
471 | stab_io(curoutstab)->lines_left = (long)str_gnum(str); |
472 | if (stab_io(curoutstab)->lines_left < 0L) |
473 | stab_io(curoutstab)->lines_left = 0L; |
8d063cd8 |
474 | break; |
475 | case '%': |
a687059c |
476 | stab_io(curoutstab)->page = (long)str_gnum(str); |
8d063cd8 |
477 | break; |
478 | case '|': |
00bf170e |
479 | if (!stab_io(curoutstab)) |
480 | stab_io(curoutstab) = stio_new(); |
a687059c |
481 | stab_io(curoutstab)->flags &= ~IOF_FLUSH; |
8d063cd8 |
482 | if (str_gnum(str) != 0.0) { |
a687059c |
483 | stab_io(curoutstab)->flags |= IOF_FLUSH; |
8d063cd8 |
484 | } |
485 | break; |
486 | case '*': |
a687059c |
487 | i = (int)str_gnum(str); |
488 | multiline = (i != 0); |
8d063cd8 |
489 | break; |
490 | case '/': |
79a0689e |
491 | if (str->str_pok) { |
fe14fcc3 |
492 | rs = str_get(str); |
9f68db38 |
493 | rslen = str->str_cur; |
fe14fcc3 |
494 | if (!rslen) { |
495 | rs = "\n\n"; |
496 | rslen = 2; |
497 | } |
498 | rschar = rs[rslen - 1]; |
9f68db38 |
499 | } |
500 | else { |
fe14fcc3 |
501 | rschar = 0777; /* fake a non-existent char */ |
9f68db38 |
502 | rslen = 1; |
503 | } |
8d063cd8 |
504 | break; |
505 | case '\\': |
506 | if (ors) |
a687059c |
507 | Safefree(ors); |
8d063cd8 |
508 | ors = savestr(str_get(str)); |
a687059c |
509 | orslen = str->str_cur; |
8d063cd8 |
510 | break; |
511 | case ',': |
512 | if (ofs) |
a687059c |
513 | Safefree(ofs); |
8d063cd8 |
514 | ofs = savestr(str_get(str)); |
a687059c |
515 | ofslen = str->str_cur; |
8d063cd8 |
516 | break; |
517 | case '#': |
518 | if (ofmt) |
a687059c |
519 | Safefree(ofmt); |
8d063cd8 |
520 | ofmt = savestr(str_get(str)); |
521 | break; |
522 | case '[': |
523 | arybase = (int)str_gnum(str); |
524 | break; |
378cc40b |
525 | case '?': |
0f85fab0 |
526 | statusvalue = U_S(str_gnum(str)); |
378cc40b |
527 | break; |
8d063cd8 |
528 | case '!': |
529 | errno = (int)str_gnum(str); /* will anyone ever use this? */ |
530 | break; |
378cc40b |
531 | case '<': |
378cc40b |
532 | uid = (int)str_gnum(str); |
9ef589d8 |
533 | #if defined(HAS_SETREUID) || !defined(HAS_SETRUID) |
a687059c |
534 | if (delaymagic) { |
535 | delaymagic |= DM_REUID; |
536 | break; /* don't do magic till later */ |
537 | } |
9ef589d8 |
538 | #endif /* HAS_SETREUID or not HASSETRUID */ |
fe14fcc3 |
539 | #ifdef HAS_SETRUID |
a687059c |
540 | if (setruid((UIDTYPE)uid) < 0) |
541 | uid = (int)getuid(); |
542 | #else |
fe14fcc3 |
543 | #ifdef HAS_SETREUID |
a687059c |
544 | if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0) |
378cc40b |
545 | uid = (int)getuid(); |
546 | #else |
00bf170e |
547 | if (uid == euid) /* special case $< = $> */ |
548 | setuid(uid); |
549 | else |
550 | fatal("setruid() not implemented"); |
378cc40b |
551 | #endif |
a687059c |
552 | #endif |
378cc40b |
553 | break; |
554 | case '>': |
378cc40b |
555 | euid = (int)str_gnum(str); |
9ef589d8 |
556 | #if defined(HAS_SETREUID) || !defined(HAS_SETEUID) |
a687059c |
557 | if (delaymagic) { |
558 | delaymagic |= DM_REUID; |
559 | break; /* don't do magic till later */ |
560 | } |
9ef589d8 |
561 | #endif /* HAS_SETREUID or not HAS_SETEUID */ |
fe14fcc3 |
562 | #ifdef HAS_SETEUID |
a687059c |
563 | if (seteuid((UIDTYPE)euid) < 0) |
564 | euid = (int)geteuid(); |
565 | #else |
fe14fcc3 |
566 | #ifdef HAS_SETREUID |
a687059c |
567 | if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0) |
378cc40b |
568 | euid = (int)geteuid(); |
569 | #else |
00bf170e |
570 | if (euid == uid) /* special case $> = $< */ |
571 | setuid(euid); |
572 | else |
573 | fatal("seteuid() not implemented"); |
378cc40b |
574 | #endif |
a687059c |
575 | #endif |
378cc40b |
576 | break; |
577 | case '(': |
a687059c |
578 | gid = (int)str_gnum(str); |
9ef589d8 |
579 | #if defined(HAS_SETREGID) || !defined(HAS_SETRGID) |
a687059c |
580 | if (delaymagic) { |
581 | delaymagic |= DM_REGID; |
582 | break; /* don't do magic till later */ |
583 | } |
9ef589d8 |
584 | #endif /* HAS_SETREGID or not HAS_SETRGID */ |
fe14fcc3 |
585 | #ifdef HAS_SETRGID |
a687059c |
586 | (void)setrgid((GIDTYPE)gid); |
587 | #else |
fe14fcc3 |
588 | #ifdef HAS_SETREGID |
a687059c |
589 | (void)setregid((GIDTYPE)gid, (GIDTYPE)-1); |
378cc40b |
590 | #else |
591 | fatal("setrgid() not implemented"); |
592 | #endif |
a687059c |
593 | #endif |
378cc40b |
594 | break; |
595 | case ')': |
a687059c |
596 | egid = (int)str_gnum(str); |
9ef589d8 |
597 | #if defined(HAS_SETREGID) || !defined(HAS_SETEGID) |
a687059c |
598 | if (delaymagic) { |
599 | delaymagic |= DM_REGID; |
600 | break; /* don't do magic till later */ |
601 | } |
9ef589d8 |
602 | #endif /* HAS_SETREGID or not HAS_SETEGID */ |
fe14fcc3 |
603 | #ifdef HAS_SETEGID |
a687059c |
604 | (void)setegid((GIDTYPE)egid); |
605 | #else |
fe14fcc3 |
606 | #ifdef HAS_SETREGID |
a687059c |
607 | (void)setregid((GIDTYPE)-1, (GIDTYPE)egid); |
378cc40b |
608 | #else |
609 | fatal("setegid() not implemented"); |
610 | #endif |
a687059c |
611 | #endif |
612 | break; |
613 | case ':': |
614 | chopset = str_get(str); |
378cc40b |
615 | break; |
fe14fcc3 |
616 | case '0': |
617 | if (!origalen) { |
618 | s = origargv[0]; |
619 | s += strlen(s); |
620 | /* See if all the arguments are contiguous in memory */ |
621 | for (i = 1; i < origargc; i++) { |
622 | if (origargv[i] == s + 1) |
623 | s += strlen(++s); /* this one is ok too */ |
624 | } |
625 | if (origenviron[0] == s + 1) { /* can grab env area too? */ |
626 | setenv("NoNeSuCh", Nullch); /* force copy of environment */ |
627 | for (i = 0; origenviron[i]; i++) |
628 | if (origenviron[i] == s + 1) |
629 | s += strlen(++s); |
630 | } |
631 | origalen = s - origargv[0]; |
632 | } |
633 | s = str_get(str); |
634 | i = str->str_cur; |
635 | if (i >= origalen) { |
636 | i = origalen; |
637 | str->str_cur = i; |
638 | str->str_ptr[i] = '\0'; |
639 | bcopy(s, origargv[0], i); |
640 | } |
641 | else { |
642 | bcopy(s, origargv[0], i); |
643 | s = origargv[0]+i; |
644 | *s++ = '\0'; |
645 | while (++i < origalen) |
646 | *s++ = ' '; |
647 | } |
648 | break; |
00bf170e |
649 | default: |
650 | { |
651 | struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr; |
652 | |
653 | if (uf && uf->uf_set) |
0a12ae7d |
654 | (*uf->uf_set)(uf->uf_index, str); |
00bf170e |
655 | } |
656 | break; |
8d063cd8 |
657 | } |
a687059c |
658 | break; |
378cc40b |
659 | } |
8d063cd8 |
660 | } |
661 | |
378cc40b |
662 | whichsig(sig) |
663 | char *sig; |
8d063cd8 |
664 | { |
665 | register char **sigv; |
666 | |
667 | for (sigv = sig_name+1; *sigv; sigv++) |
378cc40b |
668 | if (strEQ(sig,*sigv)) |
8d063cd8 |
669 | return sigv - sig_name; |
a687059c |
670 | #ifdef SIGCLD |
671 | if (strEQ(sig,"CHLD")) |
672 | return SIGCLD; |
673 | #endif |
674 | #ifdef SIGCHLD |
675 | if (strEQ(sig,"CLD")) |
676 | return SIGCHLD; |
677 | #endif |
8d063cd8 |
678 | return 0; |
679 | } |
680 | |
663a0e37 |
681 | static handlertype |
8d063cd8 |
682 | sighandler(sig) |
683 | int sig; |
684 | { |
685 | STAB *stab; |
8d063cd8 |
686 | STR *str; |
378cc40b |
687 | int oldsave = savestack->ary_fill; |
35c8bce7 |
688 | int oldtmps_base = tmps_base; |
689 | register CSV *csv; |
378cc40b |
690 | SUBR *sub; |
8d063cd8 |
691 | |
00bf170e |
692 | #ifdef OS2 /* or anybody else who requires SIG_ACK */ |
693 | signal(sig, SIG_ACK); |
694 | #endif |
a687059c |
695 | stab = stabent( |
696 | str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]), |
697 | TRUE)), TRUE); |
698 | sub = stab_sub(stab); |
699 | if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) { |
700 | if (sig_name[sig][1] == 'H') |
701 | stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)), |
702 | TRUE); |
703 | else |
704 | stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)), |
705 | TRUE); |
706 | sub = stab_sub(stab); /* gag */ |
707 | } |
378cc40b |
708 | if (!sub) { |
709 | if (dowarn) |
710 | warn("SIG%s handler \"%s\" not defined.\n", |
a687059c |
711 | sig_name[sig], stab_name(stab) ); |
378cc40b |
712 | return; |
713 | } |
35c8bce7 |
714 | saveaptr(&stack); |
715 | str = Str_new(15, sizeof(CSV)); |
716 | str->str_state = SS_SCSV; |
717 | (void)apush(savestack,str); |
718 | csv = (CSV*)str->str_ptr; |
719 | csv->sub = sub; |
720 | csv->stab = stab; |
721 | csv->curcsv = curcsv; |
722 | csv->curcmd = curcmd; |
723 | csv->depth = sub->depth; |
724 | csv->wantarray = G_SCALAR; |
725 | csv->hasargs = TRUE; |
726 | csv->savearray = stab_xarray(defstab); |
727 | csv->argarray = stab_xarray(defstab) = stack = anew(defstab); |
a687059c |
728 | stack->ary_flags = 0; |
35c8bce7 |
729 | curcsv = csv; |
730 | str = str_mortal(&str_undef); |
8d063cd8 |
731 | str_set(str,sig_name[sig]); |
a687059c |
732 | (void)apush(stab_xarray(defstab),str); |
378cc40b |
733 | sub->depth++; |
734 | if (sub->depth >= 2) { /* save temporaries on recursion? */ |
735 | if (sub->depth == 100 && dowarn) |
a687059c |
736 | warn("Deep recursion on subroutine \"%s\"",stab_name(stab)); |
378cc40b |
737 | savelist(sub->tosave->ary_array,sub->tosave->ary_fill); |
738 | } |
378cc40b |
739 | |
35c8bce7 |
740 | tmps_base = tmps_max; /* protect our mortal string */ |
741 | (void)cmd_exec(sub->cmd,G_SCALAR,0); /* so do it already */ |
742 | tmps_base = oldtmps_base; |
743 | |
744 | restorelist(oldsave); /* put everything back */ |
8d063cd8 |
745 | } |
746 | |
8d063cd8 |
747 | STAB * |
748 | aadd(stab) |
749 | register STAB *stab; |
750 | { |
a687059c |
751 | if (!stab_xarray(stab)) |
752 | stab_xarray(stab) = anew(stab); |
8d063cd8 |
753 | return stab; |
754 | } |
755 | |
756 | STAB * |
757 | hadd(stab) |
758 | register STAB *stab; |
759 | { |
a687059c |
760 | if (!stab_xhash(stab)) |
761 | stab_xhash(stab) = hnew(COEFFSIZE); |
8d063cd8 |
762 | return stab; |
763 | } |
378cc40b |
764 | |
765 | STAB * |
0a12ae7d |
766 | fstab(name) |
767 | char *name; |
768 | { |
769 | char tmpbuf[1200]; |
770 | STAB *stab; |
771 | |
772 | sprintf(tmpbuf,"'_<%s", name); |
773 | stab = stabent(tmpbuf, TRUE); |
774 | str_set(stab_val(stab), name); |
775 | if (perldb) |
776 | (void)hadd(aadd(stab)); |
777 | return stab; |
778 | } |
779 | |
780 | STAB * |
378cc40b |
781 | stabent(name,add) |
782 | register char *name; |
783 | int add; |
784 | { |
785 | register STAB *stab; |
a687059c |
786 | register STBP *stbp; |
787 | int len; |
788 | register char *namend; |
789 | HASH *stash; |
790 | char *sawquote = Nullch; |
791 | char *prevquote = Nullch; |
792 | bool global = FALSE; |
378cc40b |
793 | |
a687059c |
794 | if (isascii(*name) && isupper(*name)) { |
795 | if (*name > 'I') { |
796 | if (*name == 'S' && ( |
797 | strEQ(name, "SIG") || |
798 | strEQ(name, "STDIN") || |
799 | strEQ(name, "STDOUT") || |
800 | strEQ(name, "STDERR") )) |
801 | global = TRUE; |
378cc40b |
802 | } |
a687059c |
803 | else if (*name > 'E') { |
804 | if (*name == 'I' && strEQ(name, "INC")) |
805 | global = TRUE; |
806 | } |
00bf170e |
807 | else if (*name > 'A') { |
a687059c |
808 | if (*name == 'E' && strEQ(name, "ENV")) |
809 | global = TRUE; |
810 | } |
811 | else if (*name == 'A' && ( |
812 | strEQ(name, "ARGV") || |
813 | strEQ(name, "ARGVOUT") )) |
814 | global = TRUE; |
815 | } |
816 | for (namend = name; *namend; namend++) { |
817 | if (*namend == '\'' && namend[1]) |
818 | prevquote = sawquote, sawquote = namend; |
819 | } |
820 | if (sawquote == name && name[1]) { |
821 | stash = defstash; |
822 | sawquote = Nullch; |
823 | name++; |
824 | } |
825 | else if (!isalpha(*name) || global) |
826 | stash = defstash; |
0a12ae7d |
827 | else if (curcmd == &compiling) |
a687059c |
828 | stash = curstash; |
0a12ae7d |
829 | else |
830 | stash = curcmd->c_stash; |
a687059c |
831 | if (sawquote) { |
832 | char tmpbuf[256]; |
833 | char *s, *d; |
834 | |
835 | *sawquote = '\0'; |
836 | if (s = prevquote) { |
837 | strncpy(tmpbuf,name,s-name+1); |
838 | d = tmpbuf+(s-name+1); |
839 | *d++ = '_'; |
840 | strcpy(d,s+1); |
841 | } |
842 | else { |
843 | *tmpbuf = '_'; |
844 | strcpy(tmpbuf+1,name); |
845 | } |
846 | stab = stabent(tmpbuf,TRUE); |
847 | if (!(stash = stab_xhash(stab))) |
848 | stash = stab_xhash(stab) = hnew(0); |
0a12ae7d |
849 | if (!stash->tbl_name) |
850 | stash->tbl_name = savestr(name); |
a687059c |
851 | name = sawquote+1; |
852 | *sawquote = '\''; |
378cc40b |
853 | } |
a687059c |
854 | len = namend - name; |
855 | stab = (STAB*)hfetch(stash,name,len,add); |
0a12ae7d |
856 | if (stab == (STAB*)&str_undef) |
a687059c |
857 | return Nullstab; |
858 | if (stab->str_pok) { |
859 | stab->str_pok |= SP_MULTI; |
860 | return stab; |
861 | } |
862 | else { |
863 | if (stab->str_len) |
864 | Safefree(stab->str_ptr); |
865 | Newz(602,stbp, 1, STBP); |
866 | stab->str_ptr = stbp; |
867 | stab->str_len = stab->str_cur = sizeof(STBP); |
868 | stab->str_pok = 1; |
9f68db38 |
869 | strcpy(stab_magic(stab),"StB"); |
a687059c |
870 | stab_val(stab) = Str_new(72,0); |
00bf170e |
871 | stab_line(stab) = curcmd->c_line; |
a687059c |
872 | str_magic(stab,stab,'*',name,len); |
0a12ae7d |
873 | stab_stash(stab) = stash; |
fe14fcc3 |
874 | if (isdigit(*name) && *name != '0') { |
875 | stab_flags(stab) = SF_VMAGIC; |
876 | str_magic(stab_val(stab), stab, 0, Nullch, 0); |
877 | } |
378cc40b |
878 | return stab; |
879 | } |
378cc40b |
880 | } |
881 | |
0a12ae7d |
882 | stab_fullname(str,stab) |
883 | STR *str; |
884 | STAB *stab; |
885 | { |
fe14fcc3 |
886 | HASH *tb = stab_stash(stab); |
887 | |
888 | if (!tb) |
889 | return; |
890 | str_set(str,tb->tbl_name); |
0a12ae7d |
891 | str_ncat(str,"'", 1); |
892 | str_scat(str,stab->str_magic); |
893 | } |
894 | |
378cc40b |
895 | STIO * |
896 | stio_new() |
897 | { |
a687059c |
898 | STIO *stio; |
378cc40b |
899 | |
a687059c |
900 | Newz(603,stio,1,STIO); |
378cc40b |
901 | stio->page_len = 60; |
902 | return stio; |
903 | } |
904 | |
905 | stab_check(min,max) |
906 | int min; |
907 | register int max; |
908 | { |
a687059c |
909 | register HENT *entry; |
378cc40b |
910 | register int i; |
911 | register STAB *stab; |
912 | |
913 | for (i = min; i <= max; i++) { |
a687059c |
914 | for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) { |
915 | stab = (STAB*)entry->hent_val; |
916 | if (stab->str_pok & SP_MULTI) |
378cc40b |
917 | continue; |
00bf170e |
918 | curcmd->c_line = stab_line(stab); |
a687059c |
919 | warn("Possible typo: \"%s\"", stab_name(stab)); |
378cc40b |
920 | } |
921 | } |
922 | } |
a687059c |
923 | |
924 | static int gensym = 0; |
925 | |
926 | STAB * |
927 | genstab() |
928 | { |
929 | (void)sprintf(tokenbuf,"_GEN_%d",gensym++); |
930 | return stabent(tokenbuf,TRUE); |
931 | } |
932 | |
933 | /* hopefully this is only called on local symbol table entries */ |
934 | |
935 | void |
936 | stab_clear(stab) |
937 | register STAB *stab; |
938 | { |
939 | STIO *stio; |
940 | SUBR *sub; |
941 | |
942 | afree(stab_xarray(stab)); |
fe14fcc3 |
943 | stab_xarray(stab) = Null(ARRAY*); |
0a12ae7d |
944 | (void)hfree(stab_xhash(stab), FALSE); |
fe14fcc3 |
945 | stab_xhash(stab) = Null(HASH*); |
a687059c |
946 | str_free(stab_val(stab)); |
fe14fcc3 |
947 | stab_val(stab) = Nullstr; |
a687059c |
948 | if (stio = stab_io(stab)) { |
949 | do_close(stab,FALSE); |
950 | Safefree(stio->top_name); |
951 | Safefree(stio->fmt_name); |
952 | } |
953 | if (sub = stab_sub(stab)) { |
954 | afree(sub->tosave); |
955 | cmd_free(sub->cmd); |
956 | } |
957 | Safefree(stab->str_ptr); |
958 | stab->str_ptr = Null(STBP*); |
959 | stab->str_len = 0; |
960 | stab->str_cur = 0; |
961 | } |
962 | |
9f68db38 |
963 | #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) |
964 | #define MICROPORT |
965 | #endif |
966 | |
967 | #ifdef MICROPORT /* Microport 2.4 hack */ |
968 | ARRAY *stab_array(stab) |
969 | register STAB *stab; |
970 | { |
971 | if (((STBP*)(stab->str_ptr))->stbp_array) |
972 | return ((STBP*)(stab->str_ptr))->stbp_array; |
973 | else |
974 | return ((STBP*)(aadd(stab)->str_ptr))->stbp_array; |
975 | } |
976 | |
977 | HASH *stab_hash(stab) |
978 | register STAB *stab; |
979 | { |
980 | if (((STBP*)(stab->str_ptr))->stbp_hash) |
981 | return ((STBP*)(stab->str_ptr))->stbp_hash; |
982 | else |
983 | return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash; |
984 | } |
985 | #endif /* Microport 2.4 hack */ |