From: Larry Wall Date: Wed, 8 Aug 1990 17:07:27 +0000 (+0000) Subject: perl 3.0 patch #27 patch #19, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=62b28dd9eb2541847d5ce270cb7493fed626d1ef;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #27 patch #19, continued See patch #19. --- diff --git a/dolist.c b/dolist.c index 0e74a56..3d32d98 100644 --- a/dolist.c +++ b/dolist.c @@ -1,4 +1,4 @@ -/* $Header: dolist.c,v 3.0.1.7 90/03/27 15:48:42 lwall Locked $ +/* $Header: dolist.c,v 3.0.1.8 90/08/09 03:15:56 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,17 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: dolist.c,v $ + * Revision 3.0.1.8 90/08/09 03:15:56 lwall + * patch19: certain kinds of matching cause "panic: hint" + * patch19: $' broke on embedded nulls + * patch19: split on /\s+/, /^/ and ' ' is now special cased for speed + * patch19: split on /x/i didn't work + * patch19: couldn't unpack an 'A' or 'a' field in a scalar context + * patch19: unpack called bcopy on each character of a C/c field + * patch19: pack/unpack know about uudecode lines + * patch19: fixed sort on undefined strings and sped up slightly + * patch19: each and keys returned garbage on null key in DBM file + * * Revision 3.0.1.7 90/03/27 15:48:42 lwall * patch16: MSDOS support * patch16: use of $`, $& or $' sometimes causes memory leakage @@ -69,7 +80,9 @@ int *arglast; register char *s = str_get(st[sp]); char *strend = s + st[sp]->str_cur; STR *tmpstr; + char *myhint = hint; + hint = Nullch; if (!spat) { if (gimme == G_ARRAY) return --sp; @@ -106,7 +119,7 @@ int *arglast; if (spat->spat_regexp) regfree(spat->spat_regexp); spat->spat_regexp = regcomp(t,t+tmpstr->str_cur, - spat->spat_flags & SPAT_FOLD,1); + spat->spat_flags & SPAT_FOLD); if (!*spat->spat_regexp->precomp && lastspat) spat = lastspat; if (spat->spat_flags & SPAT_KEEP) { @@ -148,11 +161,10 @@ int *arglast; if (!*spat->spat_regexp->precomp && lastspat) spat = lastspat; t = s; - if (hint) { - if (hint < s || hint > strend) + if (myhint) { + if (myhint < s || myhint > strend) fatal("panic: hint in do_match"); - s = hint; - hint = Nullch; + s = myhint; if (spat->spat_regexp->regback >= 0) { s -= spat->spat_regexp->regback; if (s < t) @@ -256,6 +268,7 @@ yup: if (spat->spat_regexp->subbase) Safefree(spat->spat_regexp->subbase); tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t); + spat->spat_regexp->subend = tmps + (strend-t); tmps = spat->spat_regexp->startp[0] = tmps + (s - t); spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur; curspat = spat; @@ -317,7 +330,7 @@ int *arglast; if (spat->spat_regexp) regfree(spat->spat_regexp); spat->spat_regexp = regcomp(m,m+dstr->str_cur, - spat->spat_flags & SPAT_FOLD,1); + spat->spat_flags & SPAT_FOLD); if (spat->spat_flags & SPAT_KEEP || (spat->spat_runtime->arg_type == O_ITEM && (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) { @@ -350,12 +363,53 @@ int *arglast; } if (!limit) limit = maxiters + 2; - if (spat->spat_short) { + if (strEQ("\\s+",spat->spat_regexp->precomp)) { + while (--limit) { + for (m = s; m < strend && !isspace(*m); m++) ; + if (m >= strend) + break; + if (realarray) + dstr = Str_new(30,m-s); + else + dstr = str_static(&str_undef); + str_nset(dstr,s,m-s); + (void)astore(ary, ++sp, dstr); + for (s = m + 1; s < strend && isspace(*s); s++) ; + } + } + else if (strEQ("^",spat->spat_regexp->precomp)) { + while (--limit) { + for (m = s; m < strend && *m != '\n'; m++) ; + m++; + if (m >= strend) + break; + if (realarray) + dstr = Str_new(30,m-s); + else + dstr = str_static(&str_undef); + str_nset(dstr,s,m-s); + (void)astore(ary, ++sp, dstr); + s = m; + } + } + else if (spat->spat_short) { i = spat->spat_short->str_cur; if (i == 1) { + int fold = (spat->spat_flags & SPAT_FOLD); + i = *spat->spat_short->str_ptr; + if (fold && isupper(i)) + i = tolower(i); while (--limit) { - for (m = s; m < strend && *m != i; m++) ; + if (fold) { + for ( m = s; + m < strend && *m != i && + (!isupper(*m) || tolower(*m) != i); + m++) + ; + } + else + for (m = s; m < strend && *m != i; m++) ; if (m >= strend) break; if (realarray) @@ -434,7 +488,7 @@ int *arglast; iters++; } else { -#ifndef I286 +#ifndef I286x while (iters > 0 && ary->ary_array[sp]->str_cur == 0) iters--,sp--; #else @@ -486,6 +540,7 @@ int *arglast; register char *pat = str_get(st[sp++]); register char *s = str_get(st[sp]); char *strend = s + st[sp--]->str_cur; + char *strbeg = s; register char *patend = pat + st[sp]->str_cur; int datumtype; register int len; @@ -500,34 +555,70 @@ int *arglast; unsigned int auint; unsigned long aulong; char *aptr; + float afloat; + double adouble; + int checksum = 0; + unsigned long culong; + double cdouble; if (gimme != G_ARRAY) { /* arrange to do first one only */ - patend = pat+1; - if (*pat == 'a' || *pat == 'A') { - while (isdigit(*patend)) + for (patend = pat; !isalpha(*patend); patend++); + if (*patend == 'a' || *patend == 'A' || *pat == '%') { + patend++; + while (isdigit(*patend) || *patend == '*') patend++; } + else + patend++; } sp--; while (pat < patend) { + reparse: datumtype = *pat++; - if (isdigit(*pat)) { + if (pat >= patend) + len = 1; + else if (*pat == '*') + len = strend - strbeg; /* long enough */ + else if (isdigit(*pat)) { len = *pat++ - '0'; while (isdigit(*pat)) len = (len * 10) + (*pat++ - '0'); } else - len = 1; + len = (datumtype != '@'); switch(datumtype) { default: break; + case '%': + if (len == 1 && pat[-1] != '1') + len = 16; + checksum = len; + culong = 0; + cdouble = 0; + if (pat < patend) + goto reparse; + break; + case '@': + if (len > strend - s) + fatal("@ outside of string"); + s = strbeg + len; + break; + case 'X': + if (len > s - strbeg) + fatal("X outside of string"); + s -= len; + break; case 'x': + if (len > strend - s) + fatal("x outside of string"); s += len; break; case 'A': case 'a': - if (s + len > strend) + if (len > strend - s) len = strend - s; + if (checksum) + goto uchar_checksum; str = Str_new(35,len); str_nset(str,s,len); s += len; @@ -543,127 +634,209 @@ int *arglast; (void)astore(stack, ++sp, str_2static(str)); break; case 'c': - while (len-- > 0) { - if (s + sizeof(char) > strend) - achar = 0; - else { - bcopy(s,(char*)&achar,sizeof(char)); - s += sizeof(char); + if (len > strend - s) + len = strend - s; + if (checksum) { + while (len-- > 0) { + aint = *s++; + if (aint >= 128) /* fake up signed chars */ + aint -= 256; + culong += aint; + } + } + else { + while (len-- > 0) { + aint = *s++; + if (aint >= 128) /* fake up signed chars */ + aint -= 256; + str = Str_new(36,0); + str_numset(str,(double)aint); + (void)astore(stack, ++sp, str_2static(str)); } - str = Str_new(36,0); - aint = achar; - if (aint >= 128) /* fake up signed chars */ - aint -= 256; - str_numset(str,(double)aint); - (void)astore(stack, ++sp, str_2static(str)); } break; case 'C': - while (len-- > 0) { - if (s + sizeof(unsigned char) > strend) - auchar = 0; - else { - bcopy(s,(char*)&auchar,sizeof(unsigned char)); - s += sizeof(unsigned char); + if (len > strend - s) + len = strend - s; + if (checksum) { + uchar_checksum: + while (len-- > 0) { + auint = *s++ & 255; + culong += auint; + } + } + else { + while (len-- > 0) { + auint = *s++ & 255; + str = Str_new(37,0); + str_numset(str,(double)auint); + (void)astore(stack, ++sp, str_2static(str)); } - str = Str_new(37,0); - auint = auchar; /* some can't cast uchar to double */ - str_numset(str,(double)auint); - (void)astore(stack, ++sp, str_2static(str)); } break; case 's': - while (len-- > 0) { - if (s + sizeof(short) > strend) - ashort = 0; - else { + along = (strend - s) / sizeof(short); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { bcopy(s,(char*)&ashort,sizeof(short)); s += sizeof(short); + culong += ashort; + } + } + else { + while (len-- > 0) { + bcopy(s,(char*)&ashort,sizeof(short)); + s += sizeof(short); + str = Str_new(38,0); + str_numset(str,(double)ashort); + (void)astore(stack, ++sp, str_2static(str)); } - str = Str_new(38,0); - str_numset(str,(double)ashort); - (void)astore(stack, ++sp, str_2static(str)); } break; case 'n': case 'S': - while (len-- > 0) { - if (s + sizeof(unsigned short) > strend) - aushort = 0; - else { + along = (strend - s) / sizeof(unsigned short); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { bcopy(s,(char*)&aushort,sizeof(unsigned short)); s += sizeof(unsigned short); +#ifdef NTOHS + if (datumtype == 'n') + aushort = ntohs(aushort); +#endif + culong += aushort; } - str = Str_new(39,0); + } + else { + while (len-- > 0) { + bcopy(s,(char*)&aushort,sizeof(unsigned short)); + s += sizeof(unsigned short); + str = Str_new(39,0); #ifdef NTOHS - if (datumtype == 'n') - aushort = ntohs(aushort); + if (datumtype == 'n') + aushort = ntohs(aushort); #endif - str_numset(str,(double)aushort); - (void)astore(stack, ++sp, str_2static(str)); + str_numset(str,(double)aushort); + (void)astore(stack, ++sp, str_2static(str)); + } } break; case 'i': - while (len-- > 0) { - if (s + sizeof(int) > strend) - aint = 0; - else { + along = (strend - s) / sizeof(int); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { bcopy(s,(char*)&aint,sizeof(int)); s += sizeof(int); + if (checksum > 32) + cdouble += (double)aint; + else + culong += aint; + } + } + else { + while (len-- > 0) { + bcopy(s,(char*)&aint,sizeof(int)); + s += sizeof(int); + str = Str_new(40,0); + str_numset(str,(double)aint); + (void)astore(stack, ++sp, str_2static(str)); } - str = Str_new(40,0); - str_numset(str,(double)aint); - (void)astore(stack, ++sp, str_2static(str)); } break; case 'I': - while (len-- > 0) { - if (s + sizeof(unsigned int) > strend) - auint = 0; - else { + along = (strend - s) / sizeof(unsigned int); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { bcopy(s,(char*)&auint,sizeof(unsigned int)); s += sizeof(unsigned int); + if (checksum > 32) + cdouble += (double)auint; + else + culong += auint; + } + } + else { + while (len-- > 0) { + bcopy(s,(char*)&auint,sizeof(unsigned int)); + s += sizeof(unsigned int); + str = Str_new(41,0); + str_numset(str,(double)auint); + (void)astore(stack, ++sp, str_2static(str)); } - str = Str_new(41,0); - str_numset(str,(double)auint); - (void)astore(stack, ++sp, str_2static(str)); } break; case 'l': - while (len-- > 0) { - if (s + sizeof(long) > strend) - along = 0; - else { + along = (strend - s) / sizeof(long); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { bcopy(s,(char*)&along,sizeof(long)); s += sizeof(long); + if (checksum > 32) + cdouble += (double)along; + else + culong += along; + } + } + else { + while (len-- > 0) { + bcopy(s,(char*)&along,sizeof(long)); + s += sizeof(long); + str = Str_new(42,0); + str_numset(str,(double)along); + (void)astore(stack, ++sp, str_2static(str)); } - str = Str_new(42,0); - str_numset(str,(double)along); - (void)astore(stack, ++sp, str_2static(str)); } break; case 'N': case 'L': - while (len-- > 0) { - if (s + sizeof(unsigned long) > strend) - aulong = 0; - else { + along = (strend - s) / sizeof(unsigned long); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { bcopy(s,(char*)&aulong,sizeof(unsigned long)); s += sizeof(unsigned long); +#ifdef NTOHL + if (datumtype == 'N') + aulong = ntohl(aulong); +#endif + if (checksum > 32) + cdouble += (double)aulong; + else + culong += aulong; } - str = Str_new(43,0); + } + else { + while (len-- > 0) { + bcopy(s,(char*)&aulong,sizeof(unsigned long)); + s += sizeof(unsigned long); + str = Str_new(43,0); #ifdef NTOHL - if (datumtype == 'N') - aulong = ntohl(aulong); + if (datumtype == 'N') + aulong = ntohl(aulong); #endif - str_numset(str,(double)aulong); - (void)astore(stack, ++sp, str_2static(str)); + str_numset(str,(double)aulong); + (void)astore(stack, ++sp, str_2static(str)); + } } break; case 'p': + along = (strend - s) / sizeof(char*); + if (len > along) + len = along; while (len-- > 0) { - if (s + sizeof(char*) > strend) - aptr = 0; + if (sizeof(char*) > strend - s) + break; else { bcopy(s,(char*)&aptr,sizeof(char*)); s += sizeof(char*); @@ -674,6 +847,122 @@ int *arglast; (void)astore(stack, ++sp, str_2static(str)); } break; + /* float and double added gnb@melba.bby.oz.au 22/11/89 */ + case 'f': + case 'F': + along = (strend - s) / sizeof(float); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + bcopy(s, (char *)&afloat, sizeof(float)); + s += sizeof(float); + cdouble += afloat; + } + } + else { + while (len-- > 0) { + bcopy(s, (char *)&afloat, sizeof(float)); + s += sizeof(float); + str = Str_new(47, 0); + str_numset(str, (double)afloat); + (void)astore(stack, ++sp, str_2static(str)); + } + } + break; + case 'd': + case 'D': + along = (strend - s) / sizeof(double); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + bcopy(s, (char *)&adouble, sizeof(double)); + s += sizeof(double); + cdouble += adouble; + } + } + else { + while (len-- > 0) { + bcopy(s, (char *)&adouble, sizeof(double)); + s += sizeof(double); + str = Str_new(48, 0); + str_numset(str, (double)adouble); + (void)astore(stack, ++sp, str_2static(str)); + } + } + break; + case 'u': + along = (strend - s) * 3 / 4; + str = Str_new(42,along); + while (s < strend && *s > ' ' && *s < 'a') { + int a,b,c,d; + char hunk[4]; + + hunk[3] = '\0'; + len = (*s++ - ' ') & 077; + while (len > 0) { + if (s < strend && *s >= ' ') + a = (*s++ - ' ') & 077; + else + a = 0; + if (s < strend && *s >= ' ') + b = (*s++ - ' ') & 077; + else + b = 0; + if (s < strend && *s >= ' ') + c = (*s++ - ' ') & 077; + else + c = 0; + if (s < strend && *s >= ' ') + d = (*s++ - ' ') & 077; + else + d = 0; + hunk[0] = a << 2 | b >> 4; + hunk[1] = b << 4 | c >> 2; + hunk[2] = c << 6 | d; + str_ncat(str,hunk, len > 3 ? 3 : len); + len -= 3; + } + if (*s == '\n') + s++; + else if (s[1] == '\n') /* possible checksum byte */ + s += 2; + } + (void)astore(stack, ++sp, str_2static(str)); + break; + } + if (checksum) { + str = Str_new(42,0); + if (index("fFdD", datumtype) || + (checksum > 32 && index("iIlLN", datumtype)) ) { + double modf(); + double trouble; + + adouble = 1.0; + while (checksum >= 16) { + checksum -= 16; + adouble *= 65536.0; + } + while (checksum >= 4) { + checksum -= 4; + adouble *= 16.0; + } + while (checksum--) + adouble *= 2.0; + along = (1 << checksum) - 1; + while (cdouble < 0.0) + cdouble += adouble; + cdouble = modf(cdouble / adouble, &trouble) * adouble; + str_numset(str,cdouble); + } + else { + along = (1 << checksum) - 1; + culong &= (unsigned long)along; + str_numset(str,(double)culong); + } + (void)astore(stack, ++sp, str_2static(str)); + checksum = 0; } } return sp; @@ -774,9 +1063,8 @@ int *arglast; } int -do_splice(ary,str,gimme,arglast) +do_splice(ary,gimme,arglast) register ARRAY *ary; -STR *str; int gimme; int *arglast; { @@ -1033,7 +1321,7 @@ STAB *stab; int gimme; int *arglast; { - STR **st = stack->ary_array; + register STR **st = stack->ary_array; int sp = arglast[1]; register STR **up; register int max = arglast[2] - sp; @@ -1052,11 +1340,16 @@ int *arglast; return sp; } up = &st[sp]; - for (i = 0; i < max; i++) { - if ((*up = up[1]) && !(*up)->str_pok) - (void)str_2ptr(*up); - up++; + st += sp; /* temporarily make st point to args */ + for (i = 1; i <= max; i++) { + if (*up = st[i]) { + if (!(*up)->str_pok) + (void)str_2ptr(*up); + up++; + } } + st -= sp; + max = up - &st[sp]; sp--; if (max > 1) { if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) { @@ -1090,9 +1383,6 @@ int *arglast; qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp); #endif } - up = &st[arglast[1]]; - while (max > 0 && !*up) - max--,up--; return sp+max; } @@ -1101,10 +1391,6 @@ sortsub(str1,str2) STR **str1; STR **str2; { - if (!*str1) - return -1; - if (!*str2) - return 1; stab_val(firststab) = *str1; stab_val(secondstab) = *str2; cmd_exec(sortcmd,G_SCALAR,-1); @@ -1119,11 +1405,6 @@ STR **strp2; register STR *str2 = *strp2; int retval; - if (!str1) - return -1; - if (!str2) - return 1; - if (str1->str_cur < str2->str_cur) { if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) return retval; @@ -1273,6 +1554,8 @@ int *arglast; while (entry = hiternext(hash)) { if (dokeys) { tmps = hiterkey(entry,&i); + if (!i) + tmps = ""; (void)astore(ary,++sp,str_2static(str_make(tmps,i))); } if (dovalues) { @@ -1314,6 +1597,8 @@ int *arglast; if (entry) { if (gimme == G_ARRAY) { tmps = hiterkey(entry, &i); + if (!i) + tmps = ""; st[++sp] = mystrk = str_make(tmps,i); } st[++sp] = str; diff --git a/lib/validate.pl b/lib/validate.pl index bee7bba..07d49d4 100644 --- a/lib/validate.pl +++ b/lib/validate.pl @@ -1,4 +1,4 @@ -;# $Header: validate.pl,v 3.0 89/10/18 15:20:04 lwall Locked $ +;# $Header: validate.pl,v 3.0.1.1 90/08/09 04:03:10 lwall Locked $ ;# The validate routine takes a single multiline string consisting of ;# lines containing a filename plus a file test to try on it. (The @@ -17,6 +17,7 @@ ;# The routine returns the number of warnings issued. ;# Usage: +;# require "validate.pl"; ;# $warnings += do validate(' ;# /vmunix -e || die ;# /boot -e || die diff --git a/patchlevel.h b/patchlevel.h index 9705476..466db5f 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 26 +#define PATCHLEVEL 27 diff --git a/usersub.c b/usersub.c new file mode 100644 index 0000000..8eb0b4c --- /dev/null +++ b/usersub.c @@ -0,0 +1,184 @@ +/* $Header: usersub.c,v 3.0.1.1 90/08/09 05:40:45 lwall Locked $ + * + * This file contains stubs for routines that the user may define to + * set up glue routines for C libraries or to decrypt encrypted scripts + * for execution. + * + * $Log: usersub.c,v $ + * Revision 3.0.1.1 90/08/09 05:40:45 lwall + * patch19: Initial revision + * + */ + +#include "EXTERN.h" +#include "perl.h" + +userinit() +{ + return 0; +} + +/* + * The following is supplied by John MacDonald as a means of decrypting + * and executing (presumably proprietary) scripts that have been encrypted + * by a (presumably secret) method. The idea is that you supply your own + * routine in place of cryptfilter (which is purposefully a very weak + * encryption). If an encrypted script is detected, a process is forked + * off to run the cryptfilter routine as input to perl. + */ + +#ifdef CRYPTSCRIPT + +#include +#ifdef I_VFORK +#include +#endif + +#define CRYPT_MAGIC_1 0xfb +#define CRYPT_MAGIC_2 0xf1 + +cryptfilter( fil ) +FILE * fil; +{ + int ch; + + while( (ch = getc( fil )) != EOF ) { + putchar( (ch ^ 0x80) ); + } +} + +#ifndef MSDOS +static FILE *lastpipefile; +static int pipepid; + +#ifdef VOIDSIG +# define VOID void +#else +# define VOID int +#endif + +FILE * +mypfiopen(fil,func) /* open a pipe to function call for input */ +FILE *fil; +VOID (*func)(); +{ + int p[2]; + STR *str; + + if (pipe(p) < 0) { + fclose( fil ); + fatal("Can't get pipe for decrypt"); + } + + /* make sure that the child doesn't get anything extra */ + fflush(stdout); + fflush(stderr); + + while ((pipepid = fork()) < 0) { + if (errno != EAGAIN) { + close(p[0]); + close(p[1]); + fclose( fil ); + fatal("Can't fork for decrypt"); + } + sleep(5); + } + if (pipepid == 0) { + close(p[0]); + if (p[1] != 1) { + dup2(p[1], 1); + close(p[1]); + } + (*func)(fil); + fflush(stdout); + fflush(stderr); + _exit(0); + } + close(p[1]); + fclose(fil); + str = afetch(pidstatary,p[0],TRUE); + str_numset(str,(double)pipepid); + str->str_cur = 0; + return fdopen(p[0], "r"); +} + +cryptswitch() +{ + int ch; +#ifdef STDSTDIO + /* cheat on stdio if possible */ + if (rsfp->_cnt > 0 && (*rsfp->_ptr & 0xff) != CRYPT_MAGIC_1) + return; +#endif + ch = getc(rsfp); + if (ch == CRYPT_MAGIC_1) { + if (getc(rsfp) == CRYPT_MAGIC_2) { + rsfp = mypfiopen( rsfp, cryptfilter ); + preprocess = 1; /* force call to pclose when done */ + } + else + fatal( "bad encryption format" ); + } + else + ungetc(ch,rsfp); +} + +FILE * +cryptopen(cmd) /* open a (possibly encrypted) program for input */ +char *cmd; +{ + FILE *fil = fopen( cmd, "r" ); + + lastpipefile = Nullfp; + pipepid = 0; + + if( fil ) { + int ch = getc( fil ); + int lines = 0; + int chars = 0; + + /* Search for the magic cookie that starts the encrypted script, + ** while still allowing a few lines of unencrypted text to let + ** '#!' and the nih hack both continue to work. (These lines + ** will end up being ignored.) + */ + while( ch != CRYPT_MAGIC_1 && ch != EOF && lines < 5 && chars < 300 ) { + if( ch == '\n' ) + ++lines; + ch = getc( fil ); + ++chars; + } + + if( ch == CRYPT_MAGIC_1 ) { + if( (ch = getc( fil ) ) == CRYPT_MAGIC_2 ) { + if( perldb ) fatal("can't debug an encrypted script"); + /* we found it, decrypt the rest of the file */ + fil = mypfiopen( fil, cryptfilter ); + return( lastpipefile = fil ); + } else + /* if its got MAGIC 1 without MAGIC 2, too bad */ + fatal( "bad encryption format" ); + } + + /* this file is not encrypted - rewind and process it normally */ + rewind( fil ); + } + + return( fil ); +} + +VOID +cryptclose(fil) +FILE *fil; +{ + if( fil == Nullfp ) + return; + + if( fil == lastpipefile ) + mypclose( fil ); + else + fclose( fil ); +} +#endif /* !MSDOS */ + +#endif /* CRYPTSCRIPT */ diff --git a/usub/usersub.c b/usub/usersub.c new file mode 100644 index 0000000..a8274fb --- /dev/null +++ b/usub/usersub.c @@ -0,0 +1,17 @@ +/* $Header: usersub.c,v 3.0.1.1 90/08/09 04:06:10 lwall Locked $ + * + * $Log: usersub.c,v $ + * Revision 3.0.1.1 90/08/09 04:06:10 lwall + * patch19: Initial revision + * + */ + +#include "EXTERN.h" +#include "perl.h" + +int +userinit() +{ + init_curses(); +} + diff --git a/util.c b/util.c index 07e057b..ca7a6a4 100644 --- a/util.c +++ b/util.c @@ -1,4 +1,4 @@ -/* $Header: util.c,v 3.0.1.5 90/03/27 16:35:13 lwall Locked $ +/* $Header: util.c,v 3.0.1.6 90/08/09 05:44:55 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ + * Revision 3.0.1.6 90/08/09 05:44:55 lwall + * patch19: fixed double include of + * patch19: various MSDOS and OS/2 patches folded in + * patch19: open(STDOUT,"|command") left wrong descriptor attached to STDOUT + * * Revision 3.0.1.5 90/03/27 16:35:13 lwall * patch16: MSDOS support * patch16: support for machines that can't cast negative floats to unsigned ints @@ -34,7 +39,10 @@ #include "EXTERN.h" #include "perl.h" + +#ifndef NSIG #include +#endif #ifdef I_VFORK # include @@ -61,11 +69,21 @@ static int an = 0; char * safemalloc(size) +#ifdef MSDOS +unsigned long size; +#else MEM_SIZE size; +#endif /* MSDOS */ { char *ptr; char *malloc(); +#ifdef MSDOS + if (size > 0xffff) { + fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH; + exit(1); + } +#endif /* MSDOS */ ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */ #ifdef DEBUGGING # ifndef I286 @@ -93,11 +111,21 @@ MEM_SIZE size; char * saferealloc(where,size) char *where; +#ifndef MSDOS MEM_SIZE size; +#else +unsigned long size; +#endif /* MSDOS */ { char *ptr; char *realloc(); +#ifdef MSDOS + if (size > 0xffff) { + fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH; + exit(1); + } +#endif /* MSDOS */ if (!where) fatal("Null realloc"); ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */ @@ -204,7 +232,8 @@ xstat() char * cpytill(to,from,fromend,delim,retlen) -register char *to, *from; +register char *to; +register char *from; register char *fromend; register int delim; int *retlen; @@ -406,7 +435,7 @@ int iflag; int rarest = 0; int frequency = 256; - str_grow(str,len+258); + Str_Grow(str,len+258); #ifndef lint table = (unsigned char*)(str->str_ptr + len + 1); #else @@ -521,13 +550,24 @@ STR *littlestr; #else table = Null(unsigned char*); #endif - s = big + --littlelen; + if (--littlelen >= bigend - big) + return Nullch; + s = big + littlelen; oldlittle = little = table - 2; if (littlestr->str_pok & SP_CASEFOLD) { /* case insensitive? */ while (s < bigend) { top1: if (tmp = table[*s]) { - s += tmp; +#ifdef POINTERRIGOR + if (bigend - s > tmp) { + s += tmp; + goto top1; + } +#else + if ((s += tmp) < bigend) + goto top1; +#endif + return Nullch; } else { tmp = littlelen; /* less expensive than calling strncmp() */ @@ -551,7 +591,16 @@ STR *littlestr; while (s < bigend) { top2: if (tmp = table[*s]) { - s += tmp; +#ifdef POINTERRIGOR + if (bigend - s > tmp) { + s += tmp; + goto top2; + } +#else + if ((s += tmp) < bigend) + goto top2; +#endif + return Nullch; } else { tmp = littlelen; /* less expensive than calling strncmp() */ @@ -723,9 +772,8 @@ long a1, a2, a3, a4; (void)sprintf(s,pat,a1,a2,a3,a4); s += strlen(s); if (s[-1] != '\n') { - if (line) { - (void)sprintf(s," at %s line %ld", - in_eval?filename:origfilename, (long)line); + if (curcmd->c_line) { + (void)sprintf(s," at %s line %ld", filename, (long)curcmd->c_line); s += strlen(s); } if (last_in_stab && @@ -821,9 +869,8 @@ va_list args; s += strlen(s); if (s[-1] != '\n') { - if (line) { - (void)sprintf(s," at %s line %ld", - in_eval?filename:origfilename, (long)line); + if (curcmd->c_line) { + (void)sprintf(s," at %s line %ld", filename, (long)curcmd->c_line); s += strlen(s); } if (last_in_stab && @@ -946,7 +993,13 @@ char *nam, *val; New(904, environ[i], strlen(nam) + strlen(val) + 2, char); /* this may or may not be in */ /* the old environ structure */ +#ifndef MSDOS (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */ +#else + /* MS-DOS requires environment variable names to be in uppercase */ + strcpy(environ[i],nam); strupr(environ[i],nam); + (void)sprintf(environ[i] + strlen(nam),"=%s",val); +#endif /* MSDOS */ } int @@ -1176,7 +1229,13 @@ char *mode; #undef THIS #undef THAT } + do_execfree(); /* free any memory malloced by child on vfork */ close(p[that]); + if (p[that] < p[this]) { + dup2(p[this], p[that]); + close(p[this]); + p[this] = p[that]; + } str = afetch(pidstatary,p[this],TRUE); str_numset(str,(double)pid); str->str_cur = 0; @@ -1206,7 +1265,11 @@ dup2(oldfd,newfd) int oldfd; int newfd; { - int fdtmp[10]; +#if defined(FCNTL) && defined(F_DUPFD) + close(newfd); + fcntl(oldfd, F_DUPFD, newfd); +#else + int fdtmp[20]; int fdx = 0; int fd; @@ -1215,6 +1278,7 @@ int newfd; fdtmp[fdx++] = fd; while (fdx > 0) close(fdtmp[--fdx]); +#endif } #endif @@ -1223,7 +1287,6 @@ int mypclose(ptr) FILE *ptr; { - register int result; #ifdef VOIDSIG void (*hstat)(), (*istat)(), (*qstat)(); #else @@ -1248,6 +1311,8 @@ FILE *ptr; if (pid < 0) /* already exited? */ status = str->str_cur; else { + int result; + while ((result = wait(&status)) != pid && result >= 0) pidgone(result,status); if (result < 0) @@ -1336,3 +1401,45 @@ double f; return (unsigned long)along; } #endif + +#ifndef RENAME +int +same_dirent(a,b) +char *a; +char *b; +{ + char *fa = rindex(a,'/'); + char *fb = rindex(b,'/'); + struct stat tmpstatbuf1; + struct stat tmpstatbuf2; +#ifndef MAXPATHLEN +#define MAXPATHLEN 1024 +#endif + char tmpbuf[MAXPATHLEN+1]; + + if (fa) + fa++; + else + fa = a; + if (fb) + fb++; + else + fb = b; + if (strNE(a,b)) + return FALSE; + if (fa == a) + strcpy(tmpbuf,".") + else + strncpy(tmpbuf, a, fa - a); + if (stat(tmpbuf, &tmpstatbuf1) < 0) + return FALSE; + if (fb == b) + strcpy(tmpbuf,".") + else + strncpy(tmpbuf, b, fb - b); + if (stat(tmpbuf, &tmpstatbuf2) < 0) + return FALSE; + return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev && + tmpstatbuf1.st_ino == tmpstatbuf2.st_ino; +} +#endif /* !RENAME */ diff --git a/x2p/walk.c b/x2p/walk.c index 58494c9..ce16453 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -1,4 +1,4 @@ -/* $Header: walk.c,v 3.0.1.4 90/03/01 10:32:45 lwall Locked $ +/* $Header: walk.c,v 3.0.1.5 90/08/09 05:55:01 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: walk.c,v $ + * Revision 3.0.1.5 90/08/09 05:55:01 lwall + * patch19: a2p emited local($_) without a semicolon + * patch19: a2p didn't make explicit split on whitespace skip leading whitespace + * patch19: foreach on a normal array was iterating on values instead of indexes + * * Revision 3.0.1.4 90/03/01 10:32:45 lwall * patch9: a2p didn't put a $ on ExitValue * @@ -182,7 +187,7 @@ int minprec; /* minimum precedence without parens */ str_cat(str," $FNRbase = $. if eof;\n"); } if (len & 1) - str_cat(str," local($_)\n"); + str_cat(str," local($_);\n"); if (len & 2) str_cat(str, " if ($getline_ok = (($_ = <$fh>) ne ''))"); @@ -327,6 +332,16 @@ sub Pick {\n\ str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec)); str_free(fstr); break; + case OCOND: + prec = P_COND; + str = walk(1,level,ops[node+1].ival,&numarg,prec); + str_cat(str," ? "); + str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1)); + str_free(fstr); + str_cat(str," : "); + str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1)); + str_free(fstr); + break; case OCPAREN: str = str_new(0); str_set(str,"("); @@ -679,6 +694,8 @@ sub Pick {\n\ i = fstr->str_ptr[1] & 127; if (index("*+?.[]()|^$\\",i)) sprintf(tokenbuf,"/\\%c/",i); + else if (i = ' ') + sprintf(tokenbuf,"' '"); else sprintf(tokenbuf,"/%c/",i); str_cat(str,tokenbuf); @@ -698,7 +715,7 @@ sub Pick {\n\ str_cat(str,", "); str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1)); str_free(fstr); - str_cat(str,", 999)"); + str_cat(str,", 9999)"); if (useval) { str_cat(str,")"); } @@ -1441,7 +1458,7 @@ sub Pick {\n\ tmp2str = hfetch(symtab,str->str_ptr); if (tmp2str && atoi(tmp2str->str_ptr)) { sprintf(tokenbuf, - "foreach %s (@%s) ", + "foreach %s ($[ .. $#%s) ", s, d+1); } @@ -1587,13 +1604,13 @@ int level; str_cat(str,tokenbuf); } if (const_FS) { - sprintf(tokenbuf," = split(/[%c\\n]/, $_, 999);\n",const_FS); + sprintf(tokenbuf," = split(/[%c\\n]/, $_, 9999);\n",const_FS); str_cat(str,tokenbuf); } else if (saw_FS) - str_cat(str," = split($FS, $_, 999);\n"); + str_cat(str," = split($FS, $_, 9999);\n"); else - str_cat(str," = split(' ', $_, 999);\n"); + str_cat(str," = split(' ', $_, 9999);\n"); tab(str,level); }