diff options
Diffstat (limited to 'str.c.orig')
-rw-r--r-- | str.c.orig | 1594 |
1 files changed, 0 insertions, 1594 deletions
diff --git a/str.c.orig b/str.c.orig deleted file mode 100644 index 4b597ccd51..0000000000 --- a/str.c.orig +++ /dev/null @@ -1,1594 +0,0 @@ -/* $RCSfile: str.c,v $$Revision: 4.0.1.6 $$Date: 92/06/11 21:14:21 $ - * - * Copyright (c) 1991, Larry Wall - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: str.c,v $ - * Revision 4.0.1.6 92/06/11 21:14:21 lwall - * patch34: quotes containing subscripts containing variables didn't parse right - * - * Revision 4.0.1.5 92/06/08 15:40:43 lwall - * patch20: removed implicit int declarations on functions - * patch20: Perl now distinguishes overlapped copies from non-overlapped - * patch20: paragraph mode now skips extra newlines automatically - * patch20: fixed memory leak in doube-quote interpretation - * patch20: made /\$$foo/ look for literal '$foo' - * patch20: "$var{$foo'bar}" didn't scan subscript correctly - * patch20: a splice on non-existent array elements could dump core - * patch20: running taintperl explicitly now does checks even if $< == $> - * - * Revision 4.0.1.4 91/11/05 18:40:51 lwall - * patch11: $foo .= <BAR> could overrun malloced memory - * patch11: \$ didn't always make it through double-quoter to regexp routines - * patch11: prepared for ctype implementations that don't define isascii() - * - * Revision 4.0.1.3 91/06/10 01:27:54 lwall - * patch10: $) and $| incorrectly handled in run-time patterns - * - * Revision 4.0.1.2 91/06/07 11:58:13 lwall - * patch4: new copyright notice - * patch4: taint check on undefined string could cause core dump - * - * Revision 4.0.1.1 91/04/12 09:15:30 lwall - * patch1: fixed undefined environ problem - * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment - * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo - * - * Revision 4.0 91/03/20 01:39:55 lwall - * 4.0 baseline. - * - */ - -#include "EXTERN.h" -#include "perl.h" -#include "perly.h" - -static void ucase(); -static void lcase(); - -#ifndef str_get -char * -str_get(str) -STR *str; -{ -#ifdef TAINT - tainted |= str->str_tainted; -#endif - return str->str_pok ? str->str_ptr : str_2ptr(str); -} -#endif - -/* dlb ... guess we have a "crippled cc". - * dlb the following functions are usually macros. - */ -#ifndef str_true -int -str_true(Str) -STR *Str; -{ - if (Str->str_pok) { - if (*Str->str_ptr > '0' || - Str->str_cur > 1 || - (Str->str_cur && *Str->str_ptr != '0')) - return 1; - return 0; - } - if (Str->str_nok) - return (Str->str_u.str_nval != 0.0); - return 0; -} -#endif /* str_true */ - -#ifndef str_gnum -double str_gnum(Str) -STR *Str; -{ -#ifdef TAINT - tainted |= Str->str_tainted; -#endif /* TAINT*/ - if (Str->str_nok) - return Str->str_u.str_nval; - return str_2num(Str); -} -#endif /* str_gnum */ -/* dlb ... end of crutch */ - -char * -str_grow(str,newlen) -register STR *str; -#ifndef DOSISH -register int newlen; -#else -unsigned long newlen; -#endif -{ - register char *s = str->str_ptr; - -#ifdef MSDOS - if (newlen >= 0x10000) { - fprintf(stderr, "Allocation too large: %lx\n", newlen); - exit(1); - } -#endif /* MSDOS */ - if (str->str_state == SS_INCR) { /* data before str_ptr? */ - str->str_len += str->str_u.str_useful; - str->str_ptr -= str->str_u.str_useful; - str->str_u.str_useful = 0L; - Move(s, str->str_ptr, str->str_cur+1, char); - s = str->str_ptr; - str->str_state = SS_NORM; /* normal again */ - if (newlen > str->str_len) - newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */ - } - if (newlen > str->str_len) { /* need more room? */ - if (str->str_len) - Renew(s,newlen,char); - else - New(703,s,newlen,char); - str->str_ptr = s; - str->str_len = newlen; - } - return s; -} - -void -str_numset(str,num) -register STR *str; -double num; -{ - if (str->str_pok) { - str->str_pok = 0; /* invalidate pointer */ - if (str->str_state == SS_INCR) - Str_Grow(str,0); - } - str->str_u.str_nval = num; - str->str_state = SS_NORM; - str->str_nok = 1; /* validate number */ -#ifdef TAINT - str->str_tainted = tainted; -#endif -} - -char * -str_2ptr(str) -register STR *str; -{ - register char *s; - int olderrno; - - if (!str) - return ""; - if (str->str_nok) { - STR_GROW(str, 30); - s = str->str_ptr; - olderrno = errno; /* some Xenix systems wipe out errno here */ -#if defined(scs) && defined(ns32000) - gcvt(str->str_u.str_nval,20,s); -#else -#ifdef apollo - if (str->str_u.str_nval == 0.0) - (void)strcpy(s,"0"); - else -#endif /*apollo*/ - (void)sprintf(s,"%.20g",str->str_u.str_nval); -#endif /*scs*/ - errno = olderrno; - while (*s) s++; -#ifdef hcx - if (s[-1] == '.') - s--; -#endif - } - else { - if (str == &str_undef) - return No; - if (dowarn) - warn("Use of uninitialized variable"); - STR_GROW(str, 30); - s = str->str_ptr; - } - *s = '\0'; - str->str_cur = s - str->str_ptr; - str->str_pok = 1; -#ifdef DEBUGGING - if (debug & 32) - fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr); -#endif - return str->str_ptr; -} - -double -str_2num(str) -register STR *str; -{ - if (!str) - return 0.0; - if (str->str_state == SS_INCR) - Str_Grow(str,0); /* just force copy down */ - str->str_state = SS_NORM; - if (str->str_len && str->str_pok) - str->str_u.str_nval = atof(str->str_ptr); - else { - if (str == &str_undef) - return 0.0; - if (dowarn) - warn("Use of uninitialized variable"); - str->str_u.str_nval = 0.0; - } - str->str_nok = 1; -#ifdef DEBUGGING - if (debug & 32) - fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval); -#endif - return str->str_u.str_nval; -} - -/* Note: str_sset() should not be called with a source string that needs - * be reused, since it may destroy the source string if it is marked - * as temporary. - */ - -void -str_sset(dstr,sstr) -STR *dstr; -register STR *sstr; -{ -#ifdef TAINT - if (sstr) - tainted |= sstr->str_tainted; -#endif - if (sstr == dstr || dstr == &str_undef) - return; - if (!sstr) - dstr->str_pok = dstr->str_nok = 0; - else if (sstr->str_pok) { - - /* - * Check to see if we can just swipe the string. If so, it's a - * possible small lose on short strings, but a big win on long ones. - * It might even be a win on short strings if dstr->str_ptr - * has to be allocated and sstr->str_ptr has to be freed. - */ - - if (sstr->str_pok & SP_TEMP) { /* slated for free anyway? */ - if (dstr->str_ptr) { - if (dstr->str_state == SS_INCR) - dstr->str_ptr -= dstr->str_u.str_useful; - Safefree(dstr->str_ptr); - } - dstr->str_ptr = sstr->str_ptr; - dstr->str_len = sstr->str_len; - dstr->str_cur = sstr->str_cur; - dstr->str_state = sstr->str_state; - dstr->str_pok = sstr->str_pok & ~SP_TEMP; -#ifdef TAINT - dstr->str_tainted = sstr->str_tainted; -#endif - sstr->str_ptr = Nullch; - sstr->str_len = 0; - sstr->str_pok = 0; /* wipe out any weird flags */ - sstr->str_state = 0; /* so sstr frees uneventfully */ - } - else { /* have to copy actual string */ - if (dstr->str_ptr) { - if (dstr->str_state == SS_INCR) { - Str_Grow(dstr,0); - } - } - str_nset(dstr,sstr->str_ptr,sstr->str_cur); - } - /*SUPPRESS 560*/ - if (dstr->str_nok = sstr->str_nok) - dstr->str_u.str_nval = sstr->str_u.str_nval; - else { -#ifdef STRUCTCOPY - dstr->str_u = sstr->str_u; -#else - dstr->str_u.str_nval = sstr->str_u.str_nval; -#endif - if (dstr->str_cur == sizeof(STBP)) { - char *tmps = dstr->str_ptr; - - if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) { - if (dstr->str_magic && dstr->str_magic->str_rare == 'X') { - str_free(dstr->str_magic); - dstr->str_magic = Nullstr; - } - if (!dstr->str_magic) { - dstr->str_magic = str_smake(sstr->str_magic); - dstr->str_magic->str_rare = 'X'; - } - } - } - } - } - else if (sstr->str_nok) - str_numset(dstr,sstr->str_u.str_nval); - else { - if (dstr->str_state == SS_INCR) - Str_Grow(dstr,0); /* just force copy down */ - -#ifdef STRUCTCOPY - dstr->str_u = sstr->str_u; -#else - dstr->str_u.str_nval = sstr->str_u.str_nval; -#endif - dstr->str_pok = dstr->str_nok = 0; - } -} - -void -str_nset(str,ptr,len) -register STR *str; -register char *ptr; -register STRLEN len; -{ - if (str == &str_undef) - return; - STR_GROW(str, len + 1); - if (ptr) - Move(ptr,str->str_ptr,len,char); - str->str_cur = len; - *(str->str_ptr+str->str_cur) = '\0'; - str->str_nok = 0; /* invalidate number */ - str->str_pok = 1; /* validate pointer */ -#ifdef TAINT - str->str_tainted = tainted; -#endif -} - -void -str_set(str,ptr) -register STR *str; -register char *ptr; -{ - register STRLEN len; - - if (str == &str_undef) - return; - if (!ptr) - ptr = ""; - len = strlen(ptr); - STR_GROW(str, len + 1); - Move(ptr,str->str_ptr,len+1,char); - str->str_cur = len; - str->str_nok = 0; /* invalidate number */ - str->str_pok = 1; /* validate pointer */ -#ifdef TAINT - str->str_tainted = tainted; -#endif -} - -void -str_chop(str,ptr) /* like set but assuming ptr is in str */ -register STR *str; -register char *ptr; -{ - register STRLEN delta; - - if (!ptr || !(str->str_pok)) - return; - delta = ptr - str->str_ptr; - str->str_len -= delta; - str->str_cur -= delta; - str->str_ptr += delta; - if (str->str_state == SS_INCR) - str->str_u.str_useful += delta; - else { - str->str_u.str_useful = delta; - str->str_state = SS_INCR; - } - str->str_nok = 0; /* invalidate number */ - str->str_pok = 1; /* validate pointer (and unstudy str) */ -} - -void -str_ncat(str,ptr,len) -register STR *str; -register char *ptr; -register STRLEN len; -{ - if (str == &str_undef) - return; - if (!(str->str_pok)) - (void)str_2ptr(str); - STR_GROW(str, str->str_cur + len + 1); - Move(ptr,str->str_ptr+str->str_cur,len,char); - str->str_cur += len; - *(str->str_ptr+str->str_cur) = '\0'; - str->str_nok = 0; /* invalidate number */ - str->str_pok = 1; /* validate pointer */ -#ifdef TAINT - str->str_tainted |= tainted; -#endif -} - -void -str_scat(dstr,sstr) -STR *dstr; -register STR *sstr; -{ - if (!sstr) - return; -#ifdef TAINT - tainted |= sstr->str_tainted; -#endif - if (!(sstr->str_pok)) - (void)str_2ptr(sstr); - if (sstr) - str_ncat(dstr,sstr->str_ptr,sstr->str_cur); -} - -void -str_cat(str,ptr) -register STR *str; -register char *ptr; -{ - register STRLEN len; - - if (str == &str_undef) - return; - if (!ptr) - return; - if (!(str->str_pok)) - (void)str_2ptr(str); - len = strlen(ptr); - STR_GROW(str, str->str_cur + len + 1); - Move(ptr,str->str_ptr+str->str_cur,len+1,char); - str->str_cur += len; - str->str_nok = 0; /* invalidate number */ - str->str_pok = 1; /* validate pointer */ -#ifdef TAINT - str->str_tainted |= tainted; -#endif -} - -char * -str_append_till(str,from,fromend,delim,keeplist) -register STR *str; -register char *from; -register char *fromend; -register int delim; -char *keeplist; -{ - register char *to; - register STRLEN len; - - if (str == &str_undef) - return Nullch; - if (!from) - return Nullch; - len = fromend - from; - STR_GROW(str, str->str_cur + len + 1); - str->str_nok = 0; /* invalidate number */ - str->str_pok = 1; /* validate pointer */ - to = str->str_ptr+str->str_cur; - for (; from < fromend; from++,to++) { - if (*from == '\\' && from+1 < fromend && delim != '\\') { - if (!keeplist) { - if (from[1] == delim || from[1] == '\\') - from++; - else - *to++ = *from++; - } - else if (from[1] && index(keeplist,from[1])) - *to++ = *from++; - else - from++; - } - else if (*from == delim) - break; - *to = *from; - } - *to = '\0'; - str->str_cur = to - str->str_ptr; - return from; -} - -STR * -#ifdef LEAKTEST -str_new(x,len) -int x; -#else -str_new(len) -#endif -STRLEN len; -{ - register STR *str; - - if (freestrroot) { - str = freestrroot; - freestrroot = str->str_magic; - str->str_magic = Nullstr; - str->str_state = SS_NORM; - } - else { - Newz(700+x,str,1,STR); - } - if (len) - STR_GROW(str, len + 1); - return str; -} - -void -str_magic(str, stab, how, name, namlen) -register STR *str; -STAB *stab; -int how; -char *name; -STRLEN namlen; -{ - if (str == &str_undef || str->str_magic) - return; - str->str_magic = Str_new(75,namlen); - str = str->str_magic; - str->str_u.str_stab = stab; - str->str_rare = how; - if (name) - str_nset(str,name,namlen); -} - -void -str_insert(bigstr,offset,len,little,littlelen) -STR *bigstr; -STRLEN offset; -STRLEN len; -char *little; -STRLEN littlelen; -{ - register char *big; - register char *mid; - register char *midend; - register char *bigend; - register int i; - - if (bigstr == &str_undef) - return; - bigstr->str_nok = 0; - bigstr->str_pok = SP_VALID; /* disable possible screamer */ - - i = littlelen - len; - if (i > 0) { /* string might grow */ - STR_GROW(bigstr, bigstr->str_cur + i + 1); - big = bigstr->str_ptr; - mid = big + offset + len; - midend = bigend = big + bigstr->str_cur; - bigend += i; - *bigend = '\0'; - while (midend > mid) /* shove everything down */ - *--bigend = *--midend; - Move(little,big+offset,littlelen,char); - bigstr->str_cur += i; - STABSET(bigstr); - return; - } - else if (i == 0) { - Move(little,bigstr->str_ptr+offset,len,char); - STABSET(bigstr); - return; - } - - big = bigstr->str_ptr; - mid = big + offset; - midend = mid + len; - bigend = big + bigstr->str_cur; - - if (midend > bigend) - fatal("panic: str_insert"); - - if (mid - big > bigend - midend) { /* faster to shorten from end */ - if (littlelen) { - Move(little, mid, littlelen,char); - mid += littlelen; - } - i = bigend - midend; - if (i > 0) { - Move(midend, mid, i,char); - mid += i; - } - *mid = '\0'; - bigstr->str_cur = mid - big; - } - /*SUPPRESS 560*/ - else if (i = mid - big) { /* faster from front */ - midend -= littlelen; - mid = midend; - str_chop(bigstr,midend-i); - big += i; - while (i--) - *--midend = *--big; - if (littlelen) - Move(little, mid, littlelen,char); - } - else if (littlelen) { - midend -= littlelen; - str_chop(bigstr,midend); - Move(little,midend,littlelen,char); - } - else { - str_chop(bigstr,midend); - } - STABSET(bigstr); -} - -/* make str point to what nstr did */ - -void -str_replace(str,nstr) -register STR *str; -register STR *nstr; -{ - if (str == &str_undef) - return; - if (str->str_state == SS_INCR) - Str_Grow(str,0); /* just force copy down */ - if (nstr->str_state == SS_INCR) - Str_Grow(nstr,0); - if (str->str_ptr) - Safefree(str->str_ptr); - str->str_ptr = nstr->str_ptr; - str->str_len = nstr->str_len; - str->str_cur = nstr->str_cur; - str->str_pok = nstr->str_pok; - str->str_nok = nstr->str_nok; -#ifdef STRUCTCOPY - str->str_u = nstr->str_u; -#else - str->str_u.str_nval = nstr->str_u.str_nval; -#endif -#ifdef TAINT - str->str_tainted = nstr->str_tainted; -#endif - if (nstr->str_magic) - str_free(nstr->str_magic); - Safefree(nstr); -} - -void -str_free(str) -register STR *str; -{ - if (!str || str == &str_undef) - return; - if (str->str_state) { - if (str->str_state == SS_FREE) /* already freed */ - return; - if (str->str_state == SS_INCR && !(str->str_pok & 2)) { - str->str_ptr -= str->str_u.str_useful; - str->str_len += str->str_u.str_useful; - } - } - if (str->str_magic) - str_free(str->str_magic); - str->str_magic = freestrroot; -#ifdef LEAKTEST - if (str->str_len) { - Safefree(str->str_ptr); - str->str_ptr = Nullch; - } - if ((str->str_pok & SP_INTRP) && str->str_u.str_args) - arg_free(str->str_u.str_args); - Safefree(str); -#else /* LEAKTEST */ - if (str->str_len) { - if (str->str_len > 127) { /* next user not likely to want more */ - Safefree(str->str_ptr); /* so give it back to malloc */ - str->str_ptr = Nullch; - str->str_len = 0; - } - else - str->str_ptr[0] = '\0'; - } - if ((str->str_pok & SP_INTRP) && str->str_u.str_args) - arg_free(str->str_u.str_args); - str->str_cur = 0; - str->str_nok = 0; - str->str_pok = 0; - str->str_state = SS_FREE; -#ifdef TAINT - str->str_tainted = 0; -#endif - freestrroot = str; -#endif /* LEAKTEST */ -} - -STRLEN -str_len(str) -register STR *str; -{ - if (!str) - return 0; - if (!(str->str_pok)) - (void)str_2ptr(str); - if (str->str_ptr) - return str->str_cur; - else - return 0; -} - -int -str_eq(str1,str2) -register STR *str1; -register STR *str2; -{ - if (!str1 || str1 == &str_undef) - return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur); - if (!str2 || str2 == &str_undef) - return !str1->str_cur; - - if (!str1->str_pok) - (void)str_2ptr(str1); - if (!str2->str_pok) - (void)str_2ptr(str2); - - if (str1->str_cur != str2->str_cur) - return 0; - - return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur); -} - -int -str_cmp(str1,str2) -register STR *str1; -register STR *str2; -{ - int retval; - - if (!str1 || str1 == &str_undef) - return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1; - if (!str2 || str2 == &str_undef) - return str1->str_cur != 0; - - if (!str1->str_pok) - (void)str_2ptr(str1); - if (!str2->str_pok) - (void)str_2ptr(str2); - - if (str1->str_cur < str2->str_cur) { - /*SUPPRESS 560*/ - if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) - return retval < 0 ? -1 : 1; - else - return -1; - } - /*SUPPRESS 560*/ - else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) - return retval < 0 ? -1 : 1; - else if (str1->str_cur == str2->str_cur) - return 0; - else - return 1; -} - -char * -str_gets(str,fp,append) -register STR *str; -register FILE *fp; -int append; -{ - register char *bp; /* we're going to steal some values */ - register int cnt; /* from the stdio struct and put EVERYTHING */ - register STDCHAR *ptr; /* in the innermost loop into registers */ - register int newline = rschar;/* (assuming >= 6 registers) */ - int i; - STRLEN bpx; - int shortbuffered; - - if (str == &str_undef) - return Nullch; - if (rspara) { /* have to do this both before and after */ - do { /* to make sure file boundaries work right */ - i = getc(fp); - if (i != '\n') { - ungetc(i,fp); - break; - } - } while (i != EOF); - } -#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */ - cnt = fp->_cnt; /* get count into register */ - str->str_nok = 0; /* invalidate number */ - str->str_pok = 1; /* validate pointer */ - if (str->str_len - append <= cnt + 1) { /* make sure we have the room */ - if (cnt > 80 && str->str_len > append) { - shortbuffered = cnt - str->str_len + append + 1; - cnt -= shortbuffered; - } - else { - shortbuffered = 0; - STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */ - } - } - else - shortbuffered = 0; - bp = str->str_ptr + append; /* move these two too to registers */ - ptr = fp->_ptr; - for (;;) { - screamer: - while (--cnt >= 0) { /* this */ /* eat */ - if ((*bp++ = *ptr++) == newline) /* really */ /* dust */ - goto thats_all_folks; /* screams */ /* sed :-) */ - } - - if (shortbuffered) { /* oh well, must extend */ - cnt = shortbuffered; - shortbuffered = 0; - bpx = bp - str->str_ptr; /* prepare for possible relocation */ - str->str_cur = bpx; - STR_GROW(str, str->str_len + append + cnt + 2); - bp = str->str_ptr + bpx; /* reconstitute our pointer */ - continue; - } - - fp->_cnt = cnt; /* deregisterize cnt and ptr */ - fp->_ptr = ptr; - i = _filbuf(fp); /* get more characters */ - cnt = fp->_cnt; - ptr = fp->_ptr; /* reregisterize cnt and ptr */ - - bpx = bp - str->str_ptr; /* prepare for possible relocation */ - str->str_cur = bpx; - STR_GROW(str, bpx + cnt + 2); - bp = str->str_ptr + bpx; /* reconstitute our pointer */ - - if (i == newline) { /* all done for now? */ - *bp++ = i; - goto thats_all_folks; - } - else if (i == EOF) /* all done for ever? */ - goto thats_really_all_folks; - *bp++ = i; /* now go back to screaming loop */ - } - -thats_all_folks: - if (rslen > 1 && (bp - str->str_ptr < rslen || bcmp(bp - rslen, rs, rslen))) - goto screamer; /* go back to the fray */ -thats_really_all_folks: - if (shortbuffered) - cnt += shortbuffered; - fp->_cnt = cnt; /* put these back or we're in trouble */ - fp->_ptr = ptr; - *bp = '\0'; - str->str_cur = bp - str->str_ptr; /* set length */ - -#else /* !STDSTDIO */ /* The big, slow, and stupid way */ - - { - static char buf[8192]; - char * bpe = buf + sizeof(buf) - 3; - -screamer: - bp = buf; - while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ; - - *bp = '\0'; - if (append) - str_cat(str, buf); - else - str_set(str, buf); - if (i != EOF /* joy */ - && - (i != newline - || - (rslen > 1 - && - (str->str_cur < rslen - || - bcmp(str->str_ptr + str->str_cur - rslen, rs, rslen) - ) - ) - ) - ) - { - append = -1; - goto screamer; - } - } - -#endif /* STDSTDIO */ - - if (rspara) { - while (i != EOF) { - i = getc(fp); - if (i != '\n') { - ungetc(i,fp); - break; - } - } - } - return str->str_cur - append ? str->str_ptr : Nullch; -} - -ARG * -parselist(str) -STR *str; -{ - register CMD *cmd; - register ARG *arg; - CMD *oldcurcmd = curcmd; - int oldperldb = perldb; - int retval; - - perldb = 0; - str_sset(linestr,str); - in_eval++; - oldoldbufptr = oldbufptr = bufptr = str_get(linestr); - bufend = bufptr + linestr->str_cur; - if (++loop_ptr >= loop_max) { - loop_max += 128; - Renew(loop_stack, loop_max, struct loop); - } - loop_stack[loop_ptr].loop_label = "_EVAL_"; - loop_stack[loop_ptr].loop_sp = 0; -#ifdef DEBUGGING - if (debug & 4) { - deb("(Pushing label #%d _EVAL_)\n", loop_ptr); - } -#endif - if (setjmp(loop_stack[loop_ptr].loop_env)) { - in_eval--; - loop_ptr--; - perldb = oldperldb; - fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr); - } -#ifdef DEBUGGING - if (debug & 4) { - char *tmps = loop_stack[loop_ptr].loop_label; - deb("(Popping label #%d %s)\n",loop_ptr, - tmps ? tmps : "" ); - } -#endif - loop_ptr--; - error_count = 0; - curcmd = &compiling; - curcmd->c_line = oldcurcmd->c_line; - retval = yyparse(); - curcmd = oldcurcmd; - perldb = oldperldb; - in_eval--; - if (retval || error_count) - fatal("Invalid component in string or format"); - cmd = eval_root; - arg = cmd->c_expr; - if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST) - fatal("panic: error in parselist %d %x %d", cmd->c_type, - cmd->c_next, arg ? arg->arg_type : -1); - cmd->c_expr = Nullarg; - cmd_free(cmd); - eval_root = Nullcmd; - return arg; -} - -void -intrpcompile(src) -STR *src; -{ - register char *s = str_get(src); - register char *send = s + src->str_cur; - register STR *str; - register char *t; - STR *toparse; - STRLEN len; - register int brackets; - register char *d; - STAB *stab; - char *checkpoint; - int sawcase = 0; - - toparse = Str_new(76,0); - str = Str_new(77,0); - - str_nset(str,"",0); - str_nset(toparse,"",0); - t = s; - while (s < send) { - if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) { - str_ncat(str, t, s - t); - ++s; - if (isALPHA(*s)) { - str_ncat(str, "$c", 2); - sawcase = (*s != 'E'); - } - else { - if (*nointrp) { /* in a regular expression */ - if (*s == '@') /* always strip \@ */ /*SUPPRESS 530*/ - ; - else /* don't strip \\, \[, \{ etc. */ - str_ncat(str,s-1,1); - } - str_ncat(str, "$b", 2); - } - str_ncat(str, s, 1); - ++s; - t = s; - } - else if (*s == '$' && s+1 < send && *nointrp && index(nointrp,s[1])) { - str_ncat(str, t, s - t); - str_ncat(str, "$b", 2); - str_ncat(str, s, 2); - s += 2; - t = s; - } - else if ((*s == '@' || *s == '$') && s+1 < send) { - str_ncat(str,t,s-t); - t = s; - if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) - s++; - s = scanident(s,send,tokenbuf); - if (*t == '@' && - (!(stab = stabent(tokenbuf,FALSE)) || - (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) { - str_ncat(str,"@",1); - s = ++t; - continue; /* grandfather @ from old scripts */ - } - str_ncat(str,"$a",2); - str_ncat(toparse,",",1); - if (t[1] != '{' && (*s == '[' || *s == '{' /* }} */ ) && - (stab = stabent(tokenbuf,FALSE)) && - ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) { - brackets = 0; - checkpoint = s; - do { - switch (*s) { - case '[': - brackets++; - break; - case '{': - brackets++; - break; - case ']': - brackets--; - break; - case '}': - brackets--; - break; - case '$': - case '%': - case '@': - case '&': - case '*': - s = scanident(s,send,tokenbuf); - continue; - case '\'': - case '"': - /*SUPPRESS 68*/ - s = cpytill(tokenbuf,s+1,send,*s,&len); - if (s >= send) - fatal("Unterminated string"); - break; - } - s++; - } while (brackets > 0 && s < send); - if (s > send) - fatal("Unmatched brackets in string"); - if (*nointrp) { /* we're in a regular expression */ - d = checkpoint; - if (*d == '{' && s[-1] == '}') { /* maybe {n,m} */ - ++d; - if (isDIGIT(*d)) { /* matches /^{\d,?\d*}$/ */ - if (*++d == ',') - ++d; - while (isDIGIT(*d)) - d++; - if (d == s - 1) - s = checkpoint; /* Is {n,m}! Backoff! */ - } - } - else if (*d == '[' && s[-1] == ']') { /* char class? */ - int weight = 2; /* let's weigh the evidence */ - char seen[256]; - unsigned char un_char = 0, last_un_char; - - Zero(seen,256,char); - *--s = '\0'; - if (d[1] == '^') - weight += 150; - else if (d[1] == '$') - weight -= 3; - if (isDIGIT(d[1])) { - if (d[2]) { - if (isDIGIT(d[2]) && !d[3]) - weight -= 10; - } - else - weight -= 100; - } - for (d++; d < s; d++) { - last_un_char = un_char; - un_char = (unsigned char)*d; - switch (*d) { - case '&': - case '$': - weight -= seen[un_char] * 10; - if (isALNUM(d[1])) { - d = scanident(d,s,tokenbuf); - if (stabent(tokenbuf,FALSE)) - weight -= 100; - else - weight -= 10; - } - else if (*d == '$' && d[1] && - index("[#!%*<>()-=",d[1])) { - if (!d[2] || /*{*/ index("])} =",d[2])) - weight -= 10; - else - weight -= 1; - } - break; - case '\\': - un_char = 254; - if (d[1]) { - if (index("wds",d[1])) - weight += 100; - else if (seen['\''] || seen['"']) - weight += 1; - else if (index("rnftb",d[1])) - weight += 40; - else if (isDIGIT(d[1])) { - weight += 40; - while (d[1] && isDIGIT(d[1])) - d++; - } - } - else - weight += 100; - break; - case '-': - if (last_un_char < (unsigned char) d[1] - || d[1] == '\\') { - if (index("aA01! ",last_un_char)) - weight += 30; - if (index("zZ79~",d[1])) - weight += 30; - } - else - weight -= 1; - default: - if (isALPHA(*d) && d[1] && isALPHA(d[1])) { - bufptr = d; - if (yylex() != WORD) - weight -= 150; - d = bufptr; - } - if (un_char == last_un_char + 1) - weight += 5; - weight -= seen[un_char]; - break; - } - seen[un_char]++; - } -#ifdef DEBUGGING - if (debug & 512) - fprintf(stderr,"[%s] weight %d\n", - checkpoint+1,weight); -#endif - *s++ = ']'; - if (weight >= 0) /* probably a character class */ - s = checkpoint; - } - } - } - if (*t == '@') - str_ncat(toparse, "join($\",", 8); - if (t[1] == '{' && s[-1] == '}') { - str_ncat(toparse, t, 1); - str_ncat(toparse, t+2, s - t - 3); - } - else - str_ncat(toparse, t, s - t); - if (*t == '@') - str_ncat(toparse, ")", 1); - t = s; - } - else - s++; - } - str_ncat(str,t,s-t); - if (sawcase) - str_ncat(str, "$cE", 3); - if (toparse->str_ptr && *toparse->str_ptr == ',') { - *toparse->str_ptr = '('; - str_ncat(toparse,",$$);",5); - str->str_u.str_args = parselist(toparse); - str->str_u.str_args->arg_len--; /* ignore $$ reference */ - } - else - str->str_u.str_args = Nullarg; - str_free(toparse); - str->str_pok |= SP_INTRP; - str->str_nok = 0; - str_replace(src,str); -} - -STR * -interp(str,src,sp) -register STR *str; -STR *src; -int sp; -{ - register char *s; - register char *t; - register char *send; - register STR **elem; - int docase = 0; - int l = 0; - int u = 0; - int L = 0; - int U = 0; - - if (str == &str_undef) - return Nullstr; - if (!(src->str_pok & SP_INTRP)) { - int oldsave = savestack->ary_fill; - - (void)savehptr(&curstash); - curstash = curcmd->c_stash; /* so stabent knows right package */ - intrpcompile(src); - restorelist(oldsave); - } - s = src->str_ptr; /* assumed valid since str_pok set */ - t = s; - send = s + src->str_cur; - - if (src->str_u.str_args) { - (void)eval(src->str_u.str_args,G_ARRAY,sp); - /* Assuming we have correct # of args */ - elem = stack->ary_array + sp; - } - - str_nset(str,"",0); - while (s < send) { - if (*s == '$' && s+1 < send) { - if (s-t > 0) - str_ncat(str,t,s-t); - switch(*++s) { - default: - fatal("panic: unknown interp cookie\n"); - break; - case 'a': - str_scat(str,*++elem); - break; - case 'b': - str_ncat(str,++s,1); - break; - case 'c': - if (docase && str->str_cur >= docase) { - char *b = str->str_ptr + --docase; - - if (L) - lcase(b, str->str_ptr + str->str_cur); - else if (U) - ucase(b, str->str_ptr + str->str_cur); - - if (u) /* note that l & u are independent of L & U */ - ucase(b, b+1); - else if (l) - lcase(b, b+1); - l = u = 0; - } - docase = str->str_cur + 1; - switch (*++s) { - case 'u': - u = 1; - l = 0; - break; - case 'U': - U = 1; - L = 0; - break; - case 'l': - l = 1; - u = 0; - break; - case 'L': - L = 1; - U = 0; - break; - case 'E': - docase = L = U = l = u = 0; - break; - } - break; - } - t = ++s; - } - else - s++; - } - if (s-t > 0) - str_ncat(str,t,s-t); - return str; -} - -static void -ucase(s,send) -register char *s; -register char *send; -{ - while (s < send) { - if (isLOWER(*s)) - *s = toupper(*s); - s++; - } -} - -static void -lcase(s,send) -register char *s; -register char *send; -{ - while (s < send) { - if (isUPPER(*s)) - *s = tolower(*s); - s++; - } -} - -void -str_inc(str) -register STR *str; -{ - register char *d; - - if (!str || str == &str_undef) - return; - if (str->str_nok) { - str->str_u.str_nval += 1.0; - str->str_pok = 0; - return; - } - if (!str->str_pok || !*str->str_ptr) { - str->str_u.str_nval = 1.0; - str->str_nok = 1; - str->str_pok = 0; - return; - } - d = str->str_ptr; - while (isALPHA(*d)) d++; - while (isDIGIT(*d)) d++; - if (*d) { - str_numset(str,atof(str->str_ptr) + 1.0); /* punt */ - return; - } - d--; - while (d >= str->str_ptr) { - if (isDIGIT(*d)) { - if (++*d <= '9') - return; - *(d--) = '0'; - } - else { - ++*d; - if (isALPHA(*d)) - return; - *(d--) -= 'z' - 'a' + 1; - } - } - /* oh,oh, the number grew */ - STR_GROW(str, str->str_cur + 2); - str->str_cur++; - for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--) - *d = d[-1]; - if (isDIGIT(d[1])) - *d = '1'; - else - *d = d[1]; -} - -void -str_dec(str) -register STR *str; -{ - if (!str || str == &str_undef) - return; - if (str->str_nok) { - str->str_u.str_nval -= 1.0; - str->str_pok = 0; - return; - } - if (!str->str_pok) { - str->str_u.str_nval = -1.0; - str->str_nok = 1; - return; - } - str_numset(str,atof(str->str_ptr) - 1.0); -} - -/* Make a string that will exist for the duration of the expression - * evaluation. Actually, it may have to last longer than that, but - * hopefully cmd_exec won't free it until it has been assigned to a - * permanent location. */ - -static long tmps_size = -1; - -STR * -str_mortal(oldstr) -STR *oldstr; -{ - register STR *str = Str_new(78,0); - - str_sset(str,oldstr); - if (++tmps_max > tmps_size) { - tmps_size = tmps_max; - if (!(tmps_size & 127)) { - if (tmps_size) - Renew(tmps_list, tmps_size + 128, STR*); - else - New(702,tmps_list, 128, STR*); - } - } - tmps_list[tmps_max] = str; - if (str->str_pok) - str->str_pok |= SP_TEMP; - return str; -} - -/* same thing without the copying */ - -STR * -str_2mortal(str) -register STR *str; -{ - if (!str || str == &str_undef) - return str; - if (++tmps_max > tmps_size) { - tmps_size = tmps_max; - if (!(tmps_size & 127)) { - if (tmps_size) - Renew(tmps_list, tmps_size + 128, STR*); - else - New(704,tmps_list, 128, STR*); - } - } - tmps_list[tmps_max] = str; - if (str->str_pok) - str->str_pok |= SP_TEMP; - return str; -} - -STR * -str_make(s,len) -char *s; -STRLEN len; -{ - register STR *str = Str_new(79,0); - - if (!len) - len = strlen(s); - str_nset(str,s,len); - return str; -} - -STR * -str_nmake(n) -double n; -{ - register STR *str = Str_new(80,0); - - str_numset(str,n); - return str; -} - -/* make an exact duplicate of old */ - -STR * -str_smake(old) -register STR *old; -{ - register STR *new = Str_new(81,0); - - if (!old) - return Nullstr; - if (old->str_state == SS_FREE) { - warn("semi-panic: attempt to dup freed string"); - return Nullstr; - } - if (old->str_state == SS_INCR && !(old->str_pok & 2)) - Str_Grow(old,0); - if (new->str_ptr) - Safefree(new->str_ptr); - StructCopy(old,new,STR); - if (old->str_ptr) { - new->str_ptr = nsavestr(old->str_ptr,old->str_len); - new->str_pok &= ~SP_TEMP; - } - return new; -} - -void -str_reset(s,stash) -register char *s; -HASH *stash; -{ - register HENT *entry; - register STAB *stab; - register STR *str; - register int i; - register SPAT *spat; - register int max; - - if (!*s) { /* reset ?? searches */ - for (spat = stash->tbl_spatroot; - spat != Nullspat; - spat = spat->spat_next) { - spat->spat_flags &= ~SPAT_USED; - } - return; - } - - /* reset variables */ - - if (!stash->tbl_array) - return; - while (*s) { - i = *s; - if (s[1] == '-') { - s += 2; - } - max = *s++; - for ( ; i <= max; i++) { - for (entry = stash->tbl_array[i]; - entry; - entry = entry->hent_next) { - stab = (STAB*)entry->hent_val; - str = stab_val(stab); - str->str_cur = 0; - str->str_nok = 0; -#ifdef TAINT - str->str_tainted = tainted; -#endif - if (str->str_ptr != Nullch) - str->str_ptr[0] = '\0'; - if (stab_xarray(stab)) { - aclear(stab_xarray(stab)); - } - if (stab_xhash(stab)) { - hclear(stab_xhash(stab), FALSE); - if (stab == envstab) - environ[0] = Nullch; - } - } - } - } -} - -#ifdef TAINT -void -taintproper(s) -char *s; -{ -#ifdef DEBUGGING - if (debug & 2048) - fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid); -#endif - if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) { - if (!unsafe) - fatal("%s", s); - else if (dowarn) - warn("%s", s); - } -} - -void -taintenv() -{ - register STR *envstr; - - envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE); - if (envstr == &str_undef || envstr->str_tainted) { - tainted = 1; - if (envstr->str_tainted == 2) - taintproper("Insecure directory in PATH"); - else - taintproper("Insecure PATH"); - } - envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE); - if (envstr != &str_undef && envstr->str_tainted) { - tainted = 1; - taintproper("Insecure IFS"); - } -} -#endif /* TAINT */ |