perl.c

早期freebsd实现

	 * filename point to an accessible directory.  So there is a faint
	 * chance that someone could execute a setuid script down in a
	 * non-accessible directory.  I don't know what to do about that.
	 * But I don't think it's too important.  The manual lies when
	 * it says access() is useful in setuid programs.
	 */
	if (access(stab_val(curcmd->c_filestab)->str_ptr,1))	/*double check*/
	    fatal("Permission denied");
#else
	/* If we can swap euid and uid, then we can determine access rights
	 * with a simple stat of the file, and then compare device and
	 * inode to make sure we did stat() on the same file we opened.
	 * Then we just have to make sure he or she can execute it.
	 */
	{
	    struct stat tmpstatbuf;

	    if (setreuid(euid,uid) < 0 || getuid() != euid || geteuid() != uid)
		fatal("Can't swap uid and euid");	/* really paranoid */
	    if (stat(stab_val(curcmd->c_filestab)->str_ptr,&tmpstatbuf) < 0)
		fatal("Permission denied");	/* testing full pathname here */
	    if (tmpstatbuf.st_dev != statbuf.st_dev ||
		tmpstatbuf.st_ino != statbuf.st_ino) {
		(void)fclose(rsfp);
		if (rsfp = mypopen("/bin/mail root","w")) {	/* heh, heh */
		    fprintf(rsfp,
"User %d tried to run dev %d ino %d in place of dev %d ino %d!\n\
(Filename of set-id script was %s, uid %d gid %d.)\n\nSincerely,\nperl\n",
			uid,tmpstatbuf.st_dev, tmpstatbuf.st_ino,
			statbuf.st_dev, statbuf.st_ino,
			stab_val(curcmd->c_filestab)->str_ptr,
			statbuf.st_uid, statbuf.st_gid);
		    (void)mypclose(rsfp);
		}
		fatal("Permission denied\n");
	    }
	    if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid)
		fatal("Can't reswap uid and euid");
	    if (!cando(S_IXUSR,FALSE,&statbuf))		/* can real uid exec? */
		fatal("Permission denied\n");
	}
#endif /* HAS_SETREUID */
#endif /* IAMSUID */

	if (!S_ISREG(statbuf.st_mode))
	    fatal("Permission denied");
	if (statbuf.st_mode & S_IWOTH)
	    fatal("Setuid/gid script is writable by world");
	doswitches = FALSE;		/* -s is insecure in suid */
	curcmd->c_line++;
	if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
	  strnNE(tokenbuf,"#!",2) )	/* required even on Sys V */
	    fatal("No #! line");
	s = tokenbuf+2;
	if (*s == ' ') s++;
	while (!isSPACE(*s)) s++;
	if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
	    fatal("Not a perl script");
	while (*s == ' ' || *s == '\t') s++;
	/*
	 * #! arg must be what we saw above.  They can invoke it by
	 * mentioning suidperl explicitly, but they may not add any strange
	 * arguments beyond what #! says if they do invoke suidperl that way.
	 */
	len = strlen(validarg);
	if (strEQ(validarg," PHOOEY ") ||
	    strnNE(s,validarg,len) || !isSPACE(s[len]))
	    fatal("Args must match #! line");

#ifndef IAMSUID
	if (euid != uid && (statbuf.st_mode & S_ISUID) &&
	    euid == statbuf.st_uid)
	    if (!do_undump)
		fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
#endif /* IAMSUID */

	if (euid) {	/* oops, we're not the setuid root perl */
	    (void)fclose(rsfp);
#ifndef IAMSUID
	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
	    execv(buf, origargv);	/* try again */
#endif
	    fatal("Can't do setuid\n");
	}

	if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) {
#ifdef HAS_SETEGID
	    (void)setegid(statbuf.st_gid);
#else
#ifdef HAS_SETREGID
	    (void)setregid((GIDTYPE)-1,statbuf.st_gid);
#else
	    setgid(statbuf.st_gid);
#endif
#endif
	    if (getegid() != statbuf.st_gid)
		fatal("Can't do setegid!\n");
	}
	if (statbuf.st_mode & S_ISUID) {
	    if (statbuf.st_uid != euid)
#ifdef HAS_SETEUID
		(void)seteuid(statbuf.st_uid);	/* all that for this */
#else
#ifdef HAS_SETREUID
		(void)setreuid((UIDTYPE)-1,statbuf.st_uid);
#else
		setuid(statbuf.st_uid);
#endif
#endif
	    if (geteuid() != statbuf.st_uid)
		fatal("Can't do seteuid!\n");
	}
	else if (uid) {			/* oops, mustn't run as root */
#ifdef HAS_SETEUID
	    (void)seteuid((UIDTYPE)uid);
#else
#ifdef HAS_SETREUID
	    (void)setreuid((UIDTYPE)-1,(UIDTYPE)uid);
#else
	    setuid((UIDTYPE)uid);
#endif
#endif
	    if (geteuid() != uid)
		fatal("Can't do seteuid!\n");
	}
	uid = (int)getuid();
	euid = (int)geteuid();
	gid = (int)getgid();
	egid = (int)getegid();
	if (!cando(S_IXUSR,TRUE,&statbuf))
	    fatal("Permission denied\n");	/* they can't do this */
    }
#ifdef IAMSUID
    else if (preprocess)
	fatal("-P not allowed for setuid/setgid script\n");
    else
	fatal("Script is not setuid/setgid in suidperl\n");
#else
#ifndef TAINT		/* we aren't taintperl or suidperl */
    /* script has a wrapper--can't run suidperl or we lose euid */
    else if (euid != uid || egid != gid) {
	(void)fclose(rsfp);
	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
	execv(buf, origargv);	/* try again */
	fatal("Can't run setuid script with taint checks");
    }
#endif /* TAINT */
#endif /* IAMSUID */
#else /* !DOSUID */
#ifndef TAINT		/* we aren't taintperl or suidperl */
    if (euid != uid || egid != gid) {	/* (suidperl doesn't exist, in fact) */
#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
	fstat(fileno(rsfp),&statbuf);	/* may be either wrapped or real suid */
	if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
	    ||
	    (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
	   )
	    if (!do_undump)
		fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
	/* not set-id, must be wrapped */
	(void)fclose(rsfp);
	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
	execv(buf, origargv);	/* try again */
	fatal("Can't run setuid script with taint checks");
    }
#endif /* TAINT */
#endif /* DOSUID */

#if !defined(IAMSUID) && !defined(TAINT)

    /* skip forward in input to the real script? */

    while (doextract) {
	if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
	    fatal("No Perl script found in input\n");
	if (*s == '#' && s[1] == '!' && instr(s,"perl")) {
	    ungetc('\n',rsfp);		/* to keep line count right */
	    doextract = FALSE;
	    if (s = instr(s,"perl -")) {
		s += 6;
		/*SUPPRESS 530*/
		while (s = moreswitches(s)) ;
	    }
	    if (cddir && chdir(cddir) < 0)
		fatal("Can't chdir to %s",cddir);
	}
    }
#endif /* !defined(IAMSUID) && !defined(TAINT) */

    defstab = stabent("_",TRUE);

    subname = str_make("main",4);
    if (perldb) {
	debstash = hnew(0);
	stab_xhash(stabent("_DB",TRUE)) = debstash;
	curstash = debstash;
	dbargs = stab_xarray(aadd((tmpstab = stabent("args",TRUE))));
	tmpstab->str_pok |= SP_MULTI;
	dbargs->ary_flags = 0;
	DBstab = stabent("DB",TRUE);
	DBstab->str_pok |= SP_MULTI;
	DBline = stabent("dbline",TRUE);
	DBline->str_pok |= SP_MULTI;
	DBsub = hadd(tmpstab = stabent("sub",TRUE));
	tmpstab->str_pok |= SP_MULTI;
	DBsingle = stab_val((tmpstab = stabent("single",TRUE)));
	tmpstab->str_pok |= SP_MULTI;
	DBtrace = stab_val((tmpstab = stabent("trace",TRUE)));
	tmpstab->str_pok |= SP_MULTI;
	DBsignal = stab_val((tmpstab = stabent("signal",TRUE)));
	tmpstab->str_pok |= SP_MULTI;
	curstash = defstash;
    }

    /* init tokener */

    bufend = bufptr = str_get(linestr);

    savestack = anew(Nullstab);		/* for saving non-local values */
    stack = anew(Nullstab);		/* for saving non-local values */
    stack->ary_flags = 0;		/* not a real array */
    afill(stack,63); afill(stack,-1);	/* preextend stack */
    afill(savestack,63); afill(savestack,-1);

    /* now parse the script */

    error_count = 0;
    if (yyparse() || error_count) {
	if (minus_c)
	    fatal("%s had compilation errors.\n", origfilename);
	else {
	    fatal("Execution of %s aborted due to compilation errors.\n",
		origfilename);
	}
    }

    New(50,loop_stack,128,struct loop);
#ifdef DEBUGGING
    if (debug) {
	New(51,debname,128,char);
	New(52,debdelim,128,char);
    }
#endif
    curstash = defstash;

    preprocess = FALSE;
    if (e_fp) {
	e_fp = Nullfp;
	(void)UNLINK(e_tmpname);
    }

    /* initialize everything that won't change if we undump */

    if (sigstab = stabent("SIG",allstabs)) {
	sigstab->str_pok |= SP_MULTI;
	(void)hadd(sigstab);
    }

    magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006");
    userinit();		/* in case linked C routines want magical variables */

    amperstab = stabent("&",allstabs);
    leftstab = stabent("`",allstabs);
    rightstab = stabent("'",allstabs);
    sawampersand = (amperstab || leftstab || rightstab);
    if (tmpstab = stabent(":",allstabs))
	str_set(stab_val(tmpstab),chopset);
    if (tmpstab = stabent("\024",allstabs))
	time(&basetime);

    /* these aren't necessarily magical */
    if (tmpstab = stabent("\014",allstabs)) {
	str_set(stab_val(tmpstab),"\f");
	formfeed = stab_val(tmpstab);
    }
    if (tmpstab = stabent(";",allstabs))
	str_set(STAB_STR(tmpstab),"\034");
    if (tmpstab = stabent("]",allstabs)) {
	str = STAB_STR(tmpstab);
	str_set(str,rcsid);
	str->str_u.str_nval = atof(patchlevel);
	str->str_nok = 1;
    }
    str_nset(stab_val(stabent("\"", TRUE)), " ", 1);

    stdinstab = stabent("STDIN",TRUE);
    stdinstab->str_pok |= SP_MULTI;
    if (!stab_io(stdinstab))
	stab_io(stdinstab) = stio_new();
    stab_io(stdinstab)->ifp = stdin;
    tmpstab = stabent("stdin",TRUE);
    stab_io(tmpstab) = stab_io(stdinstab);
    tmpstab->str_pok |= SP_MULTI;

    tmpstab = stabent("STDOUT",TRUE);
    tmpstab->str_pok |= SP_MULTI;
    if (!stab_io(tmpstab))
	stab_io(tmpstab) = stio_new();
    stab_io(tmpstab)->ofp = stab_io(tmpstab)->ifp = stdout;
    defoutstab = tmpstab;
    tmpstab = stabent("stdout",TRUE);
    stab_io(tmpstab) = stab_io(defoutstab);
    tmpstab->str_pok |= SP_MULTI;

    curoutstab = stabent("STDERR",TRUE);
    curoutstab->str_pok |= SP_MULTI;
    if (!stab_io(curoutstab))
	stab_io(curoutstab) = stio_new();
    stab_io(curoutstab)->ofp = stab_io(curoutstab)->ifp = stderr;
    tmpstab = stabent("stderr",TRUE);
    stab_io(tmpstab) = stab_io(curoutstab);
    tmpstab->str_pok |= SP_MULTI;
    curoutstab = defoutstab;		/* switch back to STDOUT */

    statname = Str_new(66,0);		/* last filename we did stat on */

    /* now that script is parsed, we can modify record separator */

    rs = nrs;
    rslen = nrslen;
    rschar = nrschar;
    rspara = (nrslen == 2);
    str_nset(stab_val(stabent("/", TRUE)), rs, rslen);

    if (do_undump)
	my_unexec();

  just_doit:		/* come here if running an undumped a.out */
    argc--,argv++;	/* skip name of script */
    if (doswitches) {
	for (; argc > 0 && **argv == '-'; argc--,argv++) {
	    if (argv[0][1] == '-') {
		argc--,argv++;
		break;
	    }
	    if (s = index(argv[0], '=')) {
		*s++ = '\0';
		str_set(stab_val(stabent(argv[0]+1,TRUE)),s);
	    }
	    else
		str_numset(stab_val(stabent(argv[0]+1,TRUE)),(double)1.0);
	}
    }
#ifdef TAINT
    tainted = 1;
#endif
    if (tmpstab = stabent("0",allstabs)) {
	str_set(stab_val(tmpstab),origfilename);
	magicname("0", Nullch, 0);
    }
    if (tmpstab = stabent("\030",allstabs))
	str_set(stab_val(tmpstab),origargv[0]);
    if (argvstab = stabent("ARGV",allstabs)) {
	argvstab->str_pok |= SP_MULTI;
	(void)aadd(argvstab);
	aclear(stab_array(argvstab));
	for (; argc > 0; argc--,argv++) {
	    (void)apush(stab_array(argvstab),str_make(argv[0],0));
	}
    }
#ifdef TAINT
    (void) stabent("ENV",TRUE);		/* must test PATH and IFS */
#endif
    if (envstab = stabent("ENV",allstabs)) {
	envstab->str_pok |= SP_MULTI;
	(void)hadd(envstab);
	hclear(stab_hash(envstab), FALSE);
	if (env != environ)
	    environ[0] = Nullch;
	for (; *env; env++) {
	    if (!(s = index(*env,'=')))
		continue;
	    *s++ = '\0';
	    str = str_make(s--,0);
	    str_magic(str, envstab, 'E', *env, s - *env);
	    (void)hstore(stab_hash(envstab), *env, s - *env, str, 0);
	    *s = '=';
	}
    }
#ifdef TAINT
    tainted = 0;
#endif
    if (tmpstab = stabent("$",allstabs))
	str_numset(STAB_STR(tmpstab),(double)getpid());

    if (dowarn) {
	stab_check('A','Z');
	stab_check('a','z');
    }

    if (setjmp(top_env))	/* sets goto_targ on longjump */
	loop_ptr = -1;		/* start label stack again */

#ifdef DEBUGGING
    if (debug & 1024)
	dump_all();
    if (debug)
	fprintf(stderr,"\nEXECUTING...\n\n");
#endif

    if (minus_c) {
	fprintf(stderr,"%s syntax OK\n", origfilename);
	exit(0);
    }

    /* do it */

    (void) cmd_exec(main_root,G_SCALAR,-1);

    if (goto_targ)
	fatal("Can't find label \"%s\"--aborting",goto_targ);
    exit(0);
    /* NOTREACHED */
}

void
magicalize(list)
register char *list;
{
    char sym[2];

    sym[1] = '\0';
    while (*sym = *list++)
	magicname(sym, Nullch, 0);
}

void
magicname(sym,name,namlen)
char *sym;
char *name;
int namlen;
{
    register STAB *stab;

    if (stab = stabent(sym,allstabs)) {
	stab_flags(stab) = SF_VMAGIC;
	str_magic(stab_val(stab), stab, 0, name, namlen);
    }
}

static void
incpush(p)
char *p;
{
    char *s;

    if (!p)
	return;

    /* Break at all separators */
    while (*p) {
	/* First, skip any consecutive separators */
	while ( *p == PERLLIB_SEP ) {
	    /* Uncomment the next line for PATH semantics */
	    /* (void)apush(stab_array(incstab), str_make(".", 1)); */
	    p++;
	}
	if ( (s = index(p, PERLLIB_SEP)) != Nullch ) {
	    (void)apush(stab_array(incstab), str_make(p, (int)(s - p)));
	    p = s + 1;
	} else {
	    (void)apush(stab_array(incstab), str_make(p, 0));
	    break;
	}
    }
}

void
savelines(array, str)
ARRAY *array;
STR *str;
{
    register char *s = str->str_ptr;
    register char *send = str->str_ptr + str->str_cur;
    register char *t;
    register int line = 1;

    while (s && s < send) {
	STR *tmpstr = Str_new(85,0);