Home | History | Annotate | Line # | Download | only in ksh
var.c revision 1.20
      1 /*	$NetBSD: var.c,v 1.20 2017/06/30 04:41:19 kamil Exp $	*/
      2 
      3 #include <sys/cdefs.h>
      4 
      5 #ifndef lint
      6 __RCSID("$NetBSD: var.c,v 1.20 2017/06/30 04:41:19 kamil Exp $");
      7 #endif
      8 
      9 #include <sys/stat.h>
     10 #include <sys/time.h>
     11 #include <time.h>
     12 #include <ctype.h>
     13 #include <stdbool.h>
     14 
     15 #include "sh.h"
     16 #include "ksh_limval.h"
     17 
     18 /*
     19  * Variables
     20  *
     21  * WARNING: unreadable code, needs a rewrite
     22  *
     23  * if (flag&INTEGER), val.i contains integer value, and type contains base.
     24  * otherwise, (val.s + type) contains string value.
     25  * if (flag&EXPORT), val.s contains "name=value" for E-Z exporting.
     26  */
     27 static	struct tbl vtemp;
     28 static	struct table specials;
     29 static char	*formatstr	ARGS((struct tbl *vp, const char *s));
     30 static void	export		ARGS((struct tbl *vp, const char *val));
     31 static int	special		ARGS((const char *name));
     32 static void	unspecial	ARGS((const char *name));
     33 static void	getspec		ARGS((struct tbl *vp));
     34 static void	setspec		ARGS((struct tbl *vp));
     35 static void	unsetspec	ARGS((struct tbl *vp));
     36 static struct tbl *arraysearch  ARGS((struct tbl *, int));
     37 
     38 /*
     39  * create a new block for function calls and simple commands
     40  * assume caller has allocated and set up e->loc
     41  */
     42 void
     43 newblock()
     44 {
     45 	register struct block *l;
     46 	static char *const empty[] = {null};
     47 
     48 	l = (struct block *) alloc(sizeof(struct block), ATEMP);
     49 	l->flags = 0;
     50 	ainit(&l->area); /* todo: could use e->area (l->area => l->areap) */
     51 	if (!e->loc) {
     52 		l->argc = 0;
     53 		l->argv = (char **) __UNCONST(empty);
     54 	} else {
     55 		l->argc = e->loc->argc;
     56 		l->argv = e->loc->argv;
     57 	}
     58 	l->exit = l->error = NULL;
     59 	tinit(&l->vars, &l->area, 0);
     60 	tinit(&l->funs, &l->area, 0);
     61 	l->next = e->loc;
     62 	e->loc = l;
     63 }
     64 
     65 /*
     66  * pop a block handling special variables
     67  */
     68 void
     69 popblock()
     70 {
     71 	register struct block *l = e->loc;
     72 	register struct tbl *vp, **vpp = l->vars.tbls, *vq;
     73 	register int i;
     74 
     75 	e->loc = l->next;	/* pop block */
     76 	for (i = l->vars.size; --i >= 0; ) {
     77 		if ((vp = *vpp++) != NULL && (vp->flag&SPECIAL)) {
     78 			if ((vq = global(vp->name))->flag & ISSET)
     79 				setspec(vq);
     80 			else
     81 				unsetspec(vq);
     82 		}
     83 	}
     84 	if (l->flags & BF_DOGETOPTS)
     85 		user_opt = l->getopts_state;
     86 	afreeall(&l->area);
     87 	afree(l, ATEMP);
     88 }
     89 
     90 /* called by main() to initialize variable data structures */
     91 void
     92 initvar()
     93 {
     94 	static const struct {
     95 		const char *name;
     96 		int v;
     97 	} names[] = {
     98 			{ "COLUMNS",		V_COLUMNS },
     99 			{ "IFS",		V_IFS },
    100 			{ "OPTIND",		V_OPTIND },
    101 			{ "PATH",		V_PATH },
    102 			{ "POSIXLY_CORRECT",	V_POSIXLY_CORRECT },
    103 			{ "TMPDIR",		V_TMPDIR },
    104 #ifdef HISTORY
    105 			{ "HISTFILE",		V_HISTFILE },
    106 			{ "HISTSIZE",		V_HISTSIZE },
    107 #endif /* HISTORY */
    108 #ifdef EDIT
    109 			{ "EDITOR",		V_EDITOR },
    110 			{ "VISUAL",		V_VISUAL },
    111 #endif /* EDIT */
    112 #ifdef KSH
    113 			{ "MAIL",		V_MAIL },
    114 			{ "MAILCHECK",		V_MAILCHECK },
    115 			{ "MAILPATH",		V_MAILPATH },
    116 			{ "RANDOM",		V_RANDOM },
    117 			{ "SECONDS",		V_SECONDS },
    118 			{ "TMOUT",		V_TMOUT },
    119 #endif /* KSH */
    120 			{ "LINENO",		V_LINENO },
    121 			{ (char *) 0,	0 }
    122 		};
    123 	int i;
    124 	struct tbl *tp;
    125 
    126 	tinit(&specials, APERM, 32); /* must be 2^n (currently 17 specials) */
    127 	for (i = 0; names[i].name; i++) {
    128 		tp = tenter(&specials, names[i].name, hash(names[i].name));
    129 		tp->flag = DEFINED|ISSET;
    130 		tp->type = names[i].v;
    131 	}
    132 }
    133 
    134 /* Used to calculate an array index for global()/local().  Sets *arrayp to
    135  * non-zero if this is an array, sets *valp to the array index, returns
    136  * the basename of the array.
    137  */
    138 const char *array_index_calc(const char *n, bool *arrayp, int *valp);
    139 
    140 const char *
    141 array_index_calc(n, arrayp, valp)
    142 	const char *n;
    143 	bool *arrayp;
    144 	int *valp;
    145 {
    146 	const char *p;
    147 	int len;
    148 
    149 	*arrayp = false;
    150 	p = skip_varname(n, false);
    151 	if (p != n && *p == '[' && (len = array_ref_len(p))) {
    152 		char *sub, *tmp;
    153 		long rval;
    154 
    155 		/* Calculate the value of the subscript */
    156 		*arrayp = true;
    157 		tmp = str_nsave(p+1, len-2, ATEMP);
    158 		sub = substitute(tmp, 0);
    159 		afree(tmp, ATEMP);
    160 		n = str_nsave(n, p - n, ATEMP);
    161 		evaluate(sub, &rval, KSH_UNWIND_ERROR);
    162 		if (rval < 0 || rval > ARRAYMAX)
    163 			errorf("%s: subscript out of range", n);
    164 		*valp = rval;
    165 		afree(sub, ATEMP);
    166 	}
    167 	return n;
    168 }
    169 
    170 /*
    171  * Search for variable, if not found create globally.
    172  */
    173 struct tbl *
    174 global(n)
    175 	register const char *n;
    176 {
    177 	register struct block *l = e->loc;
    178 	register struct tbl *vp;
    179 	register int c;
    180 	unsigned h;
    181 	bool	 array;
    182 	int	 val;
    183 
    184 	/* Check to see if this is an array */
    185 	n = array_index_calc(n, &array, &val);
    186 	h = hash(n);
    187 	c = n[0];
    188 	if (!letter(c)) {
    189 		if (array)
    190 			errorf("bad substitution");
    191 		vp = &vtemp;
    192 		vp->flag = DEFINED;
    193 		vp->type = 0;
    194 		vp->areap = ATEMP;
    195 		*vp->name = c;
    196 		if (digit(c)) {
    197 			for (c = 0; digit(*n); n++)
    198 				c = c*10 + *n-'0';
    199 			if (c <= l->argc)
    200 				/* setstr can't fail here */
    201 				setstr(vp, l->argv[c], KSH_RETURN_ERROR);
    202 			vp->flag |= RDONLY;
    203 			return vp;
    204 		}
    205 		vp->flag |= RDONLY;
    206 		if (n[1] != '\0')
    207 			return vp;
    208 		vp->flag |= ISSET|INTEGER;
    209 		switch (c) {
    210 		  case '$':
    211 			vp->val.i = kshpid;
    212 			break;
    213 		  case '!':
    214 			/* If no job, expand to nothing */
    215 			if ((vp->val.i = j_async()) == 0)
    216 				vp->flag &= ~(ISSET|INTEGER);
    217 			break;
    218 		  case '?':
    219 			vp->val.i = exstat;
    220 			break;
    221 		  case '#':
    222 			vp->val.i = l->argc;
    223 			break;
    224 		  case '-':
    225 			vp->flag &= ~INTEGER;
    226 			vp->val.s = getoptions();
    227 			break;
    228 		  default:
    229 			vp->flag &= ~(ISSET|INTEGER);
    230 		}
    231 		return vp;
    232 	}
    233 	for (l = e->loc; ; l = l->next) {
    234 		vp = tsearch(&l->vars, n, h);
    235 		if (vp != NULL) {
    236 			if (array)
    237 				return arraysearch(vp, val);
    238 			else
    239 				return vp;
    240 		}
    241 		if (l->next == NULL)
    242 			break;
    243 	}
    244 	vp = tenter(&l->vars, n, h);
    245 	if (array)
    246 		vp = arraysearch(vp, val);
    247 	vp->flag |= DEFINED;
    248 	if (special(n))
    249 		vp->flag |= SPECIAL;
    250 	return vp;
    251 }
    252 
    253 /*
    254  * Search for local variable, if not found create locally.
    255  */
    256 struct tbl *
    257 local(n, copy)
    258 	register const char *n;
    259 	bool copy;
    260 {
    261 	register struct block *l = e->loc;
    262 	register struct tbl *vp;
    263 	unsigned h;
    264 	bool	 array;
    265 	int	 val;
    266 
    267 	/* Check to see if this is an array */
    268 	n = array_index_calc(n, &array, &val);
    269 	h = hash(n);
    270 	if (!letter(*n)) {
    271 		vp = &vtemp;
    272 		vp->flag = DEFINED|RDONLY;
    273 		vp->type = 0;
    274 		vp->areap = ATEMP;
    275 		return vp;
    276 	}
    277 	vp = tenter(&l->vars, n, h);
    278 	if (copy && !(vp->flag & DEFINED)) {
    279 		struct block *ll = l;
    280 		struct tbl *vq = (struct tbl *) 0;
    281 
    282 		while ((ll = ll->next) && !(vq = tsearch(&ll->vars, n, h)))
    283 			;
    284 		if (vq) {
    285 			vp->flag |= vq->flag & (EXPORT|INTEGER|RDONLY
    286 						|LJUST|RJUST|ZEROFIL
    287 						|LCASEV|UCASEV_AL|INT_U|INT_L);
    288 			if (vq->flag & INTEGER)
    289 				vp->type = vq->type;
    290 			vp->u2.field = vq->u2.field;
    291 		}
    292 	}
    293 	if (array)
    294 		vp = arraysearch(vp, val);
    295 	vp->flag |= DEFINED;
    296 	if (special(n))
    297 		vp->flag |= SPECIAL;
    298 	return vp;
    299 }
    300 
    301 /* get variable string value */
    302 char *
    303 str_val(vp)
    304 	register struct tbl *vp;
    305 {
    306 	char *s;
    307 
    308 	if ((vp->flag&SPECIAL))
    309 		getspec(vp);
    310 	if (!(vp->flag&ISSET))
    311 		s = null;		/* special to dollar() */
    312 	else if (!(vp->flag&INTEGER))	/* string source */
    313 		s = vp->val.s + vp->type;
    314 	else {				/* integer source */
    315 		/* worst case number length is when base=2, so use BITS(long) */
    316 			     /* minus base #     number    null */
    317 		static char strbuf[1 + 2 + 1 + BITS(long) + 1];
    318 		const char *digits = (vp->flag & UCASEV_AL) ?
    319 				  "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    320 				: "0123456789abcdefghijklmnopqrstuvwxyz";
    321 		register unsigned long n;
    322 		register int base;
    323 
    324 		s = strbuf + sizeof(strbuf);
    325 		if (vp->flag & INT_U)
    326 			n = (unsigned long) vp->val.i;
    327 		else
    328 			n = (vp->val.i < 0) ? -vp->val.i : vp->val.i;
    329 		base = (vp->type == 0) ? 10 : vp->type;
    330 
    331 		*--s = '\0';
    332 		do {
    333 			*--s = digits[n % base];
    334 			n /= base;
    335 		} while (n != 0);
    336 		if (base != 10) {
    337 			*--s = '#';
    338 			*--s = digits[base % 10];
    339 			if (base >= 10)
    340 				*--s = digits[base / 10];
    341 		}
    342 		if (!(vp->flag & INT_U) && vp->val.i < 0)
    343 			*--s = '-';
    344 		if (vp->flag & (RJUST|LJUST)) { /* case already dealt with */
    345 			s = formatstr(vp, s);
    346 			(void)strlcpy(strbuf, s, sizeof(strbuf));
    347 			afree(s, ATEMP);
    348 			s = strbuf;
    349 		}
    350 	}
    351 	return s;
    352 }
    353 
    354 /* get variable integer value, with error checking */
    355 long
    356 intval(vp)
    357 	register struct tbl *vp;
    358 {
    359 	long num;
    360 	int base;
    361 
    362 	base = getint(vp, &num);
    363 	if (base == -1)
    364 		/* XXX check calls - is error here ok by POSIX? */
    365 		errorf("%s: bad number", str_val(vp));
    366 	return num;
    367 }
    368 
    369 /* set variable to string value */
    370 int
    371 setstr(vq, s, error_ok)
    372 	register struct tbl *vq;
    373 	const char *s;
    374 	int error_ok;
    375 {
    376 	char *fs = NULL;
    377 	int no_ro_check = error_ok & 0x4;
    378 	error_ok &= ~0x4;
    379 	if ((vq->flag & RDONLY) && !no_ro_check) {
    380 		warningf(true, "%s: is read only", vq->name);
    381 		if (!error_ok)
    382 			errorf("%s", null);
    383 		return 0;
    384 	}
    385 	if (!(vq->flag&INTEGER)) { /* string dest */
    386 		if ((vq->flag&ALLOC)) {
    387 			/* debugging */
    388 			if (s >= vq->val.s
    389 			    && s <= vq->val.s + strlen(vq->val.s))
    390 				internal_errorf(true,
    391 				    "setstr: %s=%s: assigning to self",
    392 				    vq->name, s);
    393 			afree((void*)vq->val.s, vq->areap);
    394 		}
    395 		vq->flag &= ~(ISSET|ALLOC);
    396 		vq->type = 0;
    397 		if (s && (vq->flag & (UCASEV_AL|LCASEV|LJUST|RJUST)))
    398 			s = fs = formatstr(vq, s);
    399 		if ((vq->flag&EXPORT))
    400 			export(vq, s);
    401 		else {
    402 			vq->val.s = str_save(s, vq->areap);
    403 			vq->flag |= ALLOC;
    404 		}
    405 	} else			/* integer dest */
    406 		if (!v_evaluate(vq, s, error_ok))
    407 			return 0;
    408 	vq->flag |= ISSET;
    409 	if ((vq->flag&SPECIAL))
    410 		setspec(vq);
    411 	if (fs)
    412 		afree(fs, ATEMP);
    413 	return 1;
    414 }
    415 
    416 /* set variable to integer */
    417 void
    418 setint(vq, n)
    419 	register struct tbl *vq;
    420 	long n;
    421 {
    422 	if (!(vq->flag&INTEGER)) {
    423 		register struct tbl *vp = &vtemp;
    424 		vp->flag = (ISSET|INTEGER);
    425 		vp->type = 0;
    426 		vp->areap = ATEMP;
    427 		vp->val.i = n;
    428 		/* setstr can't fail here */
    429 		setstr(vq, str_val(vp), KSH_RETURN_ERROR);
    430 	} else
    431 		vq->val.i = n;
    432 	vq->flag |= ISSET;
    433 	if ((vq->flag&SPECIAL))
    434 		setspec(vq);
    435 }
    436 
    437 int
    438 getint(vp, nump)
    439 	struct tbl *vp;
    440 	long *nump;
    441 {
    442 	register char *s;
    443 	register int c;
    444 	int base, neg;
    445 	int have_base = 0;
    446 	long num;
    447 
    448 	if (vp->flag&SPECIAL)
    449 		getspec(vp);
    450 	/* XXX is it possible for ISSET to be set and val.s to be 0? */
    451 	if (!(vp->flag&ISSET) || (!(vp->flag&INTEGER) && vp->val.s == NULL))
    452 		return -1;
    453 	if (vp->flag&INTEGER) {
    454 		*nump = vp->val.i;
    455 		return vp->type;
    456 	}
    457 	s = vp->val.s + vp->type;
    458 	if (s == NULL)	/* redundant given initial test */
    459 		s = null;
    460 	base = 10;
    461 	num = 0;
    462 	neg = 0;
    463 	if (*s == '-') {
    464 		neg = 1;
    465 		s++;
    466 	}
    467 	if (s[0] == '0' && s[1] == 'x') {
    468 		base = 16;
    469 		have_base = 1;
    470 		s += 2;
    471 	}
    472 	for (c = (unsigned char)*s++; c ; c = (unsigned char)*s++) {
    473 		if (c == '#') {
    474 			base = (int) num;
    475 			if (have_base || base < 2 || base > 36)
    476 				return -1;
    477 			num = 0;
    478 			have_base = 1;
    479 		} else if (letnum(c)) {
    480 			if (isdigit(c))
    481 				c -= '0';
    482 			else if (islower(c))
    483 				c -= 'a' - 10; /* todo: assumes ascii */
    484 			else if (isupper(c))
    485 				c -= 'A' - 10; /* todo: assumes ascii */
    486 			else
    487 				c = -1; /* _: force error */
    488 			if (c < 0 || c >= base)
    489 				return -1;
    490 			num = num * base + c;
    491 		} else
    492 			return -1;
    493 	}
    494 	if (neg)
    495 		num = -num;
    496 	*nump = num;
    497 	return base;
    498 }
    499 
    500 /* convert variable vq to integer variable, setting its value from vp
    501  * (vq and vp may be the same)
    502  */
    503 struct tbl *
    504 setint_v(vq, vp)
    505 	register struct tbl *vq, *vp;
    506 {
    507 	int base;
    508 	long num;
    509 
    510 	if ((base = getint(vp, &num)) == -1)
    511 		return NULL;
    512 	if (!(vq->flag & INTEGER) && (vq->flag & ALLOC)) {
    513 		vq->flag &= ~ALLOC;
    514 		afree(vq->val.s, vq->areap);
    515 	}
    516 	vq->val.i = num;
    517 	if (vq->type == 0) /* default base */
    518 		vq->type = base;
    519 	vq->flag |= ISSET|INTEGER;
    520 	if (vq->flag&SPECIAL)
    521 		setspec(vq);
    522 	return vq;
    523 }
    524 
    525 static char *
    526 formatstr(vp, s)
    527 	struct tbl *vp;
    528 	const char *s;
    529 {
    530 	int olen, nlen;
    531 	char *p, *q;
    532 
    533 	olen = strlen(s);
    534 
    535 	if (vp->flag & (RJUST|LJUST)) {
    536 		if (!vp->u2.field)	/* default field width */
    537 			vp->u2.field = olen;
    538 		nlen = vp->u2.field;
    539 	} else
    540 		nlen = olen;
    541 
    542 	p = (char *) alloc(nlen + 1, ATEMP);
    543 	if (vp->flag & (RJUST|LJUST)) {
    544 		int slen;
    545 
    546 		if (vp->flag & RJUST) {
    547 			const char *r = s + olen;
    548 			/* strip trailing spaces (at&t ksh uses q[-1] == ' ') */
    549 			while (r > s && isspace((unsigned char)r[-1]))
    550 				--r;
    551 			slen = r - s;
    552 			if (slen > vp->u2.field) {
    553 				s += slen - vp->u2.field;
    554 				slen = vp->u2.field;
    555 			}
    556 			shf_snprintf(p, nlen + 1,
    557 				((vp->flag & ZEROFIL) && digit(*s)) ?
    558 					  "%0*s%.*s" : "%*s%.*s",
    559 				vp->u2.field - slen, null, slen, s);
    560 		} else {
    561 			/* strip leading spaces/zeros */
    562 			while (isspace((unsigned char)*s))
    563 				s++;
    564 			if (vp->flag & ZEROFIL)
    565 				while (*s == '0')
    566 					s++;
    567 			shf_snprintf(p, nlen + 1, "%-*.*s",
    568 				vp->u2.field, vp->u2.field, s);
    569 		}
    570 	} else
    571 		memcpy(p, s, olen + 1);
    572 
    573 	if (vp->flag & UCASEV_AL) {
    574 		for (q = p; *q; q++)
    575 			if (islower((unsigned char)*q))
    576 				*q = toupper((unsigned char)*q);
    577 	} else if (vp->flag & LCASEV) {
    578 		for (q = p; *q; q++)
    579 			if (isupper((unsigned char)*q))
    580 				*q = tolower((unsigned char)*q);
    581 	}
    582 
    583 	return p;
    584 }
    585 
    586 /*
    587  * make vp->val.s be "name=value" for quick exporting.
    588  */
    589 static void
    590 export(vp, val)
    591 	register struct tbl *vp;
    592 	const char *val;
    593 {
    594 	register char *xp;
    595 	char *op = (vp->flag&ALLOC) ? vp->val.s : NULL;
    596 	int namelen = strlen(vp->name);
    597 	int vallen = strlen(val) + 1;
    598 
    599 	vp->flag |= ALLOC;
    600 	xp = (char*)alloc(namelen + 1 + vallen, vp->areap);
    601 	memcpy(vp->val.s = xp, vp->name, namelen);
    602 	xp += namelen;
    603 	*xp++ = '=';
    604 	vp->type = xp - vp->val.s; /* offset to value */
    605 	memcpy(xp, val, vallen);
    606 	if (op != NULL)
    607 		afree((void*)op, vp->areap);
    608 }
    609 
    610 /*
    611  * lookup variable (according to (set&LOCAL)),
    612  * set its attributes (INTEGER, RDONLY, EXPORT, TRACE, LJUST, RJUST, ZEROFIL,
    613  * LCASEV, UCASEV_AL), and optionally set its value if an assignment.
    614  */
    615 struct tbl *
    616 typeset(var, set, clr, field, base)
    617 	register const char *var;
    618 	Tflag clr, set;
    619 	int field, base;
    620 {
    621 	register struct tbl *vp;
    622 	struct tbl *vpbase, *t;
    623 	char *tvar;
    624 	const char *val;
    625 
    626 	/* check for valid variable name, search for value */
    627 	val = skip_varname(var, false);
    628 	if (val == var)
    629 		return NULL;
    630 	if (*val == '[') {
    631 		int len;
    632 
    633 		len = array_ref_len(val);
    634 		if (len == 0)
    635 			return NULL;
    636 		/* IMPORT is only used when the shell starts up and is
    637 		 * setting up its environment.  Allow only simple array
    638 		 * references at this time since parameter/command substitution
    639 		 * is performed on the [expression], which would be a major
    640 		 * security hole.
    641 		 */
    642 		if (set & IMPORT) {
    643 			int i;
    644 			for (i = 1; i < len - 1; i++)
    645 				if (!digit(val[i]))
    646 					return NULL;
    647 		}
    648 		val += len;
    649 	}
    650 	if (*val == '=')
    651 		tvar = str_nsave(var, val++ - var, ATEMP);
    652 	else {
    653 		/* Importing from original environment: must have an = */
    654 		if (set & IMPORT)
    655 			return NULL;
    656 		tvar = (char *) __UNCONST(var);
    657 		val = NULL;
    658 	}
    659 
    660 	/* Prevent typeset from creating a local PATH/ENV/SHELL */
    661 	if (Flag(FRESTRICTED) && (strcmp(tvar, "PATH") == 0
    662 				  || strcmp(tvar, "ENV") == 0
    663 				  || strcmp(tvar, "SHELL") == 0))
    664 		errorf("%s: restricted", tvar);
    665 
    666 	vp = (set&LOCAL) ? local(tvar, (set & LOCAL_COPY) ? true : false)
    667 		: global(tvar);
    668 	set &= ~(LOCAL|LOCAL_COPY);
    669 
    670 	vpbase = (vp->flag & ARRAY) ? global(arrayname(var)) : vp;
    671 
    672 	/* only allow export flag to be set.  at&t ksh allows any attribute to
    673 	 * be changed, which means it can be truncated or modified
    674 	 * (-L/-R/-Z/-i).
    675 	 */
    676 	if ((vpbase->flag&RDONLY)
    677 	    && (val || clr || (set & ~EXPORT)))
    678 		/* XXX check calls - is error here ok by POSIX? */
    679 		errorf("%s: is read only", tvar);
    680 	if (val)
    681 		afree(tvar, ATEMP);
    682 
    683 	/* most calls are with set/clr == 0 */
    684 	if (set | clr) {
    685 		int ok = 1;
    686 		/* XXX if x[0] isn't set, there will be problems: need to have
    687 		 * one copy of attributes for arrays...
    688 		 */
    689 		for (t = vpbase; t; t = t->u.array) {
    690 			int fake_assign;
    691 			char UNINITIALIZED(*s);
    692 			char UNINITIALIZED(*free_me);
    693 
    694 			fake_assign = (t->flag & ISSET) && (!val || t != vp)
    695 				      && ((set & (UCASEV_AL|LCASEV|LJUST|RJUST|ZEROFIL))
    696 					  || ((t->flag & INTEGER) && (clr & INTEGER))
    697 					  || (!(t->flag & INTEGER) && (set & INTEGER)));
    698 			if (fake_assign) {
    699 				if (t->flag & INTEGER) {
    700 					s = str_val(t);
    701 					free_me = (char *) 0;
    702 				} else {
    703 					s = t->val.s + t->type;
    704 					free_me = (t->flag & ALLOC) ? t->val.s
    705 								  : (char *) 0;
    706 				}
    707 				t->flag &= ~ALLOC;
    708 			}
    709 			if (!(t->flag & INTEGER) && (set & INTEGER)) {
    710 				t->type = 0;
    711 				t->flag &= ~ALLOC;
    712 			}
    713 			t->flag = (t->flag | set) & ~clr;
    714 			/* Don't change base if assignment is to be done,
    715 			 * in case assignment fails.
    716 			 */
    717 			if ((set & INTEGER) && base > 0 && (!val || t != vp))
    718 				t->type = base;
    719 			if (set & (LJUST|RJUST|ZEROFIL))
    720 				t->u2.field = field;
    721 			if (fake_assign) {
    722 				if (!setstr(t, s, KSH_RETURN_ERROR)) {
    723 					/* Somewhat arbitrary action here:
    724 					 * zap contents of variable, but keep
    725 					 * the flag settings.
    726 					 */
    727 					ok = 0;
    728 					if (t->flag & INTEGER)
    729 						t->flag &= ~ISSET;
    730 					else {
    731 						if (t->flag & ALLOC)
    732 							afree((void*) t->val.s,
    733 							      t->areap);
    734 						t->flag &= ~(ISSET|ALLOC);
    735 						t->type = 0;
    736 					}
    737 				}
    738 				if (free_me)
    739 					afree((void *) free_me, t->areap);
    740 			}
    741 		}
    742 		if (!ok)
    743 		    errorf("%s", null);
    744 	}
    745 
    746 	if (val != NULL) {
    747 		if (vp->flag&INTEGER) {
    748 			/* do not zero base before assignment */
    749 			setstr(vp, val, KSH_UNWIND_ERROR | 0x4);
    750 			/* Done after assignment to override default */
    751 			if (base > 0)
    752 				vp->type = base;
    753 		} else
    754 			/* setstr can't fail (readonly check already done) */
    755 			setstr(vp, val, KSH_RETURN_ERROR | 0x4);
    756 	}
    757 
    758 	/* only x[0] is ever exported, so use vpbase */
    759 	if ((vpbase->flag&EXPORT) && !(vpbase->flag&INTEGER)
    760 	    && vpbase->type == 0)
    761 		export(vpbase, (vpbase->flag&ISSET) ? vpbase->val.s : null);
    762 
    763 	return vp;
    764 }
    765 
    766 /* Unset a variable.  array_ref is set if there was an array reference in
    767  * the name lookup (eg, x[2]).
    768  */
    769 void
    770 unset(vp, array_ref)
    771 	register struct tbl *vp;
    772 	int array_ref;
    773 {
    774 	if (vp->flag & ALLOC)
    775 		afree((void*)vp->val.s, vp->areap);
    776 	if ((vp->flag & ARRAY) && !array_ref) {
    777 		struct tbl *a, *tmp;
    778 
    779 		/* Free up entire array */
    780 		for (a = vp->u.array; a; ) {
    781 			tmp = a;
    782 			a = a->u.array;
    783 			if (tmp->flag & ALLOC)
    784 				afree((void *) tmp->val.s, tmp->areap);
    785 			afree(tmp, tmp->areap);
    786 		}
    787 		vp->u.array = (struct tbl *) 0;
    788 	}
    789 	/* If foo[0] is being unset, the remainder of the array is kept... */
    790 	vp->flag &= SPECIAL | (array_ref ? ARRAY|DEFINED : 0);
    791 	if (vp->flag & SPECIAL)
    792 		unsetspec(vp);	/* responsible for `unspecial'ing var */
    793 }
    794 
    795 /* return a pointer to the first char past a legal variable name (returns the
    796  * argument if there is no legal name, returns * a pointer to the terminating
    797  * null if whole string is legal).
    798  */
    799 char *
    800 skip_varname(s, aok)
    801 	const char *s;
    802 	int aok;
    803 {
    804 	int alen;
    805 
    806 	if (s && letter(*s)) {
    807 		while (*++s && letnum(*s))
    808 			;
    809 		if (aok && *s == '[' && (alen = array_ref_len(s)))
    810 			s += alen;
    811 	}
    812 	return (char *) __UNCONST(s);
    813 }
    814 
    815 /* Return a pointer to the first character past any legal variable name.  */
    816 char *
    817 skip_wdvarname(s, aok)
    818 	const char *s;
    819 	int aok;	/* skip array de-reference? */
    820 {
    821 	if (s[0] == CHAR && letter(s[1])) {
    822 		do
    823 			s += 2;
    824 		while (s[0] == CHAR && letnum(s[1]));
    825 		if (aok && s[0] == CHAR && s[1] == '[') {
    826 			/* skip possible array de-reference */
    827 			const char *p = s;
    828 			char c;
    829 			int depth = 0;
    830 
    831 			while (1) {
    832 				if (p[0] != CHAR)
    833 					break;
    834 				c = p[1];
    835 				p += 2;
    836 				if (c == '[')
    837 					depth++;
    838 				else if (c == ']' && --depth == 0) {
    839 					s = p;
    840 					break;
    841 				}
    842 			}
    843 		}
    844 	}
    845 	return (char *) __UNCONST(s);
    846 }
    847 
    848 /* Check if coded string s is a variable name */
    849 int
    850 is_wdvarname(s, aok)
    851 	const char *s;
    852 	int aok;
    853 {
    854 	char *p = skip_wdvarname(s, aok);
    855 
    856 	return p != s && p[0] == EOS;
    857 }
    858 
    859 /* Check if coded string s is a variable assignment */
    860 int
    861 is_wdvarassign(s)
    862 	const char *s;
    863 {
    864 	char *p = skip_wdvarname(s, true);
    865 
    866 	return p != s && p[0] == CHAR && p[1] == '=';
    867 }
    868 
    869 /*
    870  * Make the exported environment from the exported names in the dictionary.
    871  */
    872 char **
    873 makenv()
    874 {
    875 	struct block *l = e->loc;
    876 	XPtrV env;
    877 	register struct tbl *vp, **vpp;
    878 	register int i;
    879 
    880 	XPinit(env, 64);
    881 	for (l = e->loc; l != NULL; l = l->next)
    882 		for (vpp = l->vars.tbls, i = l->vars.size; --i >= 0; )
    883 			if ((vp = *vpp++) != NULL
    884 			    && (vp->flag&(ISSET|EXPORT)) == (ISSET|EXPORT)) {
    885 				register struct block *l2;
    886 				register struct tbl *vp2;
    887 				unsigned h = hash(vp->name);
    888 
    889 				/* unexport any redefined instances */
    890 				for (l2 = l->next; l2 != NULL; l2 = l2->next) {
    891 					vp2 = tsearch(&l2->vars, vp->name, h);
    892 					if (vp2 != NULL)
    893 						vp2->flag &= ~EXPORT;
    894 				}
    895 				if ((vp->flag&INTEGER)) {
    896 					/* integer to string */
    897 					char *val;
    898 					val = str_val(vp);
    899 					vp->flag &= ~(INTEGER|RDONLY);
    900 					/* setstr can't fail here */
    901 					setstr(vp, val, KSH_RETURN_ERROR);
    902 				}
    903 				XPput(env, vp->val.s);
    904 			}
    905 	XPput(env, NULL);
    906 	return (char **) XPclose(env);
    907 }
    908 
    909 /*
    910  * Called after a fork in parent to bump the random number generator.
    911  * Done to ensure children will not get the same random number sequence
    912  * if the parent doesn't use $RANDOM.
    913  */
    914 void
    915 change_random()
    916 {
    917     rand();
    918 }
    919 
    920 /*
    921  * handle special variables with side effects - PATH, SECONDS.
    922  */
    923 
    924 /* Test if name is a special parameter */
    925 static int
    926 special(name)
    927 	register const char * name;
    928 {
    929 	register struct tbl *tp;
    930 
    931 	tp = tsearch(&specials, name, hash(name));
    932 	return tp && (tp->flag & ISSET) ? tp->type : V_NONE;
    933 }
    934 
    935 /* Make a variable non-special */
    936 static void
    937 unspecial(name)
    938 	register const char * name;
    939 {
    940 	register struct tbl *tp;
    941 
    942 	tp = tsearch(&specials, name, hash(name));
    943 	if (tp)
    944 		tdelete(tp);
    945 }
    946 
    947 #ifdef KSH
    948 static	time_t	seconds;		/* time SECONDS last set */
    949 #endif /* KSH */
    950 static	int	user_lineno;		/* what user set $LINENO to */
    951 
    952 static void
    953 getspec(vp)
    954 	register struct tbl *vp;
    955 {
    956 	switch (special(vp->name)) {
    957 #ifdef KSH
    958 	  case V_SECONDS:
    959 		vp->flag &= ~SPECIAL;
    960 		/* On start up the value of SECONDS is used before seconds
    961 		 * has been set - don't do anything in this case
    962 		 * (see initcoms[] in main.c).
    963 		 */
    964 		if (vp->flag & ISSET)
    965 			setint(vp, (long) (time((time_t *)0) - seconds));
    966 		vp->flag |= SPECIAL;
    967 		break;
    968 	  case V_RANDOM:
    969 		vp->flag &= ~SPECIAL;
    970 		setint(vp, (long) (rand() & 0x7fff));
    971 		vp->flag |= SPECIAL;
    972 		break;
    973 #endif /* KSH */
    974 #ifdef HISTORY
    975 	  case V_HISTSIZE:
    976 		vp->flag &= ~SPECIAL;
    977 		setint(vp, (long) histsize);
    978 		vp->flag |= SPECIAL;
    979 		break;
    980 #endif /* HISTORY */
    981 	  case V_OPTIND:
    982 		vp->flag &= ~SPECIAL;
    983 		setint(vp, (long) user_opt.uoptind);
    984 		vp->flag |= SPECIAL;
    985 		break;
    986 	  case V_LINENO:
    987 		vp->flag &= ~SPECIAL;
    988 		setint(vp, (long) current_lineno + user_lineno);
    989 		vp->flag |= SPECIAL;
    990 		break;
    991 	}
    992 }
    993 
    994 static void
    995 setspec(vp)
    996 	register struct tbl *vp;
    997 {
    998 	char *s;
    999 
   1000 	switch (special(vp->name)) {
   1001 	  case V_PATH:
   1002 		if (path)
   1003 			afree(path, APERM);
   1004 		path = str_save(str_val(vp), APERM);
   1005 		flushcom(1);	/* clear tracked aliases */
   1006 		break;
   1007 	  case V_IFS:
   1008 		setctypes(s = str_val(vp), C_IFS);
   1009 		ifs0 = *s;
   1010 		break;
   1011 	  case V_OPTIND:
   1012 		vp->flag &= ~SPECIAL;
   1013 		getopts_reset((int) intval(vp));
   1014 		vp->flag |= SPECIAL;
   1015 		break;
   1016 	  case V_POSIXLY_CORRECT:
   1017 		change_flag(FPOSIX, OF_SPECIAL, 1);
   1018 		break;
   1019 	  case V_TMPDIR:
   1020 		if (tmpdir) {
   1021 			afree(tmpdir, APERM);
   1022 			tmpdir = (char *) 0;
   1023 		}
   1024 		/* Use tmpdir iff it is an absolute path, is writable and
   1025 		 * searchable and is a directory...
   1026 		 */
   1027 		{
   1028 			struct stat statb;
   1029 			s = str_val(vp);
   1030 			if (ISABSPATH(s) && eaccess(s, W_OK|X_OK) == 0
   1031 			    && stat(s, &statb) == 0 && S_ISDIR(statb.st_mode))
   1032 				tmpdir = str_save(s, APERM);
   1033 		}
   1034 		break;
   1035 #ifdef HISTORY
   1036 	  case V_HISTSIZE:
   1037 		vp->flag &= ~SPECIAL;
   1038 		sethistsize((int) intval(vp));
   1039 		vp->flag |= SPECIAL;
   1040 		break;
   1041 	  case V_HISTFILE:
   1042 		sethistfile(str_val(vp));
   1043 		break;
   1044 #endif /* HISTORY */
   1045 #ifdef EDIT
   1046 	  case V_VISUAL:
   1047 		set_editmode(str_val(vp));
   1048 		break;
   1049 	  case V_EDITOR:
   1050 		if (!(global("VISUAL")->flag & ISSET))
   1051 			set_editmode(str_val(vp));
   1052 		break;
   1053 	  case V_COLUMNS:
   1054 		if ((x_cols = intval(vp)) <= MIN_COLS)
   1055 			x_cols = MIN_COLS;
   1056 		break;
   1057 #endif /* EDIT */
   1058 #ifdef KSH
   1059 	  case V_MAIL:
   1060 		mbset(str_val(vp));
   1061 		break;
   1062 	  case V_MAILPATH:
   1063 		mpset(str_val(vp));
   1064 		break;
   1065 	  case V_MAILCHECK:
   1066 		vp->flag &= ~SPECIAL;
   1067 		mcset(intval(vp));
   1068 		vp->flag |= SPECIAL;
   1069 		break;
   1070 	  case V_RANDOM:
   1071 		vp->flag &= ~SPECIAL;
   1072 		srand((unsigned int)intval(vp));
   1073 		vp->flag |= SPECIAL;
   1074 		break;
   1075 	  case V_SECONDS:
   1076 		vp->flag &= ~SPECIAL;
   1077 		seconds = time((time_t*) 0) - intval(vp);
   1078 		vp->flag |= SPECIAL;
   1079 		break;
   1080 	  case V_TMOUT:
   1081 		/* at&t ksh seems to do this (only listen if integer) */
   1082 		if (vp->flag & INTEGER)
   1083 			ksh_tmout = vp->val.i >= 0 ? vp->val.i : 0;
   1084 		break;
   1085 #endif /* KSH */
   1086 	  case V_LINENO:
   1087 		vp->flag &= ~SPECIAL;
   1088 		/* The -1 is because line numbering starts at 1. */
   1089 		user_lineno = (unsigned int) intval(vp) - current_lineno - 1;
   1090 		vp->flag |= SPECIAL;
   1091 		break;
   1092 	}
   1093 }
   1094 
   1095 static void
   1096 unsetspec(vp)
   1097 	register struct tbl *vp;
   1098 {
   1099 	switch (special(vp->name)) {
   1100 	  case V_PATH:
   1101 		if (path)
   1102 			afree(path, APERM);
   1103 		path = str_save(def_path, APERM);
   1104 		flushcom(1);	/* clear tracked aliases */
   1105 		break;
   1106 	  case V_IFS:
   1107 		setctypes(" \t\n", C_IFS);
   1108 		ifs0 = ' ';
   1109 		break;
   1110 	  case V_TMPDIR:
   1111 		/* should not become unspecial */
   1112 		if (tmpdir) {
   1113 			afree(tmpdir, APERM);
   1114 			tmpdir = (char *) 0;
   1115 		}
   1116 		break;
   1117 #ifdef KSH
   1118 	  case V_MAIL:
   1119 		mbset((char *) 0);
   1120 		break;
   1121 	  case V_MAILPATH:
   1122 		mpset((char *) 0);
   1123 		break;
   1124 #endif /* KSH */
   1125 
   1126 	  case V_LINENO:
   1127 #ifdef KSH
   1128 	  case V_MAILCHECK:	/* at&t ksh leaves previous value in place */
   1129 	  case V_RANDOM:
   1130 	  case V_SECONDS:
   1131 	  case V_TMOUT:		/* at&t ksh leaves previous value in place */
   1132 #endif /* KSH */
   1133 		unspecial(vp->name);
   1134 		break;
   1135 
   1136 	  /* at&t ksh man page says OPTIND, OPTARG and _ lose special meaning,
   1137 	   * but OPTARG does not (still set by getopts) and _ is also still
   1138 	   * set in various places.
   1139 	   * Don't know what at&t does for:
   1140 	   *		MAIL, MAILPATH, HISTSIZE, HISTFILE,
   1141 	   * Unsetting these in at&t ksh does not loose the `specialness':
   1142 	   *    no effect: IFS, COLUMNS, PATH, TMPDIR,
   1143 	   *		VISUAL, EDITOR,
   1144 	   * pdkshisms: no effect:
   1145 	   *		POSIXLY_CORRECT (use set +o posix instead)
   1146 	   */
   1147 	}
   1148 }
   1149 
   1150 /*
   1151  * Search for (and possibly create) a table entry starting with
   1152  * vp, indexed by val.
   1153  */
   1154 static struct tbl *
   1155 arraysearch(vp, val)
   1156 	struct tbl *vp;
   1157 	int val;
   1158 {
   1159 	struct tbl *prev, *curr, *new;
   1160 	size_t namelen = strlen(vp->name) + 1;
   1161 
   1162 	vp->flag |= ARRAY|DEFINED;
   1163 
   1164 	/* The table entry is always [0] */
   1165 	if (val == 0) {
   1166 		vp->index = 0;
   1167 		return vp;
   1168 	}
   1169 	prev = vp;
   1170 	curr = vp->u.array;
   1171 	while (curr && curr->index < val) {
   1172 		prev = curr;
   1173 		curr = curr->u.array;
   1174 	}
   1175 	if (curr && curr->index == val) {
   1176 		if (curr->flag&ISSET)
   1177 			return curr;
   1178 		else
   1179 			new = curr;
   1180 	} else
   1181 		new = (struct tbl *)alloc(sizeof(struct tbl) + namelen,
   1182 		    vp->areap);
   1183 	strlcpy(new->name, vp->name, namelen);
   1184 	new->flag = vp->flag & ~(ALLOC|DEFINED|ISSET|SPECIAL);
   1185 	new->type = vp->type;
   1186 	new->areap = vp->areap;
   1187 	new->u2.field = vp->u2.field;
   1188 	new->index = val;
   1189 	if (curr != new) {		/* not reusing old array entry */
   1190 		prev->u.array = new;
   1191 		new->u.array = curr;
   1192 	}
   1193 	return new;
   1194 }
   1195 
   1196 /* Return the length of an array reference (eg, [1+2]) - cp is assumed
   1197  * to point to the open bracket.  Returns 0 if there is no matching closing
   1198  * bracket.
   1199  */
   1200 int
   1201 array_ref_len(cp)
   1202 	const char *cp;
   1203 {
   1204 	const char *s = cp;
   1205 	int c;
   1206 	int depth = 0;
   1207 
   1208 	while ((c = *s++) && (c != ']' || --depth))
   1209 		if (c == '[')
   1210 			depth++;
   1211 	if (!c)
   1212 		return 0;
   1213 	return s - cp;
   1214 }
   1215 
   1216 /*
   1217  * Make a copy of the base of an array name
   1218  */
   1219 char *
   1220 arrayname(str)
   1221 	const char *str;
   1222 {
   1223 	const char *p;
   1224 
   1225 	if ((p = strchr(str, '[')) == 0)
   1226 		/* Shouldn't happen, but why worry? */
   1227 		return (char *) __UNCONST(str);
   1228 
   1229 	return str_nsave(str, p - str, ATEMP);
   1230 }
   1231 
   1232 /* Set (or overwrite, if !reset) the array variable var to the values in vals.
   1233  */
   1234 void
   1235 set_array(var, reset, vals)
   1236 	const char *var;
   1237 	int reset;
   1238 	char **vals;
   1239 {
   1240 	struct tbl *vp, *vq;
   1241 	int i;
   1242 
   1243 	/* to get local array, use "typeset foo; set -A foo" */
   1244 	vp = global(var);
   1245 
   1246 	/* Note: at&t ksh allows set -A but not set +A of a read-only var */
   1247 	if ((vp->flag&RDONLY))
   1248 		errorf("%s: is read only", var);
   1249 	/* This code is quite non-optimal */
   1250 	if (reset > 0)
   1251 		/* trash existing values and attributes */
   1252 		unset(vp, 0);
   1253 	/* todo: would be nice for assignment to completely succeed or
   1254 	 * completely fail.  Only really effects integer arrays:
   1255 	 * evaluation of some of vals[] may fail...
   1256 	 */
   1257 	for (i = 0; vals[i]; i++) {
   1258 		vq = arraysearch(vp, i);
   1259 		/* would be nice to deal with errors here... (see above) */
   1260 		setstr(vq, vals[i], KSH_RETURN_ERROR);
   1261 	}
   1262 }
   1263