1/*-
2 * Copyright (c) 1991, 1993
3 *	The Regents of the University of California.  All rights reserved.
4 * Copyright (c) 1997-2005
5 *	Herbert Xu <herbert@gondor.apana.org.au>.  All rights reserved.
6 *
7 * This code is derived from software contributed to Berkeley by
8 * Kenneth Almquist.
9 *
10 * Redistribution and use in source and binary forms, with or without
11 * modification, are permitted provided that the following conditions
12 * are met:
13 * 1. Redistributions of source code must retain the above copyright
14 *    notice, this list of conditions and the following disclaimer.
15 * 2. Redistributions in binary form must reproduce the above copyright
16 *    notice, this list of conditions and the following disclaimer in the
17 *    documentation and/or other materials provided with the distribution.
18 * 3. Neither the name of the University nor the names of its contributors
19 *    may be used to endorse or promote products derived from this software
20 *    without specific prior written permission.
21 *
22 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
23 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
26 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
28 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
29 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
31 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
32 * SUCH DAMAGE.
33 */
34
35#include <sys/types.h>
36#include <sys/time.h>
37#include <sys/stat.h>
38#include <dirent.h>
39#include <unistd.h>
40#ifdef HAVE_GETPWNAM
41#include <pwd.h>
42#endif
43#include <stdlib.h>
44#include <stdio.h>
45#include <inttypes.h>
46#include <limits.h>
47#include <string.h>
48#include <fnmatch.h>
49#ifdef HAVE_GLOB
50#include <glob.h>
51#endif
52#include <ctype.h>
53#include <stdbool.h>
54
55/*
56 * Routines to expand arguments to commands.  We have to deal with
57 * backquotes, shell variables, and file metacharacters.
58 */
59
60#include "shell.h"
61#include "main.h"
62#include "nodes.h"
63#include "eval.h"
64#include "expand.h"
65#include "syntax.h"
66#include "parser.h"
67#include "jobs.h"
68#include "options.h"
69#include "var.h"
70#include "output.h"
71#include "memalloc.h"
72#include "error.h"
73#include "mystring.h"
74#include "show.h"
75#include "system.h"
76
77/*
78 * _rmescape() flags
79 */
80#define RMESCAPE_ALLOC	0x1	/* Allocate a new string */
81#define RMESCAPE_GLOB	0x2	/* Add backslashes for glob */
82#define RMESCAPE_GROW	0x8	/* Grow strings instead of stalloc */
83#define RMESCAPE_HEAP	0x10	/* Malloc strings instead of stalloc */
84
85/* Add CTLESC when necessary. */
86#define QUOTES_ESC	(EXP_FULL | EXP_CASE | EXP_QPAT)
87/* Do not skip NUL characters. */
88#define QUOTES_KEEPNUL	EXP_TILDE
89
90/*
91 * Structure specifying which parts of the string should be searched
92 * for IFS characters.
93 */
94
95struct ifsregion {
96	struct ifsregion *next;	/* next region in list */
97	int begoff;		/* offset of start of region */
98	int endoff;		/* offset of end of region */
99	int nulonly;		/* search for nul bytes only */
100};
101
102/* output of current string */
103static char *expdest;
104/* list of back quote expressions */
105static struct nodelist *argbackq;
106/* first struct in list of ifs regions */
107static struct ifsregion ifsfirst;
108/* last struct in list */
109static struct ifsregion *ifslastp;
110/* holds expanded arg list */
111static struct arglist exparg;
112
113STATIC void argstr(char *, int);
114STATIC char *exptilde(char *, char *, int);
115STATIC void expbackq(union node *, int);
116STATIC const char *subevalvar(char *, char *, int, int, int, int, int);
117STATIC char *evalvar(char *, int);
118STATIC size_t strtodest(const char *, const char *, int);
119STATIC void memtodest(const char *, size_t, const char *, int);
120STATIC ssize_t varvalue(char *, int, int, int *);
121STATIC void expandmeta(struct strlist *, int);
122#ifdef HAVE_GLOB
123STATIC void addglob(const glob_t *);
124#else
125STATIC void expmeta(char *, char *);
126STATIC struct strlist *expsort(struct strlist *);
127STATIC struct strlist *msort(struct strlist *, int);
128#endif
129STATIC void addfname(char *);
130STATIC int patmatch(char *, const char *);
131#ifndef HAVE_FNMATCH
132STATIC int pmatch(const char *, const char *);
133#else
134#define pmatch(a, b) !fnmatch((a), (b), 0)
135#endif
136STATIC int cvtnum(intmax_t);
137STATIC size_t esclen(const char *, const char *);
138STATIC char *scanleft(char *, char *, char *, char *, int, int);
139STATIC char *scanright(char *, char *, char *, char *, int, int);
140STATIC void varunset(const char *, const char *, const char *, int)
141	__attribute__((__noreturn__));
142
143
144/*
145 * Prepare a pattern for a glob(3) call.
146 *
147 * Returns an stalloced string.
148 */
149
150STATIC inline char *
151preglob(const char *pattern, int flag) {
152	flag |= RMESCAPE_GLOB;
153	return _rmescapes((char *)pattern, flag);
154}
155
156
157STATIC size_t
158esclen(const char *start, const char *p) {
159	size_t esc = 0;
160
161	while (p > start && *--p == (char)CTLESC) {
162		esc++;
163	}
164	return esc;
165}
166
167
168static inline const char *getpwhome(const char *name)
169{
170#ifdef HAVE_GETPWNAM
171	struct passwd *pw = getpwnam(name);
172	return pw ? pw->pw_dir : 0;
173#else
174	return 0;
175#endif
176}
177
178
179/*
180 * Perform variable substitution and command substitution on an argument,
181 * placing the resulting list of arguments in arglist.  If EXP_FULL is true,
182 * perform splitting and file name expansion.  When arglist is NULL, perform
183 * here document expansion.
184 */
185
186void
187expandarg(union node *arg, struct arglist *arglist, int flag)
188{
189	struct strlist *sp;
190	char *p;
191
192	argbackq = arg->narg.backquote;
193	STARTSTACKSTR(expdest);
194	argstr(arg->narg.text, flag);
195	p = _STPUTC('\0', expdest);
196	expdest = p - 1;
197	if (arglist == NULL) {
198		/* here document expanded */
199		goto out;
200	}
201	p = grabstackstr(p);
202	exparg.lastp = &exparg.list;
203	/*
204	 * TODO - EXP_REDIR
205	 */
206	if (flag & EXP_FULL) {
207		ifsbreakup(p, -1, &exparg);
208		*exparg.lastp = NULL;
209		exparg.lastp = &exparg.list;
210		expandmeta(exparg.list, flag);
211	} else {
212		sp = (struct strlist *)stalloc(sizeof (struct strlist));
213		sp->text = p;
214		*exparg.lastp = sp;
215		exparg.lastp = &sp->next;
216	}
217	*exparg.lastp = NULL;
218	if (exparg.list) {
219		*arglist->lastp = exparg.list;
220		arglist->lastp = exparg.lastp;
221	}
222
223out:
224	ifsfree();
225}
226
227
228
229/*
230 * Perform variable and command substitution.  If EXP_FULL is set, output CTLESC
231 * characters to allow for further processing.  Otherwise treat
232 * $@ like $* since no splitting will be performed.
233 */
234
235STATIC void
236argstr(char *p, int flag)
237{
238	static const char spclchars[] = {
239		'=',
240		':',
241		CTLQUOTEMARK,
242		CTLENDVAR,
243		CTLESC,
244		CTLVAR,
245		CTLBACKQ,
246		CTLENDARI,
247		0
248	};
249	const char *reject = spclchars;
250	int c;
251	int breakall = (flag & (EXP_WORD | EXP_QUOTED)) == EXP_WORD;
252	int inquotes;
253	size_t length;
254	int startloc;
255
256	if (!(flag & EXP_VARTILDE)) {
257		reject += 2;
258	} else if (flag & EXP_VARTILDE2) {
259		reject++;
260	}
261	inquotes = 0;
262	length = 0;
263	if (flag & EXP_TILDE) {
264		char *q;
265
266		flag &= ~EXP_TILDE;
267tilde:
268		q = p;
269		if (*q == '~')
270			p = exptilde(p, q, flag);
271	}
272start:
273	startloc = expdest - (char *)stackblock();
274	for (;;) {
275		length += strcspn(p + length, reject);
276		c = (signed char)p[length];
277		if (c && (!(c & 0x80) || c == CTLENDARI)) {
278			/* c == '=' || c == ':' || c == CTLENDARI */
279			length++;
280		}
281		if (length > 0) {
282			int newloc;
283			expdest = stnputs(p, length, expdest);
284			newloc = expdest - (char *)stackblock();
285			if (breakall && !inquotes && newloc > startloc) {
286				recordregion(startloc, newloc, 0);
287			}
288			startloc = newloc;
289		}
290		p += length + 1;
291		length = 0;
292
293		switch (c) {
294		case '\0':
295			goto breakloop;
296		case '=':
297			if (flag & EXP_VARTILDE2) {
298				p--;
299				continue;
300			}
301			flag |= EXP_VARTILDE2;
302			reject++;
303			/* fall through */
304		case ':':
305			/*
306			 * sort of a hack - expand tildes in variable
307			 * assignments (after the first '=' and after ':'s).
308			 */
309			if (*--p == '~') {
310				goto tilde;
311			}
312			continue;
313		}
314
315		switch (c) {
316		case CTLENDVAR: /* ??? */
317			goto breakloop;
318		case CTLQUOTEMARK:
319			inquotes ^= EXP_QUOTED;
320			/* "$@" syntax adherence hack */
321			if (inquotes && !memcmp(p, dolatstr + 1,
322						DOLATSTRLEN - 1)) {
323				p = evalvar(p + 1, flag | inquotes) + 1;
324				goto start;
325			}
326addquote:
327			if (flag & QUOTES_ESC) {
328				p--;
329				length++;
330				startloc++;
331			}
332			break;
333		case CTLESC:
334			startloc++;
335			length++;
336
337			/*
338			 * Quoted parameter expansion pattern: remove quote
339			 * unless inside inner quotes or we have a literal
340			 * backslash.
341			 */
342			if (((flag | inquotes) & (EXP_QPAT | EXP_QUOTED)) ==
343			    EXP_QPAT && *p != '\\')
344				break;
345
346			goto addquote;
347		case CTLVAR:
348			p = evalvar(p, flag | inquotes);
349			goto start;
350		case CTLBACKQ:
351			expbackq(argbackq->n, flag | inquotes);
352			argbackq = argbackq->next;
353			goto start;
354		case CTLENDARI:
355			p--;
356			expari(flag | inquotes);
357			goto start;
358		}
359	}
360breakloop:
361	;
362}
363
364STATIC char *
365exptilde(char *startp, char *p, int flag)
366{
367	signed char c;
368	char *name;
369	const char *home;
370	int quotes = flag & QUOTES_ESC;
371
372	name = p + 1;
373
374	while ((c = *++p) != '\0') {
375		switch(c) {
376		case CTLESC:
377			return (startp);
378		case CTLQUOTEMARK:
379			return (startp);
380		case ':':
381			if (flag & EXP_VARTILDE)
382				goto done;
383			break;
384		case '/':
385		case CTLENDVAR:
386			goto done;
387		}
388	}
389done:
390	*p = '\0';
391	if (*name == '\0') {
392		home = lookupvar(homestr);
393	} else {
394		home = getpwhome(name);
395	}
396	if (!home || !*home)
397		goto lose;
398	*p = c;
399	strtodest(home, SQSYNTAX, quotes);
400	return (p);
401lose:
402	*p = c;
403	return (startp);
404}
405
406
407void
408removerecordregions(int endoff)
409{
410	if (ifslastp == NULL)
411		return;
412
413	if (ifsfirst.endoff > endoff) {
414		while (ifsfirst.next != NULL) {
415			struct ifsregion *ifsp;
416			INTOFF;
417			ifsp = ifsfirst.next->next;
418			ckfree(ifsfirst.next);
419			ifsfirst.next = ifsp;
420			INTON;
421		}
422		if (ifsfirst.begoff > endoff)
423			ifslastp = NULL;
424		else {
425			ifslastp = &ifsfirst;
426			ifsfirst.endoff = endoff;
427		}
428		return;
429	}
430
431	ifslastp = &ifsfirst;
432	while (ifslastp->next && ifslastp->next->begoff < endoff)
433		ifslastp=ifslastp->next;
434	while (ifslastp->next != NULL) {
435		struct ifsregion *ifsp;
436		INTOFF;
437		ifsp = ifslastp->next->next;
438		ckfree(ifslastp->next);
439		ifslastp->next = ifsp;
440		INTON;
441	}
442	if (ifslastp->endoff > endoff)
443		ifslastp->endoff = endoff;
444}
445
446
447/*
448 * Expand arithmetic expression.  Backup to start of expression,
449 * evaluate, place result in (backed up) result, adjust string position.
450 */
451void
452expari(int flag)
453{
454	struct stackmark sm;
455	char *p, *start;
456	int begoff;
457	int len;
458	intmax_t result;
459
460	/*	ifsfree(); */
461
462	/*
463	 * This routine is slightly over-complicated for
464	 * efficiency.  Next we scan backwards looking for the
465	 * start of arithmetic.
466	 */
467	start = stackblock();
468	p = expdest;
469	pushstackmark(&sm, p - start);
470	*--p = '\0';
471	p--;
472	do {
473		int esc;
474
475		while (*p != (char)CTLARI) {
476			p--;
477#ifdef DEBUG
478			if (p < start) {
479				sh_error("missing CTLARI (shouldn't happen)");
480			}
481#endif
482		}
483
484		esc = esclen(start, p);
485		if (!(esc % 2)) {
486			break;
487		}
488
489		p -= esc + 1;
490	} while (1);
491
492	begoff = p - start;
493
494	removerecordregions(begoff);
495
496	expdest = p;
497
498	if (likely(flag & QUOTES_ESC))
499		rmescapes(p + 1);
500
501	result = arith(p + 1);
502	popstackmark(&sm);
503
504	len = cvtnum(result);
505
506	if (likely(!(flag & EXP_QUOTED)))
507		recordregion(begoff, begoff + len, 0);
508}
509
510
511/*
512 * Expand stuff in backwards quotes.
513 */
514
515STATIC void
516expbackq(union node *cmd, int flag)
517{
518	struct backcmd in;
519	int i;
520	char buf[128];
521	char *p;
522	char *dest;
523	int startloc;
524	char const *syntax = flag & EXP_QUOTED ? DQSYNTAX : BASESYNTAX;
525	struct stackmark smark;
526
527	INTOFF;
528	startloc = expdest - (char *)stackblock();
529	pushstackmark(&smark, startloc);
530	evalbackcmd(cmd, (struct backcmd *) &in);
531	popstackmark(&smark);
532
533	p = in.buf;
534	i = in.nleft;
535	if (i == 0)
536		goto read;
537	for (;;) {
538		memtodest(p, i, syntax, flag & QUOTES_ESC);
539read:
540		if (in.fd < 0)
541			break;
542		do {
543			i = read(in.fd, buf, sizeof buf);
544		} while (i < 0 && errno == EINTR);
545		TRACE(("expbackq: read returns %d\n", i));
546		if (i <= 0)
547			break;
548		p = buf;
549	}
550
551	if (in.buf)
552		ckfree(in.buf);
553	if (in.fd >= 0) {
554		close(in.fd);
555		back_exitstatus = waitforjob(in.jp);
556	}
557	INTON;
558
559	/* Eat all trailing newlines */
560	dest = expdest;
561	for (; dest > (char *)stackblock() && dest[-1] == '\n';)
562		STUNPUTC(dest);
563	expdest = dest;
564
565	if (!(flag & EXP_QUOTED))
566		recordregion(startloc, dest - (char *)stackblock(), 0);
567	TRACE(("evalbackq: size=%d: \"%.*s\"\n",
568		(dest - (char *)stackblock()) - startloc,
569		(dest - (char *)stackblock()) - startloc,
570		stackblock() + startloc));
571}
572
573
574STATIC char *
575scanleft(
576	char *startp, char *rmesc, char *rmescend, char *str, int quotes,
577	int zero
578) {
579	char *loc;
580	char *loc2;
581	char c;
582
583	loc = startp;
584	loc2 = rmesc;
585	do {
586		int match;
587		const char *s = loc2;
588		c = *loc2;
589		if (zero) {
590			*loc2 = '\0';
591			s = rmesc;
592		}
593		match = pmatch(str, s);
594		*loc2 = c;
595		if (match)
596			return loc;
597		if (quotes && *loc == (char)CTLESC)
598			loc++;
599		loc++;
600		loc2++;
601	} while (c);
602	return 0;
603}
604
605
606STATIC char *
607scanright(
608	char *startp, char *rmesc, char *rmescend, char *str, int quotes,
609	int zero
610) {
611	int esc = 0;
612	char *loc;
613	char *loc2;
614
615	for (loc = str - 1, loc2 = rmescend; loc >= startp; loc2--) {
616		int match;
617		char c = *loc2;
618		const char *s = loc2;
619		if (zero) {
620			*loc2 = '\0';
621			s = rmesc;
622		}
623		match = pmatch(str, s);
624		*loc2 = c;
625		if (match)
626			return loc;
627		loc--;
628		if (quotes) {
629			if (--esc < 0) {
630				esc = esclen(startp, loc);
631			}
632			if (esc % 2) {
633				esc--;
634				loc--;
635			}
636		}
637	}
638	return 0;
639}
640
641STATIC const char *
642subevalvar(char *p, char *str, int strloc, int subtype, int startloc, int varflags, int flag)
643{
644	int quotes = flag & QUOTES_ESC;
645	char *startp;
646	char *loc;
647	struct nodelist *saveargbackq = argbackq;
648	int amount;
649	char *rmesc, *rmescend;
650	int zero;
651	char *(*scan)(char *, char *, char *, char *, int , int);
652
653	argstr(p, EXP_TILDE | (subtype != VSASSIGN && subtype != VSQUESTION ?
654			       (flag & (EXP_QUOTED | EXP_QPAT) ?
655			        EXP_QPAT : EXP_CASE) : 0));
656	STPUTC('\0', expdest);
657	argbackq = saveargbackq;
658	startp = stackblock() + startloc;
659
660	switch (subtype) {
661	case VSASSIGN:
662		setvar(str, startp, 0);
663		amount = startp - expdest;
664		STADJUST(amount, expdest);
665		return startp;
666
667	case VSQUESTION:
668		varunset(p, str, startp, varflags);
669		/* NOTREACHED */
670	}
671
672	subtype -= VSTRIMRIGHT;
673#ifdef DEBUG
674	if (subtype < 0 || subtype > 3)
675		abort();
676#endif
677
678	rmesc = startp;
679	rmescend = stackblock() + strloc;
680	if (quotes) {
681		rmesc = _rmescapes(startp, RMESCAPE_ALLOC | RMESCAPE_GROW);
682		if (rmesc != startp) {
683			rmescend = expdest;
684			startp = stackblock() + startloc;
685		}
686	}
687	rmescend--;
688	str = stackblock() + strloc;
689	preglob(str, 0);
690
691	/* zero = subtype == VSTRIMLEFT || subtype == VSTRIMLEFTMAX */
692	zero = subtype >> 1;
693	/* VSTRIMLEFT/VSTRIMRIGHTMAX -> scanleft */
694	scan = (subtype & 1) ^ zero ? scanleft : scanright;
695
696	loc = scan(startp, rmesc, rmescend, str, quotes, zero);
697	if (loc) {
698		if (zero) {
699			memmove(startp, loc, str - loc);
700			loc = startp + (str - loc) - 1;
701		}
702		*loc = '\0';
703		amount = loc - expdest;
704		STADJUST(amount, expdest);
705	}
706	return loc;
707}
708
709
710/*
711 * Expand a variable, and return a pointer to the next character in the
712 * input string.
713 */
714STATIC char *
715evalvar(char *p, int flag)
716{
717	int subtype;
718	int varflags;
719	char *var;
720	int patloc;
721	int c;
722	int startloc;
723	ssize_t varlen;
724	int easy;
725	int quoted;
726
727	varflags = *p++;
728	subtype = varflags & VSTYPE;
729
730	if (!subtype)
731		sh_error("Bad substitution");
732
733	quoted = flag & EXP_QUOTED;
734	var = p;
735	easy = (!quoted || (*var == '@' && shellparam.nparam));
736	startloc = expdest - (char *)stackblock();
737	p = strchr(p, '=') + 1;
738
739again:
740	varlen = varvalue(var, varflags, flag, &quoted);
741	if (varflags & VSNUL)
742		varlen--;
743
744	if (subtype == VSPLUS) {
745		varlen = -1 - varlen;
746		goto vsplus;
747	}
748
749	if (subtype == VSMINUS) {
750vsplus:
751		if (varlen < 0) {
752			argstr(p, flag | EXP_TILDE | EXP_WORD);
753			goto end;
754		}
755		goto record;
756	}
757
758	if (subtype == VSASSIGN || subtype == VSQUESTION) {
759		if (varlen >= 0)
760			goto record;
761
762		subevalvar(p, var, 0, subtype, startloc, varflags,
763			   flag & ~QUOTES_ESC);
764		varflags &= ~VSNUL;
765		/*
766		 * Remove any recorded regions beyond
767		 * start of variable
768		 */
769		removerecordregions(startloc);
770		goto again;
771	}
772
773	if (varlen < 0 && uflag)
774		varunset(p, var, 0, 0);
775
776	if (subtype == VSLENGTH) {
777		cvtnum(varlen > 0 ? varlen : 0);
778		goto record;
779	}
780
781	if (subtype == VSNORMAL) {
782record:
783		if (!easy)
784			goto end;
785		recordregion(startloc, expdest - (char *)stackblock(), quoted);
786		goto end;
787	}
788
789#ifdef DEBUG
790	switch (subtype) {
791	case VSTRIMLEFT:
792	case VSTRIMLEFTMAX:
793	case VSTRIMRIGHT:
794	case VSTRIMRIGHTMAX:
795		break;
796	default:
797		abort();
798	}
799#endif
800
801	if (varlen >= 0) {
802		/*
803		 * Terminate the string and start recording the pattern
804		 * right after it
805		 */
806		STPUTC('\0', expdest);
807		patloc = expdest - (char *)stackblock();
808		if (subevalvar(p, NULL, patloc, subtype,
809			       startloc, varflags, flag) == 0) {
810			int amount = expdest - (
811				(char *)stackblock() + patloc - 1
812			);
813			STADJUST(-amount, expdest);
814		}
815		/* Remove any recorded regions beyond start of variable */
816		removerecordregions(startloc);
817		goto record;
818	}
819
820end:
821	if (subtype != VSNORMAL) {	/* skip to end of alternative */
822		int nesting = 1;
823		for (;;) {
824			if ((c = (signed char)*p++) == CTLESC)
825				p++;
826			else if (c == CTLBACKQ) {
827				if (varlen >= 0)
828					argbackq = argbackq->next;
829			} else if (c == CTLVAR) {
830				if ((*p++ & VSTYPE) != VSNORMAL)
831					nesting++;
832			} else if (c == CTLENDVAR) {
833				if (--nesting == 0)
834					break;
835			}
836		}
837	}
838	return p;
839}
840
841
842/*
843 * Put a string on the stack.
844 */
845
846STATIC void
847memtodest(const char *p, size_t len, const char *syntax, int quotes) {
848	char *q;
849
850	if (unlikely(!len))
851		return;
852
853	q = makestrspace(len * 2, expdest);
854
855	do {
856		int c = (signed char)*p++;
857		if (c) {
858			if ((quotes & QUOTES_ESC) &&
859			    ((syntax[c] == CCTL) ||
860			     (((quotes & EXP_FULL) || syntax != BASESYNTAX) &&
861			      syntax[c] == CBACK)))
862				USTPUTC(CTLESC, q);
863		} else if (!(quotes & QUOTES_KEEPNUL))
864			continue;
865		USTPUTC(c, q);
866	} while (--len);
867
868	expdest = q;
869}
870
871
872STATIC size_t
873strtodest(p, syntax, quotes)
874	const char *p;
875	const char *syntax;
876	int quotes;
877{
878	size_t len = strlen(p);
879	memtodest(p, len, syntax, quotes);
880	return len;
881}
882
883
884
885/*
886 * Add the value of a specialized variable to the stack string.
887 */
888
889STATIC ssize_t
890varvalue(char *name, int varflags, int flags, int *quotedp)
891{
892	int num;
893	char *p;
894	int i;
895	int sep;
896	char sepc;
897	char **ap;
898	char const *syntax;
899	int quoted = *quotedp;
900	int subtype = varflags & VSTYPE;
901	int discard = subtype == VSPLUS || subtype == VSLENGTH;
902	int quotes = (discard ? 0 : (flags & QUOTES_ESC)) | QUOTES_KEEPNUL;
903	ssize_t len = 0;
904
905	sep = (flags & EXP_FULL) << CHAR_BIT;
906	syntax = quoted ? DQSYNTAX : BASESYNTAX;
907
908	switch (*name) {
909	case '$':
910		num = rootpid;
911		goto numvar;
912	case '?':
913		num = exitstatus;
914		goto numvar;
915	case '#':
916		num = shellparam.nparam;
917		goto numvar;
918	case '!':
919		num = backgndpid;
920		if (num == 0)
921			return -1;
922numvar:
923		len = cvtnum(num);
924		break;
925	case '-':
926		p = makestrspace(NOPTS, expdest);
927		for (i = NOPTS - 1; i >= 0; i--) {
928			if (optlist[i]) {
929				USTPUTC(optletters[i], p);
930				len++;
931			}
932		}
933		expdest = p;
934		break;
935	case '@':
936		if (quoted && sep)
937			goto param;
938		/* fall through */
939	case '*':
940		if (quoted)
941			sep = 0;
942		sep |= ifsset() ? ifsval()[0] : ' ';
943param:
944		sepc = sep;
945		*quotedp = !sepc;
946		if (!(ap = shellparam.p))
947			return -1;
948		while ((p = *ap++)) {
949			len += strtodest(p, syntax, quotes);
950
951			if (*ap && sep) {
952				len++;
953				memtodest(&sepc, 1, syntax, quotes);
954			}
955		}
956		break;
957	case '0':
958	case '1':
959	case '2':
960	case '3':
961	case '4':
962	case '5':
963	case '6':
964	case '7':
965	case '8':
966	case '9':
967		num = atoi(name);
968		if (num < 0 || num > shellparam.nparam)
969			return -1;
970		p = num ? shellparam.p[num - 1] : arg0;
971		goto value;
972	default:
973		p = lookupvar(name);
974value:
975		if (!p)
976			return -1;
977
978		len = strtodest(p, syntax, quotes);
979		break;
980	}
981
982	if (discard)
983		STADJUST(-len, expdest);
984	return len;
985}
986
987
988
989/*
990 * Record the fact that we have to scan this region of the
991 * string for IFS characters.
992 */
993
994void
995recordregion(int start, int end, int nulonly)
996{
997	struct ifsregion *ifsp;
998
999	if (ifslastp == NULL) {
1000		ifsp = &ifsfirst;
1001	} else {
1002		INTOFF;
1003		ifsp = (struct ifsregion *)ckmalloc(sizeof (struct ifsregion));
1004		ifsp->next = NULL;
1005		ifslastp->next = ifsp;
1006		INTON;
1007	}
1008	ifslastp = ifsp;
1009	ifslastp->begoff = start;
1010	ifslastp->endoff = end;
1011	ifslastp->nulonly = nulonly;
1012}
1013
1014
1015
1016/*
1017 * Break the argument string into pieces based upon IFS and add the
1018 * strings to the argument list.  The regions of the string to be
1019 * searched for IFS characters have been stored by recordregion.
1020 * If maxargs is non-negative, at most maxargs arguments will be created, by
1021 * joining together the last arguments.
1022 */
1023void
1024ifsbreakup(char *string, int maxargs, struct arglist *arglist)
1025{
1026	struct ifsregion *ifsp;
1027	struct strlist *sp;
1028	char *start;
1029	char *p;
1030	char *q;
1031	char *r = NULL;
1032	const char *ifs, *realifs;
1033	int ifsspc;
1034	int nulonly;
1035
1036
1037	start = string;
1038	if (ifslastp != NULL) {
1039		ifsspc = 0;
1040		nulonly = 0;
1041		realifs = ifsset() ? ifsval() : defifs;
1042		ifsp = &ifsfirst;
1043		do {
1044			p = string + ifsp->begoff;
1045			nulonly = ifsp->nulonly;
1046			ifs = nulonly ? nullstr : realifs;
1047			ifsspc = 0;
1048			while (p < string + ifsp->endoff) {
1049				int c;
1050				bool isifs;
1051				bool isdefifs;
1052
1053				q = p;
1054				c = *p++;
1055				if (c == (char)CTLESC)
1056					c = *p++;
1057
1058				isifs = strchr(ifs, c);
1059				isdefifs = false;
1060				if (isifs)
1061					isdefifs = strchr(defifs, c);
1062
1063				/* If only reading one more argument:
1064				 * If we have exactly one field,
1065				 * read that field without its terminator.
1066				 * If we have more than one field,
1067				 * read all fields including their terminators,
1068				 * except for trailing IFS whitespace.
1069				 *
1070				 * This means that if we have only IFS
1071				 * characters left, and at most one
1072				 * of them is non-whitespace, we stop
1073				 * reading here.
1074				 * Otherwise, we read all the remaining
1075				 * characters except for trailing
1076				 * IFS whitespace.
1077				 *
1078				 * In any case, r indicates the start
1079				 * of the characters to remove, or NULL
1080				 * if no characters should be removed.
1081				 */
1082				if (!maxargs) {
1083					if (isdefifs) {
1084						if (!r)
1085							r = q;
1086						continue;
1087					}
1088
1089					if (!(isifs && ifsspc))
1090						r = NULL;
1091
1092					ifsspc = 0;
1093					continue;
1094				}
1095
1096				if (ifsspc) {
1097					if (isifs)
1098						q = p;
1099
1100					start = q;
1101
1102					if (isdefifs)
1103						continue;
1104
1105					isifs = false;
1106				}
1107
1108				if (isifs) {
1109					if (!nulonly)
1110						ifsspc = isdefifs;
1111					/* Ignore IFS whitespace at start */
1112					if (q == start && ifsspc) {
1113						start = p;
1114						ifsspc = 0;
1115						continue;
1116					}
1117					if (maxargs > 0 && !--maxargs) {
1118						r = q;
1119						continue;
1120					}
1121					*q = '\0';
1122					sp = (struct strlist *)stalloc(sizeof *sp);
1123					sp->text = start;
1124					*arglist->lastp = sp;
1125					arglist->lastp = &sp->next;
1126					start = p;
1127					continue;
1128				}
1129
1130				ifsspc = 0;
1131			}
1132		} while ((ifsp = ifsp->next) != NULL);
1133		if (nulonly)
1134			goto add;
1135	}
1136
1137	if (r)
1138		*r = '\0';
1139
1140	if (!*start)
1141		return;
1142
1143add:
1144	sp = (struct strlist *)stalloc(sizeof *sp);
1145	sp->text = start;
1146	*arglist->lastp = sp;
1147	arglist->lastp = &sp->next;
1148}
1149
1150void ifsfree(void)
1151{
1152	struct ifsregion *p = ifsfirst.next;
1153
1154	if (!p)
1155		goto out;
1156
1157	INTOFF;
1158	do {
1159		struct ifsregion *ifsp;
1160		ifsp = p->next;
1161		ckfree(p);
1162		p = ifsp;
1163	} while (p);
1164	ifsfirst.next = NULL;
1165	INTON;
1166
1167out:
1168	ifslastp = NULL;
1169}
1170
1171
1172
1173/*
1174 * Expand shell metacharacters.  At this point, the only control characters
1175 * should be escapes.  The results are stored in the list exparg.
1176 */
1177
1178#ifdef HAVE_GLOB
1179STATIC void
1180expandmeta(str, flag)
1181	struct strlist *str;
1182	int flag;
1183{
1184	/* TODO - EXP_REDIR */
1185
1186	while (str) {
1187		const char *p;
1188		glob_t pglob;
1189		int i;
1190
1191		if (fflag)
1192			goto nometa;
1193		INTOFF;
1194		p = preglob(str->text, RMESCAPE_ALLOC | RMESCAPE_HEAP);
1195		i = glob(p, GLOB_NOMAGIC, 0, &pglob);
1196		if (p != str->text)
1197			ckfree(p);
1198		switch (i) {
1199		case 0:
1200			if (!(pglob.gl_flags & GLOB_MAGCHAR))
1201				goto nometa2;
1202			addglob(&pglob);
1203			globfree(&pglob);
1204			INTON;
1205			break;
1206		case GLOB_NOMATCH:
1207nometa2:
1208			globfree(&pglob);
1209			INTON;
1210nometa:
1211			*exparg.lastp = str;
1212			rmescapes(str->text);
1213			exparg.lastp = &str->next;
1214			break;
1215		default:	/* GLOB_NOSPACE */
1216			sh_error("Out of space");
1217		}
1218		str = str->next;
1219	}
1220}
1221
1222
1223/*
1224 * Add the result of glob(3) to the list.
1225 */
1226
1227STATIC void
1228addglob(pglob)
1229	const glob_t *pglob;
1230{
1231	char **p = pglob->gl_pathv;
1232
1233	do {
1234		addfname(*p);
1235	} while (*++p);
1236}
1237
1238
1239#else	/* HAVE_GLOB */
1240STATIC char *expdir;
1241
1242
1243STATIC void
1244expandmeta(struct strlist *str, int flag)
1245{
1246	static const char metachars[] = {
1247		'*', '?', '[', 0
1248	};
1249	/* TODO - EXP_REDIR */
1250
1251	while (str) {
1252		struct strlist **savelastp;
1253		struct strlist *sp;
1254		char *p;
1255
1256		if (fflag)
1257			goto nometa;
1258		if (!strpbrk(str->text, metachars))
1259			goto nometa;
1260		savelastp = exparg.lastp;
1261
1262		INTOFF;
1263		p = preglob(str->text, RMESCAPE_ALLOC | RMESCAPE_HEAP);
1264		{
1265			int i = strlen(str->text);
1266			expdir = ckmalloc(i < 2048 ? 2048 : i); /* XXX */
1267		}
1268
1269		expmeta(expdir, p);
1270		ckfree(expdir);
1271		if (p != str->text)
1272			ckfree(p);
1273		INTON;
1274		if (exparg.lastp == savelastp) {
1275			/*
1276			 * no matches
1277			 */
1278nometa:
1279			*exparg.lastp = str;
1280			rmescapes(str->text);
1281			exparg.lastp = &str->next;
1282		} else {
1283			*exparg.lastp = NULL;
1284			*savelastp = sp = expsort(*savelastp);
1285			while (sp->next != NULL)
1286				sp = sp->next;
1287			exparg.lastp = &sp->next;
1288		}
1289		str = str->next;
1290	}
1291}
1292
1293
1294/*
1295 * Do metacharacter (i.e. *, ?, [...]) expansion.
1296 */
1297
1298STATIC void
1299expmeta(char *enddir, char *name)
1300{
1301	char *p;
1302	const char *cp;
1303	char *start;
1304	char *endname;
1305	int metaflag;
1306	struct stat statb;
1307	DIR *dirp;
1308	struct dirent *dp;
1309	int atend;
1310	int matchdot;
1311	int esc;
1312
1313	metaflag = 0;
1314	start = name;
1315	for (p = name; esc = 0, *p; p += esc + 1) {
1316		if (*p == '*' || *p == '?')
1317			metaflag = 1;
1318		else if (*p == '[') {
1319			char *q = p + 1;
1320			if (*q == '!')
1321				q++;
1322			for (;;) {
1323				if (*q == '\\')
1324					q++;
1325				if (*q == '/' || *q == '\0')
1326					break;
1327				if (*++q == ']') {
1328					metaflag = 1;
1329					break;
1330				}
1331			}
1332		} else {
1333			if (*p == '\\')
1334				esc++;
1335			if (p[esc] == '/') {
1336				if (metaflag)
1337					break;
1338				start = p + esc + 1;
1339			}
1340		}
1341	}
1342	if (metaflag == 0) {	/* we've reached the end of the file name */
1343		if (enddir != expdir)
1344			metaflag++;
1345		p = name;
1346		do {
1347			if (*p == '\\')
1348				p++;
1349			*enddir++ = *p;
1350		} while (*p++);
1351		if (metaflag == 0 || lstat(expdir, &statb) >= 0)
1352			addfname(expdir);
1353		return;
1354	}
1355	endname = p;
1356	if (name < start) {
1357		p = name;
1358		do {
1359			if (*p == '\\')
1360				p++;
1361			*enddir++ = *p++;
1362		} while (p < start);
1363	}
1364	if (enddir == expdir) {
1365		cp = ".";
1366	} else if (enddir == expdir + 1 && *expdir == '/') {
1367		cp = "/";
1368	} else {
1369		cp = expdir;
1370		enddir[-1] = '\0';
1371	}
1372	if ((dirp = opendir(cp)) == NULL)
1373		return;
1374	if (enddir != expdir)
1375		enddir[-1] = '/';
1376	if (*endname == 0) {
1377		atend = 1;
1378	} else {
1379		atend = 0;
1380		*endname = '\0';
1381		endname += esc + 1;
1382	}
1383	matchdot = 0;
1384	p = start;
1385	if (*p == '\\')
1386		p++;
1387	if (*p == '.')
1388		matchdot++;
1389	while (! int_pending() && (dp = readdir(dirp)) != NULL) {
1390		if (dp->d_name[0] == '.' && ! matchdot)
1391			continue;
1392		if (pmatch(start, dp->d_name)) {
1393			if (atend) {
1394				scopy(dp->d_name, enddir);
1395				addfname(expdir);
1396			} else {
1397				for (p = enddir, cp = dp->d_name;
1398				     (*p++ = *cp++) != '\0';)
1399					continue;
1400				p[-1] = '/';
1401				expmeta(p, endname);
1402			}
1403		}
1404	}
1405	closedir(dirp);
1406	if (! atend)
1407		endname[-esc - 1] = esc ? '\\' : '/';
1408}
1409#endif	/* HAVE_GLOB */
1410
1411
1412/*
1413 * Add a file name to the list.
1414 */
1415
1416STATIC void
1417addfname(char *name)
1418{
1419	struct strlist *sp;
1420
1421	sp = (struct strlist *)stalloc(sizeof *sp);
1422	sp->text = sstrdup(name);
1423	*exparg.lastp = sp;
1424	exparg.lastp = &sp->next;
1425}
1426
1427
1428#ifndef HAVE_GLOB
1429/*
1430 * Sort the results of file name expansion.  It calculates the number of
1431 * strings to sort and then calls msort (short for merge sort) to do the
1432 * work.
1433 */
1434
1435STATIC struct strlist *
1436expsort(struct strlist *str)
1437{
1438	int len;
1439	struct strlist *sp;
1440
1441	len = 0;
1442	for (sp = str ; sp ; sp = sp->next)
1443		len++;
1444	return msort(str, len);
1445}
1446
1447
1448STATIC struct strlist *
1449msort(struct strlist *list, int len)
1450{
1451	struct strlist *p, *q = NULL;
1452	struct strlist **lpp;
1453	int half;
1454	int n;
1455
1456	if (len <= 1)
1457		return list;
1458	half = len >> 1;
1459	p = list;
1460	for (n = half ; --n >= 0 ; ) {
1461		q = p;
1462		p = p->next;
1463	}
1464	q->next = NULL;			/* terminate first half of list */
1465	q = msort(list, half);		/* sort first half of list */
1466	p = msort(p, len - half);		/* sort second half */
1467	lpp = &list;
1468	for (;;) {
1469		if (strcmp(p->text, q->text) < 0) {
1470			*lpp = p;
1471			lpp = &p->next;
1472			if ((p = *lpp) == NULL) {
1473				*lpp = q;
1474				break;
1475			}
1476		} else {
1477			*lpp = q;
1478			lpp = &q->next;
1479			if ((q = *lpp) == NULL) {
1480				*lpp = p;
1481				break;
1482			}
1483		}
1484	}
1485	return list;
1486}
1487#endif
1488
1489
1490/*
1491 * Returns true if the pattern matches the string.
1492 */
1493
1494STATIC inline int
1495patmatch(char *pattern, const char *string)
1496{
1497	return pmatch(preglob(pattern, 0), string);
1498}
1499
1500
1501#ifndef HAVE_FNMATCH
1502STATIC int ccmatch(const char *p, int chr, const char **r)
1503{
1504	static const struct class {
1505		char name[10];
1506		int (*fn)(int);
1507	} classes[] = {
1508		{ .name = ":alnum:]", .fn = isalnum },
1509		{ .name = ":cntrl:]", .fn = iscntrl },
1510		{ .name = ":lower:]", .fn = islower },
1511		{ .name = ":space:]", .fn = isspace },
1512		{ .name = ":alpha:]", .fn = isalpha },
1513		{ .name = ":digit:]", .fn = isdigit },
1514		{ .name = ":print:]", .fn = isprint },
1515		{ .name = ":upper:]", .fn = isupper },
1516		{ .name = ":blank:]", .fn = isblank },
1517		{ .name = ":graph:]", .fn = isgraph },
1518		{ .name = ":punct:]", .fn = ispunct },
1519		{ .name = ":xdigit:]", .fn = isxdigit },
1520	};
1521	const struct class *class, *end;
1522
1523	end = classes + sizeof(classes) / sizeof(classes[0]);
1524	for (class = classes; class < end; class++) {
1525		const char *q;
1526
1527		q = prefix(p, class->name);
1528		if (!q)
1529			continue;
1530		*r = q;
1531		return class->fn(chr);
1532	}
1533
1534	*r = 0;
1535	return 0;
1536}
1537
1538STATIC int
1539pmatch(const char *pattern, const char *string)
1540{
1541	const char *p, *q;
1542	char c;
1543
1544	p = pattern;
1545	q = string;
1546	for (;;) {
1547		switch (c = *p++) {
1548		case '\0':
1549			goto breakloop;
1550		case '\\':
1551			if (*p) {
1552				c = *p++;
1553			}
1554			goto dft;
1555		case '?':
1556			if (*q++ == '\0')
1557				return 0;
1558			break;
1559		case '*':
1560			c = *p;
1561			while (c == '*')
1562				c = *++p;
1563			if (c != '\\' && c != '?' && c != '*' && c != '[') {
1564				while (*q != c) {
1565					if (*q == '\0')
1566						return 0;
1567					q++;
1568				}
1569			}
1570			do {
1571				if (pmatch(p, q))
1572					return 1;
1573			} while (*q++ != '\0');
1574			return 0;
1575		case '[': {
1576			const char *startp;
1577			int invert, found;
1578			char chr;
1579
1580			startp = p;
1581			invert = 0;
1582			if (*p == '!') {
1583				invert++;
1584				p++;
1585			}
1586			found = 0;
1587			chr = *q;
1588			if (chr == '\0')
1589				return 0;
1590			c = *p++;
1591			do {
1592				if (!c) {
1593					p = startp;
1594					c = '[';
1595					goto dft;
1596				}
1597				if (c == '[') {
1598					const char *r;
1599
1600					found |= !!ccmatch(p, chr, &r);
1601					if (r) {
1602						p = r;
1603						continue;
1604					}
1605				} else if (c == '\\')
1606					c = *p++;
1607				if (*p == '-' && p[1] != ']') {
1608					p++;
1609					if (*p == '\\')
1610						p++;
1611					if (chr >= c && chr <= *p)
1612						found = 1;
1613					p++;
1614				} else {
1615					if (chr == c)
1616						found = 1;
1617				}
1618			} while ((c = *p++) != ']');
1619			if (found == invert)
1620				return 0;
1621			q++;
1622			break;
1623		}
1624dft:	        default:
1625			if (*q++ != c)
1626				return 0;
1627			break;
1628		}
1629	}
1630breakloop:
1631	if (*q != '\0')
1632		return 0;
1633	return 1;
1634}
1635#endif
1636
1637
1638
1639/*
1640 * Remove any CTLESC characters from a string.
1641 */
1642
1643char *
1644_rmescapes(char *str, int flag)
1645{
1646	char *p, *q, *r;
1647	unsigned inquotes;
1648	int notescaped;
1649	int globbing;
1650
1651	p = strpbrk(str, qchars);
1652	if (!p) {
1653		return str;
1654	}
1655	q = p;
1656	r = str;
1657	if (flag & RMESCAPE_ALLOC) {
1658		size_t len = p - str;
1659		size_t fulllen = len + strlen(p) + 1;
1660
1661		if (flag & RMESCAPE_GROW) {
1662			int strloc = str - (char *)stackblock();
1663
1664			r = makestrspace(fulllen, expdest);
1665			str = (char *)stackblock() + strloc;
1666			p = str + len;
1667		} else if (flag & RMESCAPE_HEAP) {
1668			r = ckmalloc(fulllen);
1669		} else {
1670			r = stalloc(fulllen);
1671		}
1672		q = r;
1673		if (len > 0) {
1674			q = mempcpy(q, str, len);
1675		}
1676	}
1677	inquotes = 0;
1678	globbing = flag & RMESCAPE_GLOB;
1679	notescaped = globbing;
1680	while (*p) {
1681		if (*p == (char)CTLQUOTEMARK) {
1682			inquotes = ~inquotes;
1683			p++;
1684			notescaped = globbing;
1685			continue;
1686		}
1687		if (*p == (char)CTLESC) {
1688			p++;
1689			if (notescaped)
1690				*q++ = '\\';
1691		} else if (*p == '\\' && !inquotes) {
1692			/* naked back slash */
1693			notescaped = 0;
1694			goto copy;
1695		}
1696		notescaped = globbing;
1697copy:
1698		*q++ = *p++;
1699	}
1700	*q = '\0';
1701	if (flag & RMESCAPE_GROW) {
1702		expdest = r;
1703		STADJUST(q - r + 1, expdest);
1704	}
1705	return r;
1706}
1707
1708
1709
1710/*
1711 * See if a pattern matches in a case statement.
1712 */
1713
1714int
1715casematch(union node *pattern, char *val)
1716{
1717	struct stackmark smark;
1718	int result;
1719
1720	setstackmark(&smark);
1721	argbackq = pattern->narg.backquote;
1722	STARTSTACKSTR(expdest);
1723	argstr(pattern->narg.text, EXP_TILDE | EXP_CASE);
1724	STACKSTRNUL(expdest);
1725	ifsfree();
1726	result = patmatch(stackblock(), val);
1727	popstackmark(&smark);
1728	return result;
1729}
1730
1731/*
1732 * Our own itoa().
1733 */
1734
1735STATIC int
1736cvtnum(intmax_t num)
1737{
1738	int len = max_int_length(sizeof(num));
1739
1740	expdest = makestrspace(len, expdest);
1741	len = fmtstr(expdest, len, "%" PRIdMAX, num);
1742	STADJUST(len, expdest);
1743	return len;
1744}
1745
1746STATIC void
1747varunset(const char *end, const char *var, const char *umsg, int varflags)
1748{
1749	const char *msg;
1750	const char *tail;
1751
1752	tail = nullstr;
1753	msg = "parameter not set";
1754	if (umsg) {
1755		if (*end == (char)CTLENDVAR) {
1756			if (varflags & VSNUL)
1757				tail = " or null";
1758		} else
1759			msg = umsg;
1760	}
1761	sh_error("%.*s: %s%s", end - var - 1, var, msg, tail);
1762}
1763
1764#ifdef mkinit
1765
1766INCLUDE "expand.h"
1767
1768RESET {
1769	ifsfree();
1770}
1771
1772#endif
1773