-/* $Header: str.c,v 3.0.1.1 89/10/26 23:23:41 lwall Locked $
+/* $Header: str.c,v 3.0.1.11 90/11/13 15:27:14 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 3.0.1.11 90/11/13 15:27:14 lwall
+ * patch41: fixed a couple of malloc/free problems
+ *
+ * Revision 3.0.1.10 90/11/10 02:06:29 lwall
+ * patch38: temp string values are now copied less often
+ * patch38: array slurps are now faster and take less memory
+ * patch38: fixed a memory leakage on local(*foo)
+ *
+ * Revision 3.0.1.9 90/10/16 10:41:21 lwall
+ * patch29: the undefined value could get defined by devious means
+ * patch29: undefined values compared inconsistently
+ * patch29: taintperl now checks for world writable PATH components
+ *
+ * Revision 3.0.1.8 90/08/09 05:22:18 lwall
+ * patch19: the number to string converter wasn't allocating enough space
+ * patch19: tainting didn't work on setgid scripts
+ *
+ * Revision 3.0.1.7 90/03/27 16:24:11 lwall
+ * patch16: strings with prefix chopped off sometimes freed wrong
+ * patch16: taint check blows up on undefined array element
+ *
+ * Revision 3.0.1.6 90/03/12 17:02:14 lwall
+ * patch13: substr as lvalue didn't invalidate old numeric value
+ *
+ * Revision 3.0.1.5 90/02/28 18:30:38 lwall
+ * patch9: you may now undef $/ to have no input record separator
+ * patch9: nested evals clobbered their longjmp environment
+ * patch9: sometimes perl thought ordinary data was a symbol table entry
+ * patch9: insufficient space allocated for numeric string on sun4
+ * patch9: underscore in an array name in a double-quoted string not recognized
+ * patch9: "@foo{}" not recognized unless %foo defined
+ * patch9: "$foo[$[]" gives error
+ *
+ * Revision 3.0.1.4 89/12/21 20:21:35 lwall
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: made nested or recursive foreach work right
+ *
+ * Revision 3.0.1.3 89/11/17 15:38:23 lwall
+ * patch5: some machines typedef unchar too
+ * patch5: substitution on leading components occasionally caused <> corruption
+ *
+ * Revision 3.0.1.2 89/11/11 04:56:22 lwall
+ * patch2: uchar gives Crays fits
+ *
* Revision 3.0.1.1 89/10/26 23:23:41 lwall
* patch1: string ordering tests were wrong
* patch1: $/ now works even when STDSTDIO undefined
char *
str_grow(str,newlen)
register STR *str;
+#ifndef MSDOS
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;
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_pok = 0; /* invalidate pointer */
str->str_nok = 1; /* validate number */
#ifdef TAINT
str->str_tainted = tainted;
#endif
}
-extern int errno;
-
char *
str_2ptr(str)
register STR *str;
if (!str)
return "";
if (str->str_nok) {
- STR_GROW(str, 24);
+ STR_GROW(str, 30);
s = str->str_ptr;
olderrno = errno; /* some Xenix systems wipe out errno here */
#if defined(scs) && defined(ns32000)
#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, 24);
+ STR_GROW(str, 30);
s = str->str_ptr;
}
*s = '\0';
{
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);
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.
+ */
+
str_sset(dstr,sstr)
STR *dstr;
register STR *sstr;
{
#ifdef TAINT
- tainted |= sstr->str_tainted;
+ 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) {
- str_nset(dstr,sstr->str_ptr,sstr->str_cur);
- if (sstr->str_nok) {
- dstr->str_u.str_nval = sstr->str_u.str_nval;
- dstr->str_nok = 1;
- dstr->str_state = SS_NORM;
+
+ /*
+ * 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 if (sstr->str_cur == sizeof(STBP)) {
- char *tmps = sstr->str_ptr;
+ else /* have to copy actual string */
+ str_nset(dstr,sstr->str_ptr,sstr->str_cur);
+ 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,"Stab",4) == 0) {
- dstr->str_magic = str_smake(sstr->str_magic);
- dstr->str_magic->str_rare = 'X';
+ if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
+ 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
+ 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;
+ }
}
str_nset(str,ptr,len)
register STR *str;
register char *ptr;
-register int len;
+register STRLEN len;
{
+ if (str == &str_undef)
+ return;
STR_GROW(str, len + 1);
- (void)bcopy(ptr,str->str_ptr,len);
+ if (ptr)
+ (void)bcopy(ptr,str->str_ptr,len);
str->str_cur = len;
*(str->str_ptr+str->str_cur) = '\0';
str->str_nok = 0; /* invalidate number */
register STR *str;
register char *ptr;
{
- register int len;
+ register STRLEN len;
+ if (str == &str_undef)
+ return;
if (!ptr)
ptr = "";
len = strlen(ptr);
register STR *str;
register char *ptr;
{
- register int delta;
+ register STRLEN delta;
if (!(str->str_pok))
fatal("str_chop: internal inconsistency");
str_ncat(str,ptr,len)
register STR *str;
register char *ptr;
-register int len;
+register STRLEN len;
{
+ if (str == &str_undef)
+ return;
if (!(str->str_pok))
(void)str_2ptr(str);
STR_GROW(str, str->str_cur + len + 1);
register STR *str;
register char *ptr;
{
- register int len;
+ register STRLEN len;
+ if (str == &str_undef)
+ return;
if (!ptr)
return;
if (!(str->str_pok))
char *keeplist;
{
register char *to;
- register int len;
+ register STRLEN len;
+ if (str == &str_undef)
+ return Nullch;
if (!from)
return Nullch;
len = fromend - from;
#else
str_new(len)
#endif
-int len;
+STRLEN len;
{
register STR *str;
STAB *stab;
int how;
char *name;
-int namlen;
+STRLEN namlen;
{
- if (str->str_magic)
+ if (str == &str_undef || str->str_magic)
return;
str->str_magic = Str_new(75,namlen);
str = str->str_magic;
void
str_insert(bigstr,offset,len,little,littlelen)
STR *bigstr;
-int offset;
-int len;
+STRLEN offset;
+STRLEN len;
char *little;
-int littlelen;
+STRLEN littlelen;
{
register char *big;
register char *mid;
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);
if (midend > bigend)
fatal("panic: str_insert");
- bigstr->str_pok = SP_VALID; /* disable possible screamer */
-
if (mid - big > bigend - midend) { /* faster to shorten from end */
if (littlelen) {
(void)bcopy(little, mid, littlelen);
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 */
+ Str_Grow(str,0); /* just force copy down */
if (nstr->str_state == SS_INCR)
- str_grow(nstr,0);
+ Str_Grow(nstr,0);
if (str->str_ptr)
Safefree(str->str_ptr);
str->str_ptr = nstr->str_ptr;
#ifdef TAINT
str->str_tainted = nstr->str_tainted;
#endif
+ if (nstr->str_magic)
+ str_free(nstr->str_magic);
Safefree(nstr);
}
str_free(str)
register STR *str;
{
- if (!str)
+ if (!str || str == &str_undef)
return;
if (str->str_state) {
if (str->str_state == SS_FREE) /* already freed */
#endif /* LEAKTEST */
}
+STRLEN
str_len(str)
register STR *str;
{
register STR *str1;
register STR *str2;
{
- if (!str1)
- return str2 == Nullstr;
- if (!str2)
- return 0;
+ 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);
{
int retval;
- if (!str1)
- return str2 == Nullstr;
- if (!str2)
- return 0;
+ 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);
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 char newline = record_separator;/* (assuming >= 6 registers) */
+ register int newline = record_separator;/* (assuming >= 6 registers) */
int i;
- int bpx;
- int obpx;
+ STRLEN bpx;
+ STRLEN obpx;
register int get_paragraph;
register char *oldbp;
+ int shortbuffered;
+ if (str == &str_undef)
+ return Nullch;
if (get_paragraph = !rslen) { /* yes, that's an assignment */
newline = '\n';
oldbp = Nullch; /* remember last \n position (none) */
}
#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 <= cnt + 1) /* make sure we have the room */
- STR_GROW(str, append+cnt+2); /* (remembering cnt can be -1) */
+ if (str->str_len <= cnt + 1) { /* make sure we have the room */
+ if (cnt > 80 && str->str_len > 0) {
+ shortbuffered = cnt - str->str_len + 1;
+ cnt = str->str_len - 1;
+ }
+ 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 (;;) {
goto thats_all_folks; /* screams */ /* sed :-) */
}
+ if (shortbuffered) { /* oh well, must extend */
+ cnt = shortbuffered;
+ shortbuffered = 0;
+ if (get_paragraph && oldbp)
+ obpx = oldbp - str->str_ptr;
+ bpx = bp - str->str_ptr; /* prepare for possible relocation */
+ STR_GROW(str, str->str_len + append + cnt + 2);
+ bp = str->str_ptr + bpx; /* reconstitute our pointer */
+ if (get_paragraph && oldbp)
+ oldbp = str->str_ptr + obpx;
+ continue;
+ }
+
fp->_cnt = cnt; /* deregisterize cnt and ptr */
fp->_ptr = ptr;
i = _filbuf(fp); /* get more characters */
bpx = bp - str->str_ptr; /* prepare for possible relocation */
if (get_paragraph && oldbp)
obpx = oldbp - str->str_ptr;
+ str->str_cur = bpx;
STR_GROW(str, bpx + cnt + 2);
bp = str->str_ptr + bpx; /* reconstitute our pointer */
if (get_paragraph && oldbp)
goto screamer; /* and 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';
{
register CMD *cmd;
register ARG *arg;
- line_t oldline = line;
+ 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 (setjmp(eval_env)) {
- in_eval = 0;
+ 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");
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);
- line = oldline;
Safefree(cmd);
return arg;
}
register STR *str;
register char *t;
STR *toparse;
- int len;
+ STRLEN len;
register int brackets;
register char *d;
STAB *stab;
s+1 < send) {
str_ncat(str,t,s-t);
t = s;
- if (*s == '$' && s[1] == '#' && isalpha(s[2]) || s[2] == '_')
+ if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_'))
s++;
s = scanreg(s,send,tokenbuf);
if (*t == '@' &&
- (!(stab = stabent(tokenbuf,FALSE)) || !stab_xarray(stab)) ) {
+ (!(stab = stabent(tokenbuf,FALSE)) ||
+ (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
str_ncat(str,"@",1);
s = ++t;
continue; /* grandfather @ from old scripts */
checkpoint = s;
do {
switch (*s) {
- case '[': case '{':
+ case '[':
+ if (s[-1] != '$')
+ brackets++;
+ break;
+ case '{':
brackets++;
break;
- case ']': case '}':
+ case ']':
+ if (s[-1] != '$')
+ brackets--;
+ break;
+ case '}':
brackets--;
break;
case '\'':
else if (*d == '[' && s[-1] == ']') { /* char class? */
int weight = 2; /* let's weigh the evidence */
char seen[256];
- unsigned char uchar = 0, lastuchar;
+ unsigned char un_char = 0, last_un_char;
Zero(seen,256,char);
*--s = '\0';
weight -= 100;
}
for (d++; d < s; d++) {
- lastuchar = uchar;
- uchar = (unsigned char)*d;
+ last_un_char = un_char;
+ un_char = (unsigned char)*d;
switch (*d) {
case '&':
case '$':
- weight -= seen[uchar] * 10;
+ weight -= seen[un_char] * 10;
if (isalpha(d[1]) || isdigit(d[1]) ||
d[1] == '_') {
d = scanreg(d,s,tokenbuf);
}
break;
case '\\':
- uchar = 254;
+ un_char = 254;
if (d[1]) {
if (index("wds",d[1]))
weight += 100;
weight += 100;
break;
case '-':
- if (lastuchar < d[1] || d[1] == '\\') {
- if (index("aA01! ",lastuchar))
+ 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;
weight -= 150;
d = bufptr;
}
- if (uchar == lastuchar + 1)
+ if (un_char == last_un_char + 1)
weight += 5;
- weight -= seen[uchar];
+ weight -= seen[un_char];
break;
}
- seen[uchar]++;
+ seen[un_char]++;
}
#ifdef DEBUGGING
if (debug & 512)
register char *send;
register STR **elem;
+ if (str == &str_undef)
+ return Nullstr;
if (!(src->str_pok & SP_INTRP)) {
int oldsave = savestack->ary_fill;
(void)savehptr(&curstash);
- curstash = src->str_u.str_hash; /* so stabent knows right package */
+ curstash = curcmd->c_stash; /* so stabent knows right package */
intrpcompile(src);
restorelist(oldsave);
}
{
register char *d;
- if (!str)
+ if (!str || str == &str_undef)
return;
if (str->str_nok) {
str->str_u.str_nval += 1.0;
str_dec(str)
register STR *str;
{
- if (!str)
+ if (!str || str == &str_undef)
return;
if (str->str_nok) {
str->str_u.str_nval -= 1.0;
}
}
tmps_list[tmps_max] = str;
+ if (str->str_pok)
+ str->str_pok |= SP_TEMP;
return str;
}
str_2static(str)
register STR *str;
{
+ if (str == &str_undef)
+ return str;
if (++tmps_max > tmps_size) {
tmps_size = tmps_max;
if (!(tmps_size & 127)) {
}
}
tmps_list[tmps_max] = str;
+ if (str->str_pok)
+ str->str_pok |= SP_TEMP;
return str;
}
STR *
str_make(s,len)
char *s;
-int len;
+STRLEN len;
{
register STR *str = Str_new(79,0);
return Nullstr;
}
if (old->str_state == SS_INCR && !(old->str_pok & 2))
- str_grow(old,0);
+ Str_Grow(old,0);
if (new->str_ptr)
Safefree(new->str_ptr);
Copy(old,new,1,STR);
/* reset variables */
+ if (!stash->tbl_array)
+ return;
while (*s) {
i = *s;
if (s[1] == '-') {
aclear(stab_xarray(stab));
}
if (stab_xhash(stab)) {
- hclear(stab_xhash(stab));
+ hclear(stab_xhash(stab), FALSE);
if (stab == envstab)
environ[0] = Nullch;
}
if (debug & 2048)
fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
#endif
- if (tainted && (!euid || euid != uid)) {
+ if (tainted && (!euid || euid != uid || egid != gid)) {
if (!unsafe)
fatal("%s", s);
else if (dowarn)
register STR *envstr;
envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
- if (!envstr || envstr->str_tainted) {
+ if (envstr == &str_undef || envstr->str_tainted) {
tainted = 1;
- taintproper("Insecure PATH");
+ if (envstr->str_tainted == 2)
+ taintproper("Insecure directory in PATH");
+ else
+ taintproper("Insecure PATH");
}
envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
- if (envstr && envstr->str_tainted) {
+ if (envstr != &str_undef && envstr->str_tainted) {
tainted = 1;
taintproper("Insecure IFS");
}
projects / p5sagit/p5-mst-13.2.git / blobdiff