rsalz@uunet.uu.net (Rich Salz) (07/12/88)
Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Posting-number: Volume 15, Issue 97
Archive-name: perl2/part08
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 15 through sh. When all 15 kits have been run, read README.
echo "This is perl 2.0 kit 8 (of 15). If kit 8 is complete, the line"
echo '"'"End of kit 8 (of 15)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg eg/scan 2>/dev/null
echo Extracting eval.c
sed >eval.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: eval.c,v 2.0 88/06/05 00:08:48 root Exp $
X *
X * $Log: eval.c,v $
X * Revision 2.0 88/06/05 00:08:48 root
X * Baseline version 2.0.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#include <signal.h>
X#include <errno.h>
X
Xextern int errno;
X
X#ifdef VOIDSIG
Xstatic void (*ihand)();
Xstatic void (*qhand)();
X#else
Xstatic int (*ihand)();
Xstatic int (*qhand)();
X#endif
X
XARG *debarg;
XSTR str_args;
X
XSTR *
Xeval(arg,retary,sargoff)
Xregister ARG *arg;
XSTR ***retary; /* where to return an array to, null if nowhere */
Xint sargoff; /* how many elements in sarg are already assigned */
X{
X register STR *str;
X register int anum;
X register int optype;
X int maxarg;
X int maxsarg;
X double value;
X STR *quicksarg[5];
X register STR **sarg = quicksarg;
X register char *tmps;
X char *tmps2;
X int argflags;
X int argtype;
X union argptr argptr;
X int cushion;
X unsigned long tmplong;
X long when;
X FILE *fp;
X STR *tmpstr;
X FCMD *form;
X STAB *stab;
X ARRAY *ary;
X bool assigning = FALSE;
X double exp(), log(), sqrt(), modf();
X char *crypt(), *getenv();
X
X if (!arg)
X return &str_no;
X str = arg->arg_ptr.arg_str;
X optype = arg->arg_type;
X maxsarg = maxarg = arg->arg_len;
X if (maxsarg > 3 || retary) {
X if (sargoff >= 0) { /* array already exists, just append to it */
X cushion = 10;
X sarg = (STR **)saferealloc((char*)*retary,
X (maxsarg+sargoff+2+cushion) * sizeof(STR*)) + sargoff;
X /* Note that sarg points into the middle of the array */
X }
X else {
X sargoff = cushion = 0;
X sarg = (STR **)safemalloc((maxsarg+2) * sizeof(STR*));
X }
X }
X else
X sargoff = 0;
X#ifdef DEBUGGING
X if (debug) {
X if (debug & 8) {
X deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
X }
X debname[dlevel] = opname[optype][0];
X debdelim[dlevel++] = ':';
X }
X#endif
X for (anum = 1; anum <= maxarg; anum++) {
X argflags = arg[anum].arg_flags;
X if (argflags & AF_SPECIAL)
X continue;
X argtype = arg[anum].arg_type;
X argptr = arg[anum].arg_ptr;
X re_eval:
X switch (argtype) {
X default:
X sarg[anum] = &str_no;
X#ifdef DEBUGGING
X tmps = "NULL";
X#endif
X break;
X case A_EXPR:
X#ifdef DEBUGGING
X if (debug & 8) {
X tmps = "EXPR";
X deb("%d.EXPR =>\n",anum);
X }
X#endif
X if (retary &&
X (optype == O_LIST || optype == O_ITEM2 || optype == O_ITEM3)) {
X *retary = sarg - sargoff;
X eval(argptr.arg_arg, retary, anum - 1 + sargoff);
X sarg = *retary; /* they do realloc it... */
X argtype = maxarg - anum; /* how many left? */
X maxsarg = (int)(str_gnum(sarg[0])) + argtype;
X sargoff = maxsarg - maxarg;
X if (argtype > 9 - cushion) { /* we don't have room left */
X sarg = (STR **)saferealloc((char*)sarg,
X (maxsarg+2+cushion) * sizeof(STR*));
X }
X sarg += sargoff;
X }
X else
X sarg[anum] = eval(argptr.arg_arg, Null(STR***),-1);
X break;
X case A_CMD:
X#ifdef DEBUGGING
X if (debug & 8) {
X tmps = "CMD";
X deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
X }
X#endif
X sarg[anum] = cmd_exec(argptr.arg_cmd);
X break;
X case A_STAB:
X sarg[anum] = STAB_STR(argptr.arg_stab);
X#ifdef DEBUGGING
X if (debug & 8) {
X sprintf(buf,"STAB $%s",argptr.arg_stab->stab_name);
X tmps = buf;
X }
X#endif
X break;
X case A_LEXPR:
X#ifdef DEBUGGING
X if (debug & 8) {
X tmps = "LEXPR";
X deb("%d.LEXPR =>\n",anum);
X }
X#endif
X str = eval(argptr.arg_arg,Null(STR***),-1);
X if (!str)
X fatal("panic: A_LEXPR");
X goto do_crement;
X case A_LVAL:
X#ifdef DEBUGGING
X if (debug & 8) {
X sprintf(buf,"LVAL $%s",argptr.arg_stab->stab_name);
X tmps = buf;
X }
X#endif
X str = STAB_STR(argptr.arg_stab);
X if (!str)
X fatal("panic: A_LVAL");
X do_crement:
X assigning = TRUE;
X if (argflags & AF_PRE) {
X if (argflags & AF_UP)
X str_inc(str);
X else
X str_dec(str);
X STABSET(str);
X sarg[anum] = str;
X str = arg->arg_ptr.arg_str;
X }
X else if (argflags & AF_POST) {
X sarg[anum] = str_static(str);
X if (argflags & AF_UP)
X str_inc(str);
X else
X str_dec(str);
X STABSET(str);
X str = arg->arg_ptr.arg_str;
X }
X else {
X sarg[anum] = str;
X }
X break;
X case A_LARYLEN:
X str = sarg[anum] =
X argptr.arg_stab->stab_array->ary_magic;
X#ifdef DEBUGGING
X tmps = "LARYLEN";
X#endif
X if (!str)
X fatal("panic: A_LEXPR");
X goto do_crement;
X case A_ARYLEN:
X stab = argptr.arg_stab;
X sarg[anum] = stab->stab_array->ary_magic;
X str_numset(sarg[anum],(double)(stab->stab_array->ary_fill+arybase));
X#ifdef DEBUGGING
X tmps = "ARYLEN";
X#endif
X break;
X case A_SINGLE:
X sarg[anum] = argptr.arg_str;
X#ifdef DEBUGGING
X tmps = "SINGLE";
X#endif
X break;
X case A_DOUBLE:
X (void) interp(str,str_get(argptr.arg_str));
X sarg[anum] = str;
X#ifdef DEBUGGING
X tmps = "DOUBLE";
X#endif
X break;
X case A_BACKTICK:
X tmps = str_get(argptr.arg_str);
X fp = popen(str_get(interp(str,tmps)),"r");
X tmpstr = str_new(80);
X str_set(str,"");
X if (fp) {
X while (str_gets(tmpstr,fp) != Nullch) {
X str_scat(str,tmpstr);
X }
X statusvalue = pclose(fp);
X }
X else
X statusvalue = -1;
X str_free(tmpstr);
X
X sarg[anum] = str;
X#ifdef DEBUGGING
X tmps = "BACK";
X#endif
X break;
X case A_INDREAD:
X last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
X goto do_read;
X case A_GLOB:
X argflags |= AF_POST; /* enable newline chopping */
X case A_READ:
X last_in_stab = argptr.arg_stab;
X do_read:
X fp = Nullfp;
X if (last_in_stab->stab_io) {
X fp = last_in_stab->stab_io->fp;
X if (!fp) {
X if (last_in_stab->stab_io->flags & IOF_ARGV) {
X if (last_in_stab->stab_io->flags & IOF_START) {
X last_in_stab->stab_io->flags &= ~IOF_START;
X last_in_stab->stab_io->lines = 0;
X if (alen(last_in_stab->stab_array) < 0) {
X tmpstr = str_make("-"); /* assume stdin */
X apush(last_in_stab->stab_array, tmpstr);
X }
X }
X fp = nextargv(last_in_stab);
X if (!fp) /* Note: fp != last_in_stab->stab_io->fp */
X do_close(last_in_stab,FALSE); /* now it does */
X }
X else if (argtype == A_GLOB) {
X (void) interp(str,str_get(last_in_stab->stab_val));
X tmps = str->str_ptr;
X if (*tmps == '!')
X sprintf(tokenbuf,"%s|",tmps+1);
X else {
X if (*tmps == ';')
X sprintf(tokenbuf, "%s", tmps+1);
X else
X sprintf(tokenbuf, "echo %s", tmps);
X strcat(tokenbuf,
X "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
X }
X do_open(last_in_stab,tokenbuf);
X fp = last_in_stab->stab_io->fp;
X }
X }
X }
X if (!fp && dowarn)
X warn("Read on closed filehandle <%s>",last_in_stab->stab_name);
X keepgoing:
X if (!fp)
X sarg[anum] = &str_no;
X else if (!str_gets(str,fp)) {
X if (last_in_stab->stab_io->flags & IOF_ARGV) {
X fp = nextargv(last_in_stab);
X if (fp)
X goto keepgoing;
X do_close(last_in_stab,FALSE);
X last_in_stab->stab_io->flags |= IOF_START;
X }
X else if (argflags & AF_POST) {
X do_close(last_in_stab,FALSE);
X }
X if (fp == stdin) {
X clearerr(fp);
X }
X sarg[anum] = &str_no;
X if (retary) {
X maxarg = anum - 1;
X maxsarg = maxarg + sargoff;
X }
X break;
X }
X else {
X last_in_stab->stab_io->lines++;
X sarg[anum] = str;
X if (argflags & AF_POST) {
X if (str->str_cur > 0)
X str->str_cur--;
X str->str_ptr[str->str_cur] = '\0';
X }
X if (retary) {
X sarg[anum] = str_static(sarg[anum]);
X anum++;
X if (anum > maxarg) {
X maxarg = anum + anum;
X maxsarg = maxarg + sargoff;
X sarg = (STR **)saferealloc((char*)(sarg-sargoff),
X (maxsarg+2+cushion) * sizeof(STR*)) + sargoff;
X }
X goto keepgoing;
X }
X }
X if (retary) {
X maxarg = anum - 1;
X maxsarg = maxarg + sargoff;
X }
X#ifdef DEBUGGING
X tmps = "READ";
X#endif
X break;
X }
X#ifdef DEBUGGING
X if (debug & 8)
X deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
X#endif
X }
X switch (optype) {
X case O_ITEM:
X if (maxarg > arg->arg_len)
X goto array_return;
X if (str != sarg[1])
X str_sset(str,sarg[1]);
X STABSET(str);
X break;
X case O_ITEM2:
X if (str != sarg[--anum])
X str_sset(str,sarg[anum]);
X STABSET(str);
X break;
X case O_ITEM3:
X if (str != sarg[--anum])
X str_sset(str,sarg[anum]);
X STABSET(str);
X break;
X case O_CONCAT:
X if (str != sarg[1])
X str_sset(str,sarg[1]);
X str_scat(str,sarg[2]);
X STABSET(str);
X break;
X case O_REPEAT:
X if (str != sarg[1])
X str_sset(str,sarg[1]);
X anum = (int)str_gnum(sarg[2]);
X if (anum >= 1) {
X tmpstr = str_new(0);
X str_sset(tmpstr,str);
X while (--anum > 0)
X str_scat(str,tmpstr);
X }
X else
X str_sset(str,&str_no);
X STABSET(str);
X break;
X case O_MATCH:
X str_sset(str, do_match(arg,
X retary,sarg,&maxsarg,sargoff,cushion));
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X STABSET(str);
X break;
X case O_NMATCH:
X str_sset(str, do_match(arg,
X retary,sarg,&maxsarg,sargoff,cushion));
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return; /* ignore negation */
X }
X str_set(str, str_true(str) ? No : Yes);
X STABSET(str);
X break;
X case O_SUBST:
X value = (double) do_subst(str, arg);
X str = arg->arg_ptr.arg_str;
X goto donumset;
X case O_NSUBST:
X str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
X str = arg->arg_ptr.arg_str;
X break;
X case O_ASSIGN:
X if (arg[1].arg_flags & AF_SPECIAL)
X do_assign(str,arg,sarg);
X else {
X if (str != sarg[2])
X str_sset(str, sarg[2]);
X STABSET(str);
X }
X break;
X case O_CHOP:
X tmps = str_get(str);
X tmps += str->str_cur - (str->str_cur != 0);
X str_set(arg->arg_ptr.arg_str,tmps); /* remember last char */
X *tmps = '\0'; /* wipe it out */
X str->str_cur = tmps - str->str_ptr;
X str->str_nok = 0;
X str = arg->arg_ptr.arg_str;
X break;
X case O_STUDY:
X value = (double)do_study(str);
X str = arg->arg_ptr.arg_str;
X goto donumset;
X case O_MULTIPLY:
X value = str_gnum(sarg[1]);
X value *= str_gnum(sarg[2]);
X goto donumset;
X case O_DIVIDE:
X if ((value = str_gnum(sarg[2])) == 0.0)
X fatal("Illegal division by zero");
X value = str_gnum(sarg[1]) / value;
X goto donumset;
X case O_MODULO:
X if ((tmplong = (unsigned long) str_gnum(sarg[2])) == 0L)
X fatal("Illegal modulus zero");
X value = str_gnum(sarg[1]);
X value = (double)(((unsigned long)value) % tmplong);
X goto donumset;
X case O_ADD:
X value = str_gnum(sarg[1]);
X value += str_gnum(sarg[2]);
X goto donumset;
X case O_SUBTRACT:
X value = str_gnum(sarg[1]);
X value -= str_gnum(sarg[2]);
X goto donumset;
X case O_LEFT_SHIFT:
X value = str_gnum(sarg[1]);
X anum = (int)str_gnum(sarg[2]);
X value = (double)(((unsigned long)value) << anum);
X goto donumset;
X case O_RIGHT_SHIFT:
X value = str_gnum(sarg[1]);
X anum = (int)str_gnum(sarg[2]);
X value = (double)(((unsigned long)value) >> anum);
X goto donumset;
X case O_LT:
X value = str_gnum(sarg[1]);
X value = (double)(value < str_gnum(sarg[2]));
X goto donumset;
X case O_GT:
X value = str_gnum(sarg[1]);
X value = (double)(value > str_gnum(sarg[2]));
X goto donumset;
X case O_LE:
X value = str_gnum(sarg[1]);
X value = (double)(value <= str_gnum(sarg[2]));
X goto donumset;
X case O_GE:
X value = str_gnum(sarg[1]);
X value = (double)(value >= str_gnum(sarg[2]));
X goto donumset;
X case O_EQ:
X value = str_gnum(sarg[1]);
X value = (double)(value == str_gnum(sarg[2]));
X goto donumset;
X case O_NE:
X value = str_gnum(sarg[1]);
X value = (double)(value != str_gnum(sarg[2]));
X goto donumset;
X case O_BIT_AND:
X value = str_gnum(sarg[1]);
X value = (double)(((unsigned long)value) &
X (unsigned long)str_gnum(sarg[2]));
X goto donumset;
X case O_XOR:
X value = str_gnum(sarg[1]);
X value = (double)(((unsigned long)value) ^
X (unsigned long)str_gnum(sarg[2]));
X goto donumset;
X case O_BIT_OR:
X value = str_gnum(sarg[1]);
X value = (double)(((unsigned long)value) |
X (unsigned long)str_gnum(sarg[2]));
X goto donumset;
X case O_AND:
X if (str_true(sarg[1])) {
X anum = 2;
X optype = O_ITEM2;
X argflags = arg[anum].arg_flags;
X argtype = arg[anum].arg_type;
X argptr = arg[anum].arg_ptr;
X maxarg = anum = 1;
X goto re_eval;
X }
X else {
X if (assigning) {
X str_sset(str, sarg[1]);
X STABSET(str);
X }
X else
X str = sarg[1];
X break;
X }
X case O_OR:
X if (str_true(sarg[1])) {
X if (assigning) {
X str_sset(str, sarg[1]);
X STABSET(str);
X }
X else
X str = sarg[1];
X break;
X }
X else {
X anum = 2;
X optype = O_ITEM2;
X argflags = arg[anum].arg_flags;
X argtype = arg[anum].arg_type;
X argptr = arg[anum].arg_ptr;
X maxarg = anum = 1;
X goto re_eval;
X }
X case O_COND_EXPR:
X anum = (str_true(sarg[1]) ? 2 : 3);
X optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
X argflags = arg[anum].arg_flags;
X argtype = arg[anum].arg_type;
X argptr = arg[anum].arg_ptr;
X maxarg = anum = 1;
X goto re_eval;
X case O_COMMA:
X str = sarg[2];
X break;
X case O_NEGATE:
X value = -str_gnum(sarg[1]);
X goto donumset;
X case O_NOT:
X value = (double) !str_true(sarg[1]);
X goto donumset;
X case O_COMPLEMENT:
X value = (double) ~(long)str_gnum(sarg[1]);
X goto donumset;
X case O_SELECT:
X if (arg[1].arg_type == A_LVAL)
X defoutstab = arg[1].arg_ptr.arg_stab;
X else
X defoutstab = stabent(str_get(sarg[1]),TRUE);
X if (!defoutstab->stab_io)
X defoutstab->stab_io = stio_new();
X curoutstab = defoutstab;
X str_set(str,curoutstab->stab_io->fp ? Yes : No);
X STABSET(str);
X break;
X case O_WRITE:
X if (maxarg == 0)
X stab = defoutstab;
X else if (arg[1].arg_type == A_LVAL)
X stab = arg[1].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[1]),TRUE);
X if (!stab->stab_io) {
X str_set(str, No);
X STABSET(str);
X break;
X }
X curoutstab = stab;
X fp = stab->stab_io->fp;
X debarg = arg;
X if (stab->stab_io->fmt_stab)
X form = stab->stab_io->fmt_stab->stab_form;
X else
X form = stab->stab_form;
X if (!form || !fp) {
X str_set(str, No);
X STABSET(str);
X break;
X }
X format(&outrec,form);
X do_write(&outrec,stab->stab_io);
X if (stab->stab_io->flags & IOF_FLUSH)
X fflush(fp);
X str_set(str, Yes);
X STABSET(str);
X break;
X case O_OPEN:
X if (arg[1].arg_type == A_WORD)
X stab = arg[1].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[1]),TRUE);
X if (do_open(stab,str_get(sarg[2]))) {
X value = (double)forkprocess;
X stab->stab_io->lines = 0;
X goto donumset;
X }
X else
X str_set(str, No);
X STABSET(str);
X break;
X case O_TRANS:
X value = (double) do_trans(str,arg);
X str = arg->arg_ptr.arg_str;
X goto donumset;
X case O_NTRANS:
X str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
X str = arg->arg_ptr.arg_str;
X break;
X case O_CLOSE:
X if (arg[1].arg_type == A_WORD)
X stab = arg[1].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[1]),TRUE);
X str_set(str, do_close(stab,TRUE) ? Yes : No );
X STABSET(str);
X break;
X case O_EACH:
X str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,
X retary,sarg,&maxsarg,sargoff,cushion));
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X STABSET(str);
X break;
X case O_VALUES:
X case O_KEYS:
X value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash, optype,
X retary,sarg,&maxsarg,sargoff,cushion);
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X goto donumset;
X case O_ARRAY:
X if (maxarg == 1) {
X ary = arg[1].arg_ptr.arg_stab->stab_array;
X maxarg = ary->ary_fill;
X maxsarg = maxarg + sargoff;
X if (retary) { /* array wanted */
X sarg = (STR **)saferealloc((char*)(sarg-sargoff),
X (maxsarg+3+cushion)*sizeof(STR*)) + sargoff;
X for (anum = 0; anum <= maxarg; anum++) {
X sarg[anum+1] = str = afetch(ary,anum);
X }
X maxarg++;
X maxsarg++;
X goto array_return;
X }
X else
X str = afetch(ary,maxarg);
X }
X else
X str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
X ((int)str_gnum(sarg[1])) - arybase);
X if (!str)
X str = &str_no;
X break;
X case O_DELETE:
X tmpstab = arg[2].arg_ptr.arg_stab; /* XXX */
X str = hdelete(tmpstab->stab_hash,str_get(sarg[1]));
X if (!str)
X str = &str_no;
X break;
X case O_HASH:
X tmpstab = arg[2].arg_ptr.arg_stab; /* XXX */
X str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
X if (!str)
X str = &str_no;
X break;
X case O_LARRAY:
X anum = ((int)str_gnum(sarg[1])) - arybase;
X str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
X if (!str || str == &str_no) {
X str = str_new(0);
X astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
X }
X break;
X case O_LHASH:
X tmpstab = arg[2].arg_ptr.arg_stab;
X str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
X if (!str) {
X str = str_new(0);
X hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
X }
X if (tmpstab == envstab) { /* heavy wizardry going on here */
X str->str_link.str_magic = tmpstab;/* str is now magic */
X envname = savestr(str_get(sarg[1]));
X /* he threw the brick up into the air */
X }
X else if (tmpstab == sigstab) { /* same thing, only different */
X str->str_link.str_magic = tmpstab;
X signame = savestr(str_get(sarg[1]));
X }
X break;
X case O_PUSH:
X if (arg[1].arg_flags & AF_SPECIAL)
X str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
X else {
X str = str_new(0); /* must copy the STR */
X str_sset(str,sarg[1]);
X apush(arg[2].arg_ptr.arg_stab->stab_array,str);
X }
X break;
X case O_POP:
X str = apop(arg[1].arg_ptr.arg_stab->stab_array);
X if (!str) {
X str = &str_no;
X break;
X }
X#ifdef STRUCTCOPY
X *(arg->arg_ptr.arg_str) = *str;
X#else
X bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
X#endif
X safefree((char*)str);
X str = arg->arg_ptr.arg_str;
X break;
X case O_SHIFT:
X str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
X if (!str) {
X str = &str_no;
X break;
X }
X#ifdef STRUCTCOPY
X *(arg->arg_ptr.arg_str) = *str;
X#else
X bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
X#endif
X safefree((char*)str);
X str = arg->arg_ptr.arg_str;
X break;
X case O_SPLIT:
X value = (double) do_split(arg[2].arg_ptr.arg_spat,
X retary,sarg,&maxsarg,sargoff,cushion);
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X goto donumset;
X case O_LENGTH:
X value = (double) str_len(sarg[1]);
X goto donumset;
X case O_SPRINTF:
X sarg[maxsarg+1] = Nullstr;
X do_sprintf(str,arg->arg_len,sarg);
X break;
X case O_SUBSTR:
X anum = ((int)str_gnum(sarg[2])) - arybase;
X for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
X anum = (int)str_gnum(sarg[3]);
X if (anum >= 0 && strlen(tmps) > anum)
X str_nset(str, tmps, anum);
X else
X str_set(str, tmps);
X break;
X case O_JOIN:
X if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
X do_join(arg,str_get(sarg[1]),str);
X else
X ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
X break;
X case O_SLT:
X tmps = str_get(sarg[1]);
X value = (double) strLT(tmps,str_get(sarg[2]));
X goto donumset;
X case O_SGT:
X tmps = str_get(sarg[1]);
X value = (double) strGT(tmps,str_get(sarg[2]));
X goto donumset;
X case O_SLE:
X tmps = str_get(sarg[1]);
X value = (double) strLE(tmps,str_get(sarg[2]));
X goto donumset;
X case O_SGE:
X tmps = str_get(sarg[1]);
X value = (double) strGE(tmps,str_get(sarg[2]));
X goto donumset;
X case O_SEQ:
X tmps = str_get(sarg[1]);
X value = (double) strEQ(tmps,str_get(sarg[2]));
X goto donumset;
X case O_SNE:
X tmps = str_get(sarg[1]);
X value = (double) strNE(tmps,str_get(sarg[2]));
X goto donumset;
X case O_SUBR:
X str_sset(str,do_subr(arg,sarg));
X STABSET(str);
X break;
X case O_SORT:
X if (maxarg <= 1)
X stab = defoutstab;
X else {
X if (arg[2].arg_type == A_WORD)
X stab = arg[2].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[2]),TRUE);
X if (!stab)
X stab = defoutstab;
X }
X value = (double)do_sort(arg,stab,
X retary,sarg,&maxsarg,sargoff,cushion);
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X goto donumset;
X case O_PRTF:
X case O_PRINT:
X if (maxarg <= 1)
X stab = defoutstab;
X else {
X if (arg[2].arg_type == A_WORD)
X stab = arg[2].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[2]),TRUE);
X if (!stab)
X stab = defoutstab;
X }
X if (!stab->stab_io || !(fp = stab->stab_io->fp))
X value = 0.0;
X else {
X if (arg[1].arg_flags & AF_SPECIAL)
X value = (double)do_aprint(arg,fp);
X else {
X value = (double)do_print(sarg[1],fp);
X if (ors && optype == O_PRINT)
X fputs(ors, fp);
X }
X if (stab->stab_io->flags & IOF_FLUSH)
X fflush(fp);
X }
X goto donumset;
X case O_CHDIR:
X tmps = str_get(sarg[1]);
X if (!tmps || !*tmps)
X tmps = getenv("HOME");
X if (!tmps || !*tmps)
X tmps = getenv("LOGDIR");
X value = (double)(chdir(tmps) >= 0);
X goto donumset;
X case O_DIE:
X tmps = str_get(sarg[1]);
X if (!tmps || !*tmps)
X exit(1);
X fatal("%s",str_get(sarg[1]));
X value = 0.0;
X goto donumset;
X case O_EXIT:
X exit((int)str_gnum(sarg[1]));
X value = 0.0;
X goto donumset;
X case O_RESET:
X str_reset(str_get(sarg[1]));
X value = 1.0;
X goto donumset;
X case O_LIST:
X if (arg->arg_flags & AF_LOCAL)
X savelist(sarg,maxsarg);
X if (maxarg > 0)
X str = sarg[maxsarg]; /* unwanted list, return last item */
X else
X str = &str_no;
X if (retary)
X goto array_return;
X break;
X case O_EOF:
X if (maxarg <= 0)
X stab = last_in_stab;
X else if (arg[1].arg_type == A_WORD)
X stab = arg[1].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[1]),TRUE);
X str_set(str, do_eof(stab) ? Yes : No);
X STABSET(str);
X break;
X case O_TELL:
X if (maxarg <= 0)
X stab = last_in_stab;
X else if (arg[1].arg_type == A_WORD)
X stab = arg[1].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[1]),TRUE);
X value = (double)do_tell(stab);
X goto donumset;
X case O_SEEK:
X if (arg[1].arg_type == A_WORD)
X stab = arg[1].arg_ptr.arg_stab;
X else
X stab = stabent(str_get(sarg[1]),TRUE);
X value = str_gnum(sarg[2]);
X str_set(str, do_seek(stab,
X (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
X STABSET(str);
X break;
X case O_REDO:
X case O_NEXT:
X case O_LAST:
X if (maxarg > 0) {
X tmps = str_get(sarg[1]);
X while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
X strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
X#ifdef DEBUGGING
X if (debug & 4) {
X deb("(Skipping label #%d %s)\n",loop_ptr,
X loop_stack[loop_ptr].loop_label);
X }
X#endif
X loop_ptr--;
X }
X#ifdef DEBUGGING
X if (debug & 4) {
X deb("(Found label #%d %s)\n",loop_ptr,
X loop_stack[loop_ptr].loop_label);
X }
X#endif
X }
X if (loop_ptr < 0)
X fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
X longjmp(loop_stack[loop_ptr].loop_env, optype);
X case O_GOTO:/* shudder */
X goto_targ = str_get(sarg[1]);
X longjmp(top_env, 1);
X case O_INDEX:
X tmps = str_get(sarg[1]);
X if (!(tmps2 = fbminstr(tmps, tmps + sarg[1]->str_cur, sarg[2])))
X value = (double)(-1 + arybase);
X else
X value = (double)(tmps2 - tmps + arybase);
X goto donumset;
X case O_TIME:
X value = (double) time(Null(long*));
X goto donumset;
X case O_TMS:
X value = (double) do_tms(retary,sarg,&maxsarg,sargoff,cushion);
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X goto donumset;
X case O_LOCALTIME:
X when = (long)str_gnum(sarg[1]);
X value = (double)do_time(localtime(&when),
X retary,sarg,&maxsarg,sargoff,cushion);
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X goto donumset;
X case O_GMTIME:
X when = (long)str_gnum(sarg[1]);
X value = (double)do_time(gmtime(&when),
X retary,sarg,&maxsarg,sargoff,cushion);
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X goto donumset;
X case O_STAT:
X value = (double) do_stat(arg,
X retary,sarg,&maxsarg,sargoff,cushion);
X if (retary) {
X sarg = *retary; /* they realloc it */
X goto array_return;
X }
X goto donumset;
X case O_CRYPT:
X#ifdef CRYPT
X tmps = str_get(sarg[1]);
X str_set(str,crypt(tmps,str_get(sarg[2])));
X#else
X fatal(
X "The crypt() function is unimplemented due to excessive paranoia.");
X#endif
X break;
X case O_EXP:
X value = exp(str_gnum(sarg[1]));
X goto donumset;
X case O_LOG:
X value = log(str_gnum(sarg[1]));
X goto donumset;
X case O_SQRT:
X value = sqrt(str_gnum(sarg[1]));
X goto donumset;
X case O_INT:
X value = str_gnum(sarg[1]);
X if (value >= 0.0)
X modf(value,&value);
X else {
X modf(-value,&value);
X value = -value;
X }
X goto donumset;
X case O_ORD:
X value = (double) *str_get(sarg[1]);
X goto donumset;
X case O_SLEEP:
X tmps = str_get(sarg[1]);
X time(&when);
X if (!tmps || !*tmps)
X sleep((32767<<16)+32767);
X else
X sleep((unsigned)atoi(tmps));
X value = (double)when;
X time(&when);
X value = ((double)when) - value;
X goto donumset;
X case O_FLIP:
X if (str_true(sarg[1])) {
X str_numset(str,0.0);
X anum = 2;
X arg->arg_type = optype = O_FLOP;
X arg[2].arg_flags &= ~AF_SPECIAL;
X arg[1].arg_flags |= AF_SPECIAL;
X argflags = arg[2].arg_flags;
X argtype = arg[2].arg_type;
X argptr = arg[2].arg_ptr;
X goto re_eval;
X }
X str_set(str,"");
X break;
X case O_FLOP:
X str_inc(str);
X if (str_true(sarg[2])) {
X arg->arg_type = O_FLIP;
X arg[1].arg_flags &= ~AF_SPECIAL;
X arg[2].arg_flags |= AF_SPECIAL;
X str_cat(str,"E0");
X }
X break;
X case O_FORK:
X value = (double)fork();
X goto donumset;
X case O_WAIT:
X ihand = signal(SIGINT, SIG_IGN);
X qhand = signal(SIGQUIT, SIG_IGN);
X value = (double)wait(&argflags);
X signal(SIGINT, ihand);
X signal(SIGQUIT, qhand);
X statusvalue = (unsigned short)argflags;
X goto donumset;
X case O_SYSTEM:
X while ((anum = vfork()) == -1) {
X if (errno != EAGAIN) {
X value = -1.0;
X goto donumset;
X }
X sleep(5);
X }
X if (anum > 0) {
X ihand = signal(SIGINT, SIG_IGN);
X qhand = signal(SIGQUIT, SIG_IGN);
X while ((argtype = wait(&argflags)) != anum && argtype != -1)
X ;
X signal(SIGINT, ihand);
X signal(SIGQUIT, qhand);
X statusvalue = (unsigned short)argflags;
X if (argtype == -1)
X value = -1.0;
X else {
X value = (double)((unsigned int)argflags & 0xffff);
X }
X goto donumset;
X }
X if (arg[1].arg_flags & AF_SPECIAL)
X value = (double)do_aexec(arg);
X else {
X value = (double)do_exec(str_static(sarg[1]));
X }
X _exit(-1);
X case O_EXEC:
X if (arg[1].arg_flags & AF_SPECIAL)
X value = (double)do_aexec(arg);
X else {
X value = (double)do_exec(str_static(sarg[1]));
X }
X goto donumset;
X case O_HEX:
X argtype = 4;
X goto snarfnum;
X
X case O_OCT:
X argtype = 3;
X
X snarfnum:
X anum = 0;
X tmps = str_get(sarg[1]);
X for (;;) {
X switch (*tmps) {
X default:
X goto out;
X case '8': case '9':
X if (argtype != 4)
X goto out;
X /* FALL THROUGH */
X case '0': case '1': case '2': case '3': case '4':
X case '5': case '6': case '7':
X anum <<= argtype;
X anum += *tmps++ & 15;
X break;
X case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X if (argtype != 4)
X goto out;
X anum <<= 4;
X anum += (*tmps++ & 7) + 9;
X break;
X case 'x':
X argtype = 4;
X tmps++;
X break;
X }
X }
X out:
X value = (double)anum;
X goto donumset;
X case O_CHMOD:
X case O_CHOWN:
X case O_KILL:
X case O_UNLINK:
X case O_UTIME:
X if (arg[1].arg_flags & AF_SPECIAL)
X value = (double)apply(optype,arg,Null(STR**));
X else {
X sarg[2] = Nullstr;
X value = (double)apply(optype,arg,sarg);
X }
X goto donumset;
X case O_UMASK:
X value = (double)umask((int)str_gnum(sarg[1]));
X goto donumset;
X case O_RENAME:
X tmps = str_get(sarg[1]);
X#ifdef RENAME
X value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
X#else
X tmps2 = str_get(sarg[2]);
X if (euid || stat(tmps2,&statbuf) < 0 ||
X (statbuf.st_mode & S_IFMT) != S_IFDIR )
X UNLINK(tmps2); /* avoid unlinking a directory */
X if (!(anum = link(tmps,tmps2)))
X anum = UNLINK(tmps);
X value = (double)(anum >= 0);
X#endif
X goto donumset;
X case O_LINK:
X tmps = str_get(sarg[1]);
X value = (double)(link(tmps,str_get(sarg[2])) >= 0);
X goto donumset;
X case O_UNSHIFT:
X ary = arg[2].arg_ptr.arg_stab->stab_array;
X if (arg[1].arg_flags & AF_SPECIAL)
X do_unshift(arg,ary);
X else {
X str = str_new(0); /* must copy the STR */
X str_sset(str,sarg[1]);
X aunshift(ary,1);
X astore(ary,0,str);
X }
X value = (double)(ary->ary_fill + 1);
X break;
X case O_DOFILE:
X case O_EVAL:
X str_sset(str,
X do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val,
X optype) );
X STABSET(str);
X break;
X
X case O_FTRREAD:
X argtype = 0;
X anum = S_IREAD;
X goto check_perm;
X case O_FTRWRITE:
X argtype = 0;
X anum = S_IWRITE;
X goto check_perm;
X case O_FTREXEC:
X argtype = 0;
X anum = S_IEXEC;
X goto check_perm;
X case O_FTEREAD:
X argtype = 1;
X anum = S_IREAD;
X goto check_perm;
X case O_FTEWRITE:
X argtype = 1;
X anum = S_IWRITE;
X goto check_perm;
X case O_FTEEXEC:
X argtype = 1;
X anum = S_IEXEC;
X check_perm:
X str = &str_no;
X if (mystat(arg,sarg[1]) < 0)
X break;
X if (cando(anum,argtype))
X str = &str_yes;
X break;
X
X case O_FTIS:
X if (mystat(arg,sarg[1]) >= 0)
X str = &str_yes;
X else
X str = &str_no;
X break;
X case O_FTEOWNED:
X case O_FTROWNED:
X if (mystat(arg,sarg[1]) >= 0 &&
X statbuf.st_uid == (optype == O_FTEOWNED ? euid : uid) )
X str = &str_yes;
X else
X str = &str_no;
X break;
X case O_FTZERO:
X if (mystat(arg,sarg[1]) >= 0 && !statbuf.st_size)
X str = &str_yes;
X else
X str = &str_no;
X break;
X case O_FTSIZE:
X if (mystat(arg,sarg[1]) >= 0 && statbuf.st_size)
X str = &str_yes;
X else
X str = &str_no;
X break;
X
X case O_FTSOCK:
X#ifdef S_IFSOCK
X anum = S_IFSOCK;
X goto check_file_type;
X#else
X str = &str_no;
X break;
X#endif
X case O_FTCHR:
X anum = S_IFCHR;
X goto check_file_type;
X case O_FTBLK:
X anum = S_IFBLK;
X goto check_file_type;
X case O_FTFILE:
X anum = S_IFREG;
X goto check_file_type;
X case O_FTDIR:
X anum = S_IFDIR;
X check_file_type:
X if (mystat(arg,sarg[1]) >= 0 &&
X (statbuf.st_mode & S_IFMT) == anum )
X str = &str_yes;
X else
X str = &str_no;
X break;
X case O_FTPIPE:
X#ifdef S_IFIFO
X anum = S_IFIFO;
X goto check_file_type;
X#else
X str = &str_no;
X break;
X#endif
X case O_FTLINK:
X#ifdef S_IFLNK
X if (lstat(str_get(sarg[1]),&statbuf) >= 0 &&
X (statbuf.st_mode & S_IFMT) == S_IFLNK )
X str = &str_yes;
X else
X#endif
X str = &str_no;
X break;
X case O_SYMLINK:
X#ifdef SYMLINK
X tmps = str_get(sarg[1]);
X value = (double)(symlink(tmps,str_get(sarg[2])) >= 0);
X goto donumset;
X#else
X fatal("Unsupported function symlink()");
X#endif
X case O_FTSUID:
X anum = S_ISUID;
X goto check_xid;
X case O_FTSGID:
X anum = S_ISGID;
X goto check_xid;
X case O_FTSVTX:
X anum = S_ISVTX;
X check_xid:
X if (mystat(arg,sarg[1]) >= 0 && statbuf.st_mode & anum)
X str = &str_yes;
X else
X str = &str_no;
X break;
X case O_FTTTY:
X if (arg[1].arg_flags & AF_SPECIAL) {
X stab = arg[1].arg_ptr.arg_stab;
X tmps = "";
X }
X else
X stab = stabent(tmps = str_get(sarg[1]),FALSE);
X if (stab && stab->stab_io && stab->stab_io->fp)
X anum = fileno(stab->stab_io->fp);
X else if (isdigit(*tmps))
X anum = atoi(tmps);
X else
X anum = -1;
X if (isatty(anum))
X str = &str_yes;
X else
X str = &str_no;
X break;
X case O_FTTEXT:
X case O_FTBINARY:
X str = do_fttext(arg,sarg[1]);
X break;
X }
X if (retary) {
X sarg[1] = str;
X maxsarg = sargoff + 1;
X }
X#ifdef DEBUGGING
X if (debug) {
X dlevel--;
X if (debug & 8)
X deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
X }
X#endif
X goto freeargs;
X
Xarray_return:
X#ifdef DEBUGGING
X if (debug) {
X dlevel--;
X if (debug & 8)
X deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],maxsarg-sargoff);
X }
X#endif
X goto freeargs;
X
Xdonumset:
X str_numset(str,value);
X STABSET(str);
X if (retary) {
X sarg[1] = str;
X maxsarg = sargoff + 1;
X }
X#ifdef DEBUGGING
X if (debug) {
X dlevel--;
X if (debug & 8)
X deb("%s RETURNS \"%f\"\n",opname[optype],value);
X }
X#endif
X
Xfreeargs:
X sarg -= sargoff;
X if (sarg != quicksarg) {
X if (retary) {
X sarg[0] = &str_args;
X str_numset(sarg[0], (double)(maxsarg));
X sarg[maxsarg+1] = Nullstr;
X *retary = sarg; /* up to them to free it */
X }
X else
X safefree((char*)sarg);
X }
X return str;
X}
X
Xint
Xingroup(gid,effective)
Xint gid;
Xint effective;
X{
X if (gid == (effective ? getegid() : getgid()))
X return TRUE;
X#ifdef GETGROUPS
X#ifndef NGROUPS
X#define NGROUPS 32
X#endif
X {
X GIDTYPE gary[NGROUPS];
X int anum;
X
X anum = getgroups(NGROUPS,gary);
X while (--anum >= 0)
X if (gary[anum] == gid)
X return TRUE;
X }
X#endif
X return FALSE;
X}
X
X/* Do the permissions allow some operation? Assumes statbuf already set. */
X
Xint
Xcando(bit, effective)
Xint bit;
Xint effective;
X{
X if ((effective ? euid : uid) == 0) { /* root is special */
X if (bit == S_IEXEC) {
X if (statbuf.st_mode & 0111 ||
X (statbuf.st_mode & S_IFMT) == S_IFDIR )
X return TRUE;
X }
X else
X return TRUE; /* root reads and writes anything */
X return FALSE;
X }
X if (statbuf.st_uid == (effective ? euid : uid) ) {
X if (statbuf.st_mode & bit)
X return TRUE; /* ok as "user" */
X }
X else if (ingroup((int)statbuf.st_gid,effective)) {
X if (statbuf.st_mode & bit >> 3)
X return TRUE; /* ok as "group" */
X }
X else if (statbuf.st_mode & bit >> 6)
X return TRUE; /* ok as "other" */
X return FALSE;
X}
!STUFFY!FUNK!
echo Extracting util.c
sed >util.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: util.c,v 2.0 88/06/05 00:15:11 root Exp $
X *
X * $Log: util.c,v $
X * Revision 2.0 88/06/05 00:15:11 root
X * Baseline version 2.0.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#define FLUSH
X
Xstatic char nomem[] = "Out of memory!\n";
X
X/* paranoid version of malloc */
X
X#ifdef DEBUGGING
Xstatic int an = 0;
X#endif
X
Xchar *
Xsafemalloc(size)
XMEM_SIZE size;
X{
X char *ptr;
X char *malloc();
X
X ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
X#ifdef DEBUGGING
X if (debug & 128)
X fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
X#endif
X if (ptr != Nullch)
X return ptr;
X else {
X fputs(nomem,stdout) FLUSH;
X exit(1);
X }
X /*NOTREACHED*/
X}
X
X/* paranoid version of realloc */
X
Xchar *
Xsaferealloc(where,size)
Xchar *where;
XMEM_SIZE size;
X{
X char *ptr;
X char *realloc();
X
X if (!where)
X fatal("Null realloc");
X ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
X#ifdef DEBUGGING
X if (debug & 128) {
X fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
X fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
X }
X#endif
X if (ptr != Nullch)
X return ptr;
X else {
X fputs(nomem,stdout) FLUSH;
X exit(1);
X }
X /*NOTREACHED*/
X}
X
X/* safe version of free */
X
Xsafefree(where)
Xchar *where;
X{
X#ifdef DEBUGGING
X if (debug & 128)
X fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
X#endif
X if (where) {
X free(where);
X }
X}
X
X#ifdef NOTDEF
X/* safe version of string copy */
X
Xchar *
Xsafecpy(to,from,len)
Xchar *to;
Xregister char *from;
Xregister int len;
X{
X register char *dest = to;
X
X if (from != Nullch)
X for (len--; len && (*dest++ = *from++); len--) ;
X *dest = '\0';
X return to;
X}
X#endif /*NOTDEF*/
X
X#ifdef undef
X/* safe version of string concatenate, with \n deletion and space padding */
X
Xchar *
Xsafecat(to,from,len)
Xchar *to;
Xregister char *from;
Xregister int len;
X{
X register char *dest = to;
X
X len--; /* leave room for null */
X if (*dest) {
X while (len && *dest++) len--;
X if (len) {
X len--;
X *(dest-1) = ' ';
X }
X }
X if (from != Nullch)
X while (len && (*dest++ = *from++)) len--;
X if (len)
X dest--;
X if (*(dest-1) == '\n')
X dest--;
X *dest = '\0';
X return to;
X}
X#endif
X
X/* copy a string up to some (non-backslashed) delimiter, if any */
X
Xchar *
Xcpytill(to,from,delim)
Xregister char *to, *from;
Xregister int delim;
X{
X for (; *from; from++,to++) {
X if (*from == '\\') {
X if (from[1] == delim)
X from++;
X else if (from[1] == '\\')
X *to++ = *from++;
X }
X else if (*from == delim)
X break;
X *to = *from;
X }
X *to = '\0';
X return from;
X}
X
X/* return ptr to little string in big string, NULL if not found */
X/* This routine was donated by Corey Satten. */
X
Xchar *
Xinstr(big, little)
Xregister char *big;
Xregister char *little;
X{
X register char *s, *x;
X register int first = *little++;
X
X if (!first)
X return big;
X while (*big) {
X if (*big++ != first)
X continue;
X for (x=big,s=little; *s; /**/ ) {
X if (!*x)
X return Nullch;
X if (*s++ != *x++) {
X s--;
X break;
X }
X }
X if (!*s)
X return big-1;
X }
X return Nullch;
X}
X
X#ifdef NOTDEF
Xvoid
Xbmcompile(str)
XSTR *str;
X{
X register char *s;
X register char *table;
X register int i;
X register int len = str->str_cur;
X
X str_grow(str,len+128);
X s = str->str_ptr;
X table = s + len;
X for (i = 1; i < 128; i++) {
X table[i] = len;
X }
X i = 0;
X while (*s) {
X if (!isascii(*s))
X return;
X if (table[*s] == len)
X table[*s] = i;
X s++,i++;
X }
X str->str_pok |= 2; /* deep magic */
X}
X#endif /* NOTDEF */
X
Xstatic unsigned char freq[] = {
X 1, 2, 84, 151, 154, 155, 156, 157,
X 165, 246, 250, 3, 158, 7, 18, 29,
X 40, 51, 62, 73, 85, 96, 107, 118,
X 129, 140, 147, 148, 149, 150, 152, 153,
X 255, 182, 224, 205, 174, 176, 180, 217,
X 233, 232, 236, 187, 235, 228, 234, 226,
X 222, 219, 211, 195, 188, 193, 185, 184,
X 191, 183, 201, 229, 181, 220, 194, 162,
X 163, 208, 186, 202, 200, 218, 198, 179,
X 178, 214, 166, 170, 207, 199, 209, 206,
X 204, 160, 212, 216, 215, 192, 175, 173,
X 243, 172, 161, 190, 203, 189, 164, 230,
X 167, 248, 227, 244, 242, 255, 241, 231,
X 240, 253, 169, 210, 245, 237, 249, 247,
X 239, 168, 252, 251, 254, 238, 223, 221,
X 213, 225, 177, 197, 171, 196, 159, 4,
X 5, 6, 8, 9, 10, 11, 12, 13,
X 14, 15, 16, 17, 19, 20, 21, 22,
X 23, 24, 25, 26, 27, 28, 30, 31,
X 32, 33, 34, 35, 36, 37, 38, 39,
X 41, 42, 43, 44, 45, 46, 47, 48,
X 49, 50, 52, 53, 54, 55, 56, 57,
X 58, 59, 60, 61, 63, 64, 65, 66,
X 67, 68, 69, 70, 71, 72, 74, 75,
X 76, 77, 78, 79, 80, 81, 82, 83,
X 86, 87, 88, 89, 90, 91, 92, 93,
X 94, 95, 97, 98, 99, 100, 101, 102,
X 103, 104, 105, 106, 108, 109, 110, 111,
X 112, 113, 114, 115, 116, 117, 119, 120,
X 121, 122, 123, 124, 125, 126, 127, 128,
X 130, 131, 132, 133, 134, 135, 136, 137,
X 138, 139, 141, 142, 143, 144, 145, 146
X};
X
Xvoid
Xfbmcompile(str)
XSTR *str;
X{
X register char *s;
X register char *table;
X register int i;
X register int len = str->str_cur;
X int rarest = 0;
X int frequency = 256;
X
X str_grow(str,len+128);
X table = str->str_ptr + len; /* actually points at final '\0' */
X s = table - 1;
X for (i = 1; i < 128; i++) {
X table[i] = len;
X }
X i = 0;
X while (s >= str->str_ptr) {
X if (!isascii(*s))
X return;
X if (table[*s] == len)
X table[*s] = i;
X s--,i++;
X }
X str->str_pok |= 2; /* deep magic */
X
X s = str->str_ptr; /* deeper magic */
X for (i = 0; i < len; i++) {
X if (freq[s[i]] < frequency) {
X rarest = i;
X frequency = freq[s[i]];
X }
X }
X str->str_rare = s[rarest];
X str->str_prev = rarest;
X#ifdef DEBUGGING
X if (debug & 512)
X fprintf(stderr,"rarest char %c at %d\n",str->str_rare, str->str_prev);
X#endif
X}
X
X#ifdef NOTDEF
Xchar *
Xbminstr(big, biglen, littlestr)
Xregister char *big;
Xint biglen;
XSTR *littlestr;
X{
X register char *s;
X register int tmp;
X register char *little = littlestr->str_ptr;
X int littlelen = littlestr->str_cur;
X register char *table = little + littlelen;
X
X s = big + biglen - littlelen;
X while (s >= big) {
X if (tmp = table[*s]) {
X s -= tmp;
X }
X else {
X if (strnEQ(s,little,littlelen))
X return s;
X s--;
X }
X }
X return Nullch;
X}
X#endif /* NOTDEF */
X
Xchar *
Xfbminstr(big, bigend, littlestr)
Xchar *big;
Xregister char *bigend;
XSTR *littlestr;
X{
X register char *s;
X register int tmp;
X register int littlelen;
X register char *little;
X register char *table;
X register char *olds;
X register char *oldlittle;
X register int min;
X char *screaminstr();
X
X if (littlestr->str_pok != 3)
X return instr(big,littlestr->str_ptr);
X
X littlelen = littlestr->str_cur;
X table = littlestr->str_ptr + littlelen;
X s = big + --littlelen;
X oldlittle = little = table - 1;
X while (s < bigend) {
X top:
X if (tmp = table[*s]) {
X s += tmp;
X }
X else {
X tmp = littlelen; /* less expensive than calling strncmp() */
X olds = s;
X while (tmp--) {
X if (*--s == *--little)
X continue;
X s = olds + 1; /* here we pay the price for failure */
X little = oldlittle;
X if (s < bigend) /* fake up continue to outer loop */
X goto top;
X return Nullch;
X }
X return s;
X }
X }
X return Nullch;
X}
X
Xchar *
Xscreaminstr(bigstr, littlestr)
XSTR *bigstr;
XSTR *littlestr;
X{
X register char *s, *x;
X register char *big = bigstr->str_ptr;
X register int pos;
X register int previous;
X register int first;
X register char *little;
X
X if ((pos = screamfirst[littlestr->str_rare]) < 0)
X return Nullch;
X little = littlestr->str_ptr;
X first = *little++;
X previous = littlestr->str_prev;
X big -= previous;
X while (pos < previous) {
X if (!(pos += screamnext[pos]))
X return Nullch;
X }
X do {
X if (big[pos] != first)
X continue;
X for (x=big+pos+1,s=little; *s; /**/ ) {
X if (!*x)
X return Nullch;
X if (*s++ != *x++) {
X s--;
X break;
X }
X }
X if (!*s)
X return big+pos;
X } while (pos += screamnext[pos]);
X return Nullch;
X}
X
X/* copy a string to a safe spot */
X
Xchar *
Xsavestr(str)
Xchar *str;
X{
X register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1));
X
X (void)strcpy(newaddr,str);
X return newaddr;
X}
X
X/* grow a static string to at least a certain length */
X
Xvoid
Xgrowstr(strptr,curlen,newlen)
Xchar **strptr;
Xint *curlen;
Xint newlen;
X{
X if (newlen > *curlen) { /* need more room? */
X if (*curlen)
X *strptr = saferealloc(*strptr,(MEM_SIZE)newlen);
X else
X *strptr = safemalloc((MEM_SIZE)newlen);
X *curlen = newlen;
X }
X}
X
Xextern int errno;
X
X/*VARARGS1*/
Xmess(pat,a1,a2,a3,a4)
Xchar *pat;
X{
X char *s;
X
X s = tokenbuf;
X sprintf(s,pat,a1,a2,a3,a4);
X s += strlen(s);
X if (s[-1] != '\n') {
X if (line) {
X sprintf(s," at %s line %ld",
X in_eval?filename:origfilename, (long)line);
X s += strlen(s);
X }
X if (last_in_stab &&
X last_in_stab->stab_io &&
X last_in_stab->stab_io->lines ) {
X sprintf(s,", <%s> line %ld",
X last_in_stab == argvstab ? "" : last_in_stab->stab_name,
X (long)last_in_stab->stab_io->lines);
X s += strlen(s);
X }
X strcpy(s,".\n");
X }
X}
X
X/*VARARGS1*/
Xfatal(pat,a1,a2,a3,a4)
Xchar *pat;
X{
X extern FILE *e_fp;
X extern char *e_tmpname;
X
X mess(pat,a1,a2,a3,a4);
X if (in_eval) {
X str_set(stabent("@",TRUE)->stab_val,tokenbuf);
X longjmp(eval_env,1);
X }
X fputs(tokenbuf,stderr);
X fflush(stderr);
X if (e_fp)
X UNLINK(e_tmpname);
X statusvalue >>= 8;
X exit(errno?errno:(statusvalue?statusvalue:255));
X}
X
X/*VARARGS1*/
Xwarn(pat,a1,a2,a3,a4)
Xchar *pat;
X{
X mess(pat,a1,a2,a3,a4);
X fputs(tokenbuf,stderr);
X fflush(stderr);
X}
X
Xstatic bool firstsetenv = TRUE;
Xextern char **environ;
X
Xvoid
Xsetenv(nam,val)
Xchar *nam, *val;
X{
X register int i=envix(nam); /* where does it go? */
X
X if (!environ[i]) { /* does not exist yet */
X if (firstsetenv) { /* need we copy environment? */
X int j;
X#ifndef lint
X char **tmpenv = (char**) /* point our wand at memory */
X safemalloc((i+2) * sizeof(char*));
X#else
X char **tmpenv = Null(char **);
X#endif /* lint */
X
X firstsetenv = FALSE;
X for (j=0; j<i; j++) /* copy environment */
X tmpenv[j] = environ[j];
X environ = tmpenv; /* tell exec where it is now */
X }
X#ifndef lint
X else
X environ = (char**) saferealloc((char*) environ,
X (i+2) * sizeof(char*));
X /* just expand it a bit */
X#endif /* lint */
X environ[i+1] = Nullch; /* make sure it's null terminated */
X }
X environ[i] = safemalloc((MEM_SIZE)(strlen(nam) + strlen(val) + 2));
X /* this may or may not be in */
X /* the old environ structure */
X sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
X}
X
Xint
Xenvix(nam)
Xchar *nam;
X{
X register int i, len = strlen(nam);
X
X for (i = 0; environ[i]; i++) {
X if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
X break; /* strnEQ must come first to avoid */
X } /* potential SEGV's */
X return i;
X}
X
X#ifdef EUNICE
Xunlnk(f) /* unlink all versions of a file */
Xchar *f;
X{
X int i;
X
X for (i = 0; unlink(f) >= 0; i++) ;
X return i ? 0 : -1;
X}
X#endif
X
X#ifndef BCOPY
X#ifndef MEMCPY
Xchar *
Xbcopy(from,to,len)
Xregister char *from;
Xregister char *to;
Xregister int len;
X{
X char *retval = to;
X
X while (len--)
X *to++ = *from++;
X return retval;
X}
X
Xchar *
Xbzero(loc,len)
Xregister char *loc;
Xregister int len;
X{
X char *retval = loc;
X
X while (len--)
X *loc++ = 0;
X return retval;
X}
X#endif
X#endif
!STUFFY!FUNK!
echo Extracting eg/scan/scan_suid
sed >eg/scan/scan_suid <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: scan_suid,v 2.0 88/06/05 00:17:54 root Exp $
X
X# Look for new setuid root files.
X
Xchdir '/usr/adm/private/memories' || die "Can't cd.";
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('oldsuid');
Xif ($nlink) {
X $lasttime = $mtime;
X $tmp = $ctime - $atime;
X if ($tmp <= 0 || $tmp >= 10) {
X print "WARNING: somebody has read oldsuid!\n";
X }
X $tmp = $ctime - $mtime;
X if ($tmp <= 0 || $tmp >= 10) {
X print "WARNING: somebody has modified oldsuid!!!\n";
X }
X} else {
X $lasttime = time - 60 * 60 * 24; # one day ago
X}
X$thistime = time;
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
Xopen(Find, 'find / -perm -04000 -print |') ||
X die "scan_find: can't run find";
X#else
Xopen(Find, 'find / \( -fstype nfs -prune \) -o -perm -04000 -ls |') ||
X die "scan_find: can't run find";
X#endif
X
Xopen(suid, '>newsuid.tmp');
X
Xwhile (<Find>) {
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
X $x = `/bin/ls -il $_`;
X $_ = $x;
X s/^ *//;
X ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
X = split;
X#else
X s/^ *//;
X ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
X = split;
X#endif
X
X if ($perm =~ /[sS]/ && $owner eq 'root') {
X ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat($name);
X $foo = sprintf("%10s%3s %-8s %-8s%9s %3s %2s %s %s\n",
X $perm,$links,$owner,$group,$size,$month,$day,$name,$inode);
X print suid $foo;
X if ($ctime > $lasttime) {
X if ($ctime > $thistime) {
X print "Future file: $foo";
X }
X else {
X $ct .= $foo;
X }
X }
X }
X}
Xclose(suid);
X
Xprint `sort +7 -8 newsuid.tmp >newsuid 2>&1`;
X$foo = `/bin/diff oldsuid newsuid 2>&1`;
Xprint "Differences in suid info:\n",$foo if $foo;
Xprint `mv oldsuid oldoldsuid 2>&1; mv newsuid oldsuid 2>&1`;
Xprint `touch oldsuid 2>&1;sleep 2 2>&1;chmod o+w oldsuid 2>&1`;
Xprint `rm -f newsuid.tmp 2>&1`;
X
X@ct = split(/\n/,$ct);
X$ct = '';
X$* = 1;
Xwhile ($#ct >= 0) {
X $tmp = shift(@ct);
X unless ($foo =~ "^>.*$tmp\n") { $ct .= "$tmp\n"; }
X}
X
Xprint "Inode changed since last time:\n",$ct if $ct;
X
!STUFFY!FUNK!
echo ""
echo "End of kit 8 (of 15)"
cat /dev/null >kit8isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.