Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume15/perl2/part08/text0000.txt

Text File | 1989-01-05 | 48.8 KB | 2,142 lines

#! /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