This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 3.0 patch #4 Patch #2 continued
[perl5.git] / str.c
CommitLineData
ae986130 1/* $Header: str.c,v 3.0.1.2 89/11/11 04:56:22 lwall Locked $
a687059c
LW
2 *
3 * Copyright (c) 1989, Larry Wall
4 *
5 * You may distribute under the terms of the GNU General Public License
6 * as specified in the README file that comes with the perl 3.0 kit.
8d063cd8
LW
7 *
8 * $Log: str.c,v $
ae986130
LW
9 * Revision 3.0.1.2 89/11/11 04:56:22 lwall
10 * patch2: uchar gives Crays fits
11 *
03a14243
LW
12 * Revision 3.0.1.1 89/10/26 23:23:41 lwall
13 * patch1: string ordering tests were wrong
14 * patch1: $/ now works even when STDSTDIO undefined
15 *
a687059c
LW
16 * Revision 3.0 89/10/18 15:23:38 lwall
17 * 3.0 baseline
8d063cd8
LW
18 *
19 */
20
8d063cd8 21#include "EXTERN.h"
8d063cd8 22#include "perl.h"
a687059c 23#include "perly.h"
8d063cd8 24
a687059c
LW
25extern char **environ;
26
27#ifndef str_get
28char *
29str_get(str)
30STR *str;
8d063cd8 31{
a687059c
LW
32#ifdef TAINT
33 tainted |= str->str_tainted;
34#endif
35 return str->str_pok ? str->str_ptr : str_2ptr(str);
36}
37#endif
8d063cd8 38
a687059c
LW
39/* dlb ... guess we have a "crippled cc".
40 * dlb the following functions are usually macros.
41 */
42#ifndef str_true
43str_true(Str)
44STR *Str;
45{
46 if (Str->str_pok) {
47 if (*Str->str_ptr > '0' ||
48 Str->str_cur > 1 ||
49 (Str->str_cur && *Str->str_ptr != '0'))
50 return 1;
51 return 0;
8d063cd8 52 }
a687059c
LW
53 if (Str->str_nok)
54 return (Str->str_u.str_nval != 0.0);
55 return 0;
56}
57#endif /* str_true */
8d063cd8 58
a687059c
LW
59#ifndef str_gnum
60double str_gnum(Str)
61STR *Str;
62{
63#ifdef TAINT
64 tainted |= Str->str_tainted;
65#endif /* TAINT*/
66 if (Str->str_nok)
67 return Str->str_u.str_nval;
68 return str_2num(Str);
69}
70#endif /* str_gnum */
71/* dlb ... end of crutch */
8d063cd8 72
a687059c
LW
73char *
74str_grow(str,newlen)
75register STR *str;
76register int newlen;
77{
78 register char *s = str->str_ptr;
79
80 if (str->str_state == SS_INCR) { /* data before str_ptr? */
81 str->str_len += str->str_u.str_useful;
82 str->str_ptr -= str->str_u.str_useful;
83 str->str_u.str_useful = 0L;
84 bcopy(s, str->str_ptr, str->str_cur+1);
85 s = str->str_ptr;
86 str->str_state = SS_NORM; /* normal again */
87 if (newlen > str->str_len)
88 newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
89 }
90 if (newlen > str->str_len) { /* need more room? */
91 if (str->str_len)
92 Renew(s,newlen,char);
93 else
94 New(703,s,newlen,char);
95 str->str_ptr = s;
96 str->str_len = newlen;
8d063cd8 97 }
a687059c 98 return s;
8d063cd8
LW
99}
100
101str_numset(str,num)
102register STR *str;
103double num;
104{
a687059c
LW
105 str->str_u.str_nval = num;
106 str->str_state = SS_NORM;
107 str->str_pok = 0; /* invalidate pointer */
108 str->str_nok = 1; /* validate number */
109#ifdef TAINT
110 str->str_tainted = tainted;
111#endif
8d063cd8
LW
112}
113
378cc40b
LW
114extern int errno;
115
8d063cd8
LW
116char *
117str_2ptr(str)
118register STR *str;
119{
120 register char *s;
378cc40b 121 int olderrno;
8d063cd8
LW
122
123 if (!str)
124 return "";
8d063cd8 125 if (str->str_nok) {
a687059c
LW
126 STR_GROW(str, 24);
127 s = str->str_ptr;
378cc40b
LW
128 olderrno = errno; /* some Xenix systems wipe out errno here */
129#if defined(scs) && defined(ns32000)
a687059c 130 gcvt(str->str_u.str_nval,20,s);
378cc40b
LW
131#else
132#ifdef apollo
a687059c
LW
133 if (str->str_u.str_nval == 0.0)
134 (void)strcpy(s,"0");
378cc40b
LW
135 else
136#endif /*apollo*/
a687059c 137 (void)sprintf(s,"%.20g",str->str_u.str_nval);
378cc40b
LW
138#endif /*scs*/
139 errno = olderrno;
8d063cd8
LW
140 while (*s) s++;
141 }
a687059c
LW
142 else {
143 if (str == &str_undef)
144 return No;
145 if (dowarn)
146 warn("Use of uninitialized variable");
147 STR_GROW(str, 24);
148 s = str->str_ptr;
149 }
8d063cd8
LW
150 *s = '\0';
151 str->str_cur = s - str->str_ptr;
152 str->str_pok = 1;
153#ifdef DEBUGGING
154 if (debug & 32)
155 fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
156#endif
157 return str->str_ptr;
158}
159
160double
161str_2num(str)
162register STR *str;
163{
164 if (!str)
165 return 0.0;
a687059c 166 str->str_state = SS_NORM;
8d063cd8 167 if (str->str_len && str->str_pok)
a687059c
LW
168 str->str_u.str_nval = atof(str->str_ptr);
169 else {
170 if (str == &str_undef)
171 return 0.0;
378cc40b 172 if (dowarn)
a687059c
LW
173 warn("Use of uninitialized variable");
174 str->str_u.str_nval = 0.0;
378cc40b 175 }
8d063cd8
LW
176 str->str_nok = 1;
177#ifdef DEBUGGING
178 if (debug & 32)
a687059c 179 fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
8d063cd8 180#endif
a687059c 181 return str->str_u.str_nval;
8d063cd8
LW
182}
183
184str_sset(dstr,sstr)
185STR *dstr;
186register STR *sstr;
187{
a687059c
LW
188#ifdef TAINT
189 tainted |= sstr->str_tainted;
190#endif
8d063cd8 191 if (!sstr)
a687059c
LW
192 dstr->str_pok = dstr->str_nok = 0;
193 else if (sstr->str_pok) {
8d063cd8 194 str_nset(dstr,sstr->str_ptr,sstr->str_cur);
a687059c
LW
195 if (sstr->str_nok) {
196 dstr->str_u.str_nval = sstr->str_u.str_nval;
197 dstr->str_nok = 1;
198 dstr->str_state = SS_NORM;
199 }
200 else if (sstr->str_cur == sizeof(STBP)) {
201 char *tmps = sstr->str_ptr;
202
203 if (*tmps == 'S' && bcmp(tmps,"Stab",4) == 0) {
204 dstr->str_magic = str_smake(sstr->str_magic);
205 dstr->str_magic->str_rare = 'X';
206 }
207 }
208 }
209 else if (sstr->str_nok)
210 str_numset(dstr,sstr->str_u.str_nval);
8d063cd8 211 else
a687059c 212 dstr->str_pok = dstr->str_nok = 0;
8d063cd8
LW
213}
214
215str_nset(str,ptr,len)
216register STR *str;
217register char *ptr;
218register int len;
219{
a687059c
LW
220 STR_GROW(str, len + 1);
221 (void)bcopy(ptr,str->str_ptr,len);
8d063cd8
LW
222 str->str_cur = len;
223 *(str->str_ptr+str->str_cur) = '\0';
224 str->str_nok = 0; /* invalidate number */
225 str->str_pok = 1; /* validate pointer */
a687059c
LW
226#ifdef TAINT
227 str->str_tainted = tainted;
228#endif
8d063cd8
LW
229}
230
231str_set(str,ptr)
232register STR *str;
233register char *ptr;
234{
235 register int len;
236
237 if (!ptr)
238 ptr = "";
239 len = strlen(ptr);
a687059c
LW
240 STR_GROW(str, len + 1);
241 (void)bcopy(ptr,str->str_ptr,len+1);
8d063cd8
LW
242 str->str_cur = len;
243 str->str_nok = 0; /* invalidate number */
244 str->str_pok = 1; /* validate pointer */
a687059c
LW
245#ifdef TAINT
246 str->str_tainted = tainted;
247#endif
8d063cd8
LW
248}
249
250str_chop(str,ptr) /* like set but assuming ptr is in str */
251register STR *str;
252register char *ptr;
253{
a687059c
LW
254 register int delta;
255
8d063cd8 256 if (!(str->str_pok))
a687059c
LW
257 fatal("str_chop: internal inconsistency");
258 delta = ptr - str->str_ptr;
259 str->str_len -= delta;
260 str->str_cur -= delta;
261 str->str_ptr += delta;
262 if (str->str_state == SS_INCR)
263 str->str_u.str_useful += delta;
264 else {
265 str->str_u.str_useful = delta;
266 str->str_state = SS_INCR;
267 }
8d063cd8 268 str->str_nok = 0; /* invalidate number */
a687059c 269 str->str_pok = 1; /* validate pointer (and unstudy str) */
8d063cd8
LW
270}
271
272str_ncat(str,ptr,len)
273register STR *str;
274register char *ptr;
275register int len;
276{
277 if (!(str->str_pok))
a687059c
LW
278 (void)str_2ptr(str);
279 STR_GROW(str, str->str_cur + len + 1);
280 (void)bcopy(ptr,str->str_ptr+str->str_cur,len);
8d063cd8
LW
281 str->str_cur += len;
282 *(str->str_ptr+str->str_cur) = '\0';
283 str->str_nok = 0; /* invalidate number */
284 str->str_pok = 1; /* validate pointer */
a687059c
LW
285#ifdef TAINT
286 str->str_tainted |= tainted;
287#endif
8d063cd8
LW
288}
289
290str_scat(dstr,sstr)
291STR *dstr;
292register STR *sstr;
293{
a687059c
LW
294#ifdef TAINT
295 tainted |= sstr->str_tainted;
296#endif
378cc40b
LW
297 if (!sstr)
298 return;
8d063cd8 299 if (!(sstr->str_pok))
a687059c 300 (void)str_2ptr(sstr);
8d063cd8
LW
301 if (sstr)
302 str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
303}
304
305str_cat(str,ptr)
306register STR *str;
307register char *ptr;
308{
309 register int len;
310
311 if (!ptr)
312 return;
313 if (!(str->str_pok))
a687059c 314 (void)str_2ptr(str);
8d063cd8 315 len = strlen(ptr);
a687059c
LW
316 STR_GROW(str, str->str_cur + len + 1);
317 (void)bcopy(ptr,str->str_ptr+str->str_cur,len+1);
8d063cd8
LW
318 str->str_cur += len;
319 str->str_nok = 0; /* invalidate number */
320 str->str_pok = 1; /* validate pointer */
a687059c
LW
321#ifdef TAINT
322 str->str_tainted |= tainted;
323#endif
8d063cd8
LW
324}
325
326char *
a687059c 327str_append_till(str,from,fromend,delim,keeplist)
8d063cd8
LW
328register STR *str;
329register char *from;
a687059c 330register char *fromend;
8d063cd8
LW
331register int delim;
332char *keeplist;
333{
334 register char *to;
335 register int len;
336
337 if (!from)
338 return Nullch;
a687059c
LW
339 len = fromend - from;
340 STR_GROW(str, str->str_cur + len + 1);
8d063cd8
LW
341 str->str_nok = 0; /* invalidate number */
342 str->str_pok = 1; /* validate pointer */
343 to = str->str_ptr+str->str_cur;
a687059c
LW
344 for (; from < fromend; from++,to++) {
345 if (*from == '\\' && from+1 < fromend && delim != '\\') {
8d063cd8
LW
346 if (!keeplist) {
347 if (from[1] == delim || from[1] == '\\')
348 from++;
349 else
350 *to++ = *from++;
351 }
a687059c 352 else if (from[1] && index(keeplist,from[1]))
8d063cd8
LW
353 *to++ = *from++;
354 else
355 from++;
356 }
357 else if (*from == delim)
358 break;
359 *to = *from;
360 }
361 *to = '\0';
362 str->str_cur = to - str->str_ptr;
363 return from;
364}
365
366STR *
a687059c
LW
367#ifdef LEAKTEST
368str_new(x,len)
369int x;
370#else
8d063cd8 371str_new(len)
a687059c 372#endif
8d063cd8
LW
373int len;
374{
375 register STR *str;
376
377 if (freestrroot) {
378 str = freestrroot;
a687059c
LW
379 freestrroot = str->str_magic;
380 str->str_magic = Nullstr;
381 str->str_state = SS_NORM;
8d063cd8
LW
382 }
383 else {
a687059c 384 Newz(700+x,str,1,STR);
8d063cd8
LW
385 }
386 if (len)
a687059c 387 STR_GROW(str, len + 1);
8d063cd8
LW
388 return str;
389}
390
391void
a687059c 392str_magic(str, stab, how, name, namlen)
8d063cd8 393register STR *str;
a687059c
LW
394STAB *stab;
395int how;
396char *name;
397int namlen;
398{
399 if (str->str_magic)
400 return;
401 str->str_magic = Str_new(75,namlen);
402 str = str->str_magic;
403 str->str_u.str_stab = stab;
404 str->str_rare = how;
405 if (name)
406 str_nset(str,name,namlen);
407}
408
409void
410str_insert(bigstr,offset,len,little,littlelen)
411STR *bigstr;
412int offset;
8d063cd8 413int len;
a687059c
LW
414char *little;
415int littlelen;
8d063cd8 416{
a687059c
LW
417 register char *big;
418 register char *mid;
419 register char *midend;
420 register char *bigend;
421 register int i;
422
423 i = littlelen - len;
424 if (i > 0) { /* string might grow */
425 STR_GROW(bigstr, bigstr->str_cur + i + 1);
426 big = bigstr->str_ptr;
427 mid = big + offset + len;
428 midend = bigend = big + bigstr->str_cur;
429 bigend += i;
430 *bigend = '\0';
431 while (midend > mid) /* shove everything down */
432 *--bigend = *--midend;
433 (void)bcopy(little,big+offset,littlelen);
434 bigstr->str_cur += i;
435 return;
436 }
437 else if (i == 0) {
438 (void)bcopy(little,bigstr->str_ptr+offset,len);
439 return;
440 }
441
442 big = bigstr->str_ptr;
443 mid = big + offset;
444 midend = mid + len;
445 bigend = big + bigstr->str_cur;
446
447 if (midend > bigend)
448 fatal("panic: str_insert");
449
450 bigstr->str_pok = SP_VALID; /* disable possible screamer */
451
452 if (mid - big > bigend - midend) { /* faster to shorten from end */
453 if (littlelen) {
454 (void)bcopy(little, mid, littlelen);
455 mid += littlelen;
456 }
457 i = bigend - midend;
458 if (i > 0) {
459 (void)bcopy(midend, mid, i);
460 mid += i;
461 }
462 *mid = '\0';
463 bigstr->str_cur = mid - big;
464 }
465 else if (i = mid - big) { /* faster from front */
466 midend -= littlelen;
467 mid = midend;
468 str_chop(bigstr,midend-i);
469 big += i;
470 while (i--)
471 *--midend = *--big;
472 if (littlelen)
473 (void)bcopy(little, mid, littlelen);
474 }
475 else if (littlelen) {
476 midend -= littlelen;
477 str_chop(bigstr,midend);
478 (void)bcopy(little,midend,littlelen);
479 }
480 else {
481 str_chop(bigstr,midend);
482 }
483 STABSET(bigstr);
8d063cd8
LW
484}
485
486/* make str point to what nstr did */
487
488void
489str_replace(str,nstr)
490register STR *str;
491register STR *nstr;
492{
a687059c
LW
493 if (str->str_state == SS_INCR)
494 str_grow(str,0); /* just force copy down */
495 if (nstr->str_state == SS_INCR)
496 str_grow(nstr,0);
497 if (str->str_ptr)
498 Safefree(str->str_ptr);
8d063cd8
LW
499 str->str_ptr = nstr->str_ptr;
500 str->str_len = nstr->str_len;
501 str->str_cur = nstr->str_cur;
502 str->str_pok = nstr->str_pok;
a687059c
LW
503 str->str_nok = nstr->str_nok;
504#ifdef STRUCTCOPY
505 str->str_u = nstr->str_u;
506#else
507 str->str_u.str_nval = nstr->str_u.str_nval;
508#endif
509#ifdef TAINT
510 str->str_tainted = nstr->str_tainted;
511#endif
512 Safefree(nstr);
8d063cd8
LW
513}
514
515void
516str_free(str)
517register STR *str;
518{
519 if (!str)
520 return;
a687059c
LW
521 if (str->str_state) {
522 if (str->str_state == SS_FREE) /* already freed */
523 return;
524 if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
525 str->str_ptr -= str->str_u.str_useful;
526 str->str_len += str->str_u.str_useful;
527 }
528 }
529 if (str->str_magic)
530 str_free(str->str_magic);
531#ifdef LEAKTEST
8d063cd8 532 if (str->str_len)
a687059c
LW
533 Safefree(str->str_ptr);
534 if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
535 arg_free(str->str_u.str_args);
536 Safefree(str);
537#else /* LEAKTEST */
538 if (str->str_len) {
539 if (str->str_len > 127) { /* next user not likely to want more */
540 Safefree(str->str_ptr); /* so give it back to malloc */
541 str->str_ptr = Nullch;
542 str->str_len = 0;
543 }
544 else
545 str->str_ptr[0] = '\0';
546 }
547 if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
548 arg_free(str->str_u.str_args);
8d063cd8
LW
549 str->str_cur = 0;
550 str->str_nok = 0;
551 str->str_pok = 0;
a687059c
LW
552 str->str_state = SS_FREE;
553#ifdef TAINT
554 str->str_tainted = 0;
555#endif
556 str->str_magic = freestrroot;
8d063cd8 557 freestrroot = str;
a687059c 558#endif /* LEAKTEST */
8d063cd8
LW
559}
560
561str_len(str)
562register STR *str;
563{
564 if (!str)
565 return 0;
566 if (!(str->str_pok))
a687059c
LW
567 (void)str_2ptr(str);
568 if (str->str_ptr)
8d063cd8
LW
569 return str->str_cur;
570 else
571 return 0;
572}
573
a687059c
LW
574str_eq(str1,str2)
575register STR *str1;
576register STR *str2;
577{
578 if (!str1)
579 return str2 == Nullstr;
580 if (!str2)
581 return 0;
582
583 if (!str1->str_pok)
584 (void)str_2ptr(str1);
585 if (!str2->str_pok)
586 (void)str_2ptr(str2);
587
588 if (str1->str_cur != str2->str_cur)
589 return 0;
590
591 return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
592}
593
594str_cmp(str1,str2)
595register STR *str1;
596register STR *str2;
597{
598 int retval;
599
600 if (!str1)
601 return str2 == Nullstr;
602 if (!str2)
603 return 0;
604
605 if (!str1->str_pok)
606 (void)str_2ptr(str1);
607 if (!str2->str_pok)
608 (void)str_2ptr(str2);
609
610 if (str1->str_cur < str2->str_cur) {
611 if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
612 return retval;
613 else
03a14243 614 return -1;
a687059c
LW
615 }
616 else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
617 return retval;
618 else if (str1->str_cur == str2->str_cur)
619 return 0;
620 else
03a14243 621 return 1;
a687059c
LW
622}
623
8d063cd8 624char *
a687059c 625str_gets(str,fp,append)
8d063cd8
LW
626register STR *str;
627register FILE *fp;
a687059c 628int append;
8d063cd8 629{
8d063cd8
LW
630 register char *bp; /* we're going to steal some values */
631 register int cnt; /* from the stdio struct and put EVERYTHING */
36ce8bec
DFDL
632 register STDCHAR *ptr; /* in the innermost loop into registers */
633 register char newline = record_separator;/* (assuming >= 6 registers) */
8d063cd8
LW
634 int i;
635 int bpx;
636 int obpx;
637 register int get_paragraph;
638 register char *oldbp;
639
a687059c 640 if (get_paragraph = !rslen) { /* yes, that's an assignment */
8d063cd8
LW
641 newline = '\n';
642 oldbp = Nullch; /* remember last \n position (none) */
643 }
03a14243
LW
644#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */
645
8d063cd8
LW
646 cnt = fp->_cnt; /* get count into register */
647 str->str_nok = 0; /* invalidate number */
648 str->str_pok = 1; /* validate pointer */
a687059c
LW
649 if (str->str_len <= cnt + 1) /* make sure we have the room */
650 STR_GROW(str, append+cnt+2); /* (remembering cnt can be -1) */
651 bp = str->str_ptr + append; /* move these two too to registers */
8d063cd8
LW
652 ptr = fp->_ptr;
653 for (;;) {
654 screamer:
655 while (--cnt >= 0) { /* this */ /* eat */
656 if ((*bp++ = *ptr++) == newline) /* really */ /* dust */
657 goto thats_all_folks; /* screams */ /* sed :-) */
658 }
659
660 fp->_cnt = cnt; /* deregisterize cnt and ptr */
661 fp->_ptr = ptr;
662 i = _filbuf(fp); /* get more characters */
663 cnt = fp->_cnt;
664 ptr = fp->_ptr; /* reregisterize cnt and ptr */
665
666 bpx = bp - str->str_ptr; /* prepare for possible relocation */
667 if (get_paragraph && oldbp)
668 obpx = oldbp - str->str_ptr;
a687059c 669 STR_GROW(str, bpx + cnt + 2);
8d063cd8
LW
670 bp = str->str_ptr + bpx; /* reconstitute our pointer */
671 if (get_paragraph && oldbp)
672 oldbp = str->str_ptr + obpx;
673
674 if (i == newline) { /* all done for now? */
675 *bp++ = i;
676 goto thats_all_folks;
677 }
678 else if (i == EOF) /* all done for ever? */
679 goto thats_really_all_folks;
680 *bp++ = i; /* now go back to screaming loop */
681 }
682
683thats_all_folks:
684 if (get_paragraph && bp - 1 != oldbp) {
685 oldbp = bp; /* remember where this newline was */
686 goto screamer; /* and go back to the fray */
687 }
688thats_really_all_folks:
689 fp->_cnt = cnt; /* put these back or we're in trouble */
690 fp->_ptr = ptr;
691 *bp = '\0';
692 str->str_cur = bp - str->str_ptr; /* set length */
693
694#else /* !STDSTDIO */ /* The big, slow, and stupid way */
695
03a14243
LW
696 {
697 static char buf[8192];
698 char * bpe = buf + sizeof(buf) - 3;
699
700screamer:
701 bp = buf;
702filler:
703 while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe);
704 if (i == newline && get_paragraph &&
705 (i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe)
706 goto filler;
8d063cd8 707
03a14243 708 *bp = '\0';
a687059c
LW
709 if (append)
710 str_cat(str, buf);
711 else
712 str_set(str, buf);
03a14243
LW
713 if (i != newline && i != EOF) {
714 append = -1;
715 goto screamer;
716 }
a687059c 717 }
8d063cd8
LW
718
719#endif /* STDSTDIO */
720
a687059c 721 return str->str_cur - append ? str->str_ptr : Nullch;
8d063cd8
LW
722}
723
a687059c
LW
724ARG *
725parselist(str)
726STR *str;
727{
728 register CMD *cmd;
729 register ARG *arg;
730 line_t oldline = line;
731 int retval;
8d063cd8 732
a687059c
LW
733 str_sset(linestr,str);
734 in_eval++;
735 oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
736 bufend = bufptr + linestr->str_cur;
737 if (setjmp(eval_env)) {
738 in_eval = 0;
739 fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
740 }
741 error_count = 0;
742 retval = yyparse();
743 in_eval--;
744 if (retval || error_count)
745 fatal("Invalid component in string or format");
746 cmd = eval_root;
747 arg = cmd->c_expr;
748 if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
749 fatal("panic: error in parselist %d %x %d", cmd->c_type,
750 cmd->c_next, arg ? arg->arg_type : -1);
751 line = oldline;
752 Safefree(cmd);
753 return arg;
754}
755
756void
757intrpcompile(src)
758STR *src;
8d063cd8 759{
a687059c
LW
760 register char *s = str_get(src);
761 register char *send = s + src->str_cur;
762 register STR *str;
763 register char *t;
764 STR *toparse;
765 int len;
766 register int brackets;
767 register char *d;
768 STAB *stab;
769 char *checkpoint;
8d063cd8 770
a687059c
LW
771 toparse = Str_new(76,0);
772 str = Str_new(77,0);
773
774 str_nset(str,"",0);
775 str_nset(toparse,"",0);
776 t = s;
777 while (s < send) {
778 if (*s == '\\' && s[1] && index("$@[{\\]}",s[1])) {
779 str_ncat(str, t, s - t);
780 ++s;
781 if (*nointrp && s+1 < send)
782 if (*s != '@' && (*s != '$' || index(nointrp,s[1])))
783 str_ncat(str,s-1,1);
784 str_ncat(str, "$b", 2);
785 str_ncat(str, s, 1);
786 ++s;
787 t = s;
8d063cd8 788 }
a687059c
LW
789 else if ((*s == '@' || (*s == '$' && !index(nointrp,s[1]))) &&
790 s+1 < send) {
8d063cd8 791 str_ncat(str,t,s-t);
8d063cd8 792 t = s;
a687059c
LW
793 if (*s == '$' && s[1] == '#' && isalpha(s[2]) || s[2] == '_')
794 s++;
795 s = scanreg(s,send,tokenbuf);
796 if (*t == '@' &&
797 (!(stab = stabent(tokenbuf,FALSE)) || !stab_xarray(stab)) ) {
798 str_ncat(str,"@",1);
799 s = ++t;
800 continue; /* grandfather @ from old scripts */
801 }
802 str_ncat(str,"$a",2);
803 str_ncat(toparse,",",1);
804 if (t[1] != '{' && (*s == '[' || *s == '{' /* }} */ ) &&
805 (stab = stabent(tokenbuf,FALSE)) &&
806 ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
807 brackets = 0;
808 checkpoint = s;
809 do {
810 switch (*s) {
811 case '[': case '{':
812 brackets++;
813 break;
814 case ']': case '}':
815 brackets--;
816 break;
817 case '\'':
818 case '"':
819 if (s[-1] != '$') {
820 s = cpytill(tokenbuf,s+1,send,*s,&len);
821 if (s >= send)
822 fatal("Unterminated string");
823 }
824 break;
825 }
826 s++;
827 } while (brackets > 0 && s < send);
828 if (s > send)
829 fatal("Unmatched brackets in string");
830 if (*nointrp) { /* we're in a regular expression */
831 d = checkpoint;
832 if (*d == '{' && s[-1] == '}') { /* maybe {n,m} */
833 ++d;
834 if (isdigit(*d)) { /* matches /^{\d,?\d*}$/ */
835 if (*++d == ',')
836 ++d;
837 while (isdigit(*d))
838 d++;
839 if (d == s - 1)
840 s = checkpoint; /* Is {n,m}! Backoff! */
841 }
842 }
843 else if (*d == '[' && s[-1] == ']') { /* char class? */
844 int weight = 2; /* let's weigh the evidence */
845 char seen[256];
ae986130 846 unsigned char unchar = 0, lastunchar;
a687059c
LW
847
848 Zero(seen,256,char);
849 *--s = '\0';
850 if (d[1] == '^')
851 weight += 150;
852 else if (d[1] == '$')
853 weight -= 3;
854 if (isdigit(d[1])) {
855 if (d[2]) {
856 if (isdigit(d[2]) && !d[3])
857 weight -= 10;
858 }
859 else
860 weight -= 100;
861 }
862 for (d++; d < s; d++) {
ae986130
LW
863 lastunchar = unchar;
864 unchar = (unsigned char)*d;
a687059c
LW
865 switch (*d) {
866 case '&':
867 case '$':
ae986130 868 weight -= seen[unchar] * 10;
a687059c
LW
869 if (isalpha(d[1]) || isdigit(d[1]) ||
870 d[1] == '_') {
871 d = scanreg(d,s,tokenbuf);
872 if (stabent(tokenbuf,FALSE))
873 weight -= 100;
874 else
875 weight -= 10;
876 }
877 else if (*d == '$' && d[1] &&
878 index("[#!%*<>()-=",d[1])) {
879 if (!d[2] || /*{*/ index("])} =",d[2]))
880 weight -= 10;
881 else
882 weight -= 1;
883 }
884 break;
885 case '\\':
ae986130 886 unchar = 254;
a687059c
LW
887 if (d[1]) {
888 if (index("wds",d[1]))
889 weight += 100;
890 else if (seen['\''] || seen['"'])
891 weight += 1;
892 else if (index("rnftb",d[1]))
893 weight += 40;
894 else if (isdigit(d[1])) {
895 weight += 40;
896 while (d[1] && isdigit(d[1]))
897 d++;
898 }
899 }
900 else
901 weight += 100;
902 break;
903 case '-':
ae986130
LW
904 if (lastunchar < d[1] || d[1] == '\\') {
905 if (index("aA01! ",lastunchar))
a687059c
LW
906 weight += 30;
907 if (index("zZ79~",d[1]))
908 weight += 30;
909 }
910 else
911 weight -= 1;
912 default:
913 if (isalpha(*d) && d[1] && isalpha(d[1])) {
914 bufptr = d;
915 if (yylex() != WORD)
916 weight -= 150;
917 d = bufptr;
918 }
ae986130 919 if (unchar == lastunchar + 1)
a687059c 920 weight += 5;
ae986130 921 weight -= seen[unchar];
a687059c
LW
922 break;
923 }
ae986130 924 seen[unchar]++;
a687059c
LW
925 }
926#ifdef DEBUGGING
927 if (debug & 512)
928 fprintf(stderr,"[%s] weight %d\n",
929 checkpoint+1,weight);
930#endif
931 *s++ = ']';
932 if (weight >= 0) /* probably a character class */
933 s = checkpoint;
934 }
935 }
936 }
937 if (*t == '@')
938 str_ncat(toparse, "join($\",", 8);
939 if (t[1] == '{' && s[-1] == '}') {
940 str_ncat(toparse, t, 1);
941 str_ncat(toparse, t+2, s - t - 3);
942 }
943 else
944 str_ncat(toparse, t, s - t);
945 if (*t == '@')
946 str_ncat(toparse, ")", 1);
947 t = s;
948 }
949 else
950 s++;
951 }
952 str_ncat(str,t,s-t);
953 if (toparse->str_ptr && *toparse->str_ptr == ',') {
954 *toparse->str_ptr = '(';
955 str_ncat(toparse,",$$);",5);
956 str->str_u.str_args = parselist(toparse);
957 str->str_u.str_args->arg_len--; /* ignore $$ reference */
958 }
959 else
960 str->str_u.str_args = Nullarg;
961 str_free(toparse);
962 str->str_pok |= SP_INTRP;
963 str->str_nok = 0;
964 str_replace(src,str);
965}
966
967STR *
968interp(str,src,sp)
969register STR *str;
970STR *src;
971int sp;
972{
973 register char *s;
974 register char *t;
975 register char *send;
976 register STR **elem;
977
978 if (!(src->str_pok & SP_INTRP)) {
979 int oldsave = savestack->ary_fill;
980
981 (void)savehptr(&curstash);
982 curstash = src->str_u.str_hash; /* so stabent knows right package */
983 intrpcompile(src);
984 restorelist(oldsave);
985 }
986 s = src->str_ptr; /* assumed valid since str_pok set */
987 t = s;
988 send = s + src->str_cur;
989
990 if (src->str_u.str_args) {
991 (void)eval(src->str_u.str_args,G_ARRAY,sp);
992 /* Assuming we have correct # of args */
993 elem = stack->ary_array + sp;
994 }
995
996 str_nset(str,"",0);
997 while (s < send) {
998 if (*s == '$' && s+1 < send) {
999 str_ncat(str,t,s-t);
1000 switch(*++s) {
1001 case 'a':
1002 str_scat(str,*++elem);
1003 break;
1004 case 'b':
1005 str_ncat(str,++s,1);
1006 break;
1007 }
1008 t = ++s;
8d063cd8
LW
1009 }
1010 else
1011 s++;
1012 }
8d063cd8
LW
1013 str_ncat(str,t,s-t);
1014 return str;
1015}
1016
1017void
1018str_inc(str)
1019register STR *str;
1020{
1021 register char *d;
1022
1023 if (!str)
1024 return;
1025 if (str->str_nok) {
a687059c 1026 str->str_u.str_nval += 1.0;
8d063cd8
LW
1027 str->str_pok = 0;
1028 return;
1029 }
378cc40b 1030 if (!str->str_pok || !*str->str_ptr) {
a687059c 1031 str->str_u.str_nval = 1.0;
8d063cd8 1032 str->str_nok = 1;
13281fa4 1033 str->str_pok = 0;
8d063cd8
LW
1034 return;
1035 }
378cc40b
LW
1036 d = str->str_ptr;
1037 while (isalpha(*d)) d++;
1038 while (isdigit(*d)) d++;
1039 if (*d) {
8d063cd8
LW
1040 str_numset(str,atof(str->str_ptr) + 1.0); /* punt */
1041 return;
1042 }
378cc40b 1043 d--;
8d063cd8 1044 while (d >= str->str_ptr) {
378cc40b
LW
1045 if (isdigit(*d)) {
1046 if (++*d <= '9')
1047 return;
1048 *(d--) = '0';
1049 }
1050 else {
1051 ++*d;
1052 if (isalpha(*d))
1053 return;
1054 *(d--) -= 'z' - 'a' + 1;
1055 }
8d063cd8
LW
1056 }
1057 /* oh,oh, the number grew */
a687059c 1058 STR_GROW(str, str->str_cur + 2);
8d063cd8
LW
1059 str->str_cur++;
1060 for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
1061 *d = d[-1];
378cc40b
LW
1062 if (isdigit(d[1]))
1063 *d = '1';
1064 else
1065 *d = d[1];
8d063cd8
LW
1066}
1067
1068void
1069str_dec(str)
1070register STR *str;
1071{
8d063cd8
LW
1072 if (!str)
1073 return;
1074 if (str->str_nok) {
a687059c 1075 str->str_u.str_nval -= 1.0;
8d063cd8
LW
1076 str->str_pok = 0;
1077 return;
1078 }
1079 if (!str->str_pok) {
a687059c 1080 str->str_u.str_nval = -1.0;
8d063cd8
LW
1081 str->str_nok = 1;
1082 return;
1083 }
378cc40b 1084 str_numset(str,atof(str->str_ptr) - 1.0);
8d063cd8
LW
1085}
1086
a687059c
LW
1087/* Make a string that will exist for the duration of the expression
1088 * evaluation. Actually, it may have to last longer than that, but
1089 * hopefully cmd_exec won't free it until it has been assigned to a
1090 * permanent location. */
1091
1092static long tmps_size = -1;
8d063cd8
LW
1093
1094STR *
1095str_static(oldstr)
1096STR *oldstr;
1097{
a687059c 1098 register STR *str = Str_new(78,0);
8d063cd8
LW
1099
1100 str_sset(str,oldstr);
1101 if (++tmps_max > tmps_size) {
1102 tmps_size = tmps_max;
1103 if (!(tmps_size & 127)) {
1104 if (tmps_size)
a687059c 1105 Renew(tmps_list, tmps_size + 128, STR*);
8d063cd8 1106 else
a687059c 1107 New(702,tmps_list, 128, STR*);
8d063cd8
LW
1108 }
1109 }
1110 tmps_list[tmps_max] = str;
1111 return str;
1112}
1113
a687059c
LW
1114/* same thing without the copying */
1115
8d063cd8 1116STR *
a687059c
LW
1117str_2static(str)
1118register STR *str;
1119{
1120 if (++tmps_max > tmps_size) {
1121 tmps_size = tmps_max;
1122 if (!(tmps_size & 127)) {
1123 if (tmps_size)
1124 Renew(tmps_list, tmps_size + 128, STR*);
1125 else
1126 New(704,tmps_list, 128, STR*);
1127 }
1128 }
1129 tmps_list[tmps_max] = str;
1130 return str;
1131}
1132
1133STR *
1134str_make(s,len)
8d063cd8 1135char *s;
a687059c 1136int len;
8d063cd8 1137{
a687059c 1138 register STR *str = Str_new(79,0);
8d063cd8 1139
a687059c
LW
1140 if (!len)
1141 len = strlen(s);
1142 str_nset(str,s,len);
8d063cd8
LW
1143 return str;
1144}
1145
1146STR *
1147str_nmake(n)
1148double n;
1149{
a687059c 1150 register STR *str = Str_new(80,0);
8d063cd8
LW
1151
1152 str_numset(str,n);
1153 return str;
1154}
a687059c
LW
1155
1156/* make an exact duplicate of old */
1157
1158STR *
1159str_smake(old)
1160register STR *old;
1161{
1162 register STR *new = Str_new(81,0);
1163
1164 if (!old)
1165 return Nullstr;
1166 if (old->str_state == SS_FREE) {
1167 warn("semi-panic: attempt to dup freed string");
1168 return Nullstr;
1169 }
1170 if (old->str_state == SS_INCR && !(old->str_pok & 2))
1171 str_grow(old,0);
1172 if (new->str_ptr)
1173 Safefree(new->str_ptr);
1174 Copy(old,new,1,STR);
1175 if (old->str_ptr)
1176 new->str_ptr = nsavestr(old->str_ptr,old->str_len);
1177 return new;
1178}
1179
1180str_reset(s,stash)
1181register char *s;
1182HASH *stash;
1183{
1184 register HENT *entry;
1185 register STAB *stab;
1186 register STR *str;
1187 register int i;
1188 register SPAT *spat;
1189 register int max;
1190
1191 if (!*s) { /* reset ?? searches */
1192 for (spat = stash->tbl_spatroot;
1193 spat != Nullspat;
1194 spat = spat->spat_next) {
1195 spat->spat_flags &= ~SPAT_USED;
1196 }
1197 return;
1198 }
1199
1200 /* reset variables */
1201
1202 while (*s) {
1203 i = *s;
1204 if (s[1] == '-') {
1205 s += 2;
1206 }
1207 max = *s++;
1208 for ( ; i <= max; i++) {
1209 for (entry = stash->tbl_array[i];
1210 entry;
1211 entry = entry->hent_next) {
1212 stab = (STAB*)entry->hent_val;
1213 str = stab_val(stab);
1214 str->str_cur = 0;
1215 str->str_nok = 0;
1216#ifdef TAINT
1217 str->str_tainted = tainted;
1218#endif
1219 if (str->str_ptr != Nullch)
1220 str->str_ptr[0] = '\0';
1221 if (stab_xarray(stab)) {
1222 aclear(stab_xarray(stab));
1223 }
1224 if (stab_xhash(stab)) {
1225 hclear(stab_xhash(stab));
1226 if (stab == envstab)
1227 environ[0] = Nullch;
1228 }
1229 }
1230 }
1231 }
1232}
1233
1234#ifdef TAINT
1235taintproper(s)
1236char *s;
1237{
1238#ifdef DEBUGGING
1239 if (debug & 2048)
1240 fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
1241#endif
1242 if (tainted && (!euid || euid != uid)) {
1243 if (!unsafe)
1244 fatal("%s", s);
1245 else if (dowarn)
1246 warn("%s", s);
1247 }
1248}
1249
1250taintenv()
1251{
1252 register STR *envstr;
1253
1254 envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
1255 if (!envstr || envstr->str_tainted) {
1256 tainted = 1;
1257 taintproper("Insecure PATH");
1258 }
1259 envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
1260 if (envstr && envstr->str_tainted) {
1261 tainted = 1;
1262 taintproper("Insecure IFS");
1263 }
1264}
1265#endif /* TAINT */