summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dolist.c495
-rw-r--r--lib/validate.pl3
-rw-r--r--patchlevel.h2
-rw-r--r--usersub.c184
-rw-r--r--usub/usersub.c17
-rw-r--r--util.c135
-rw-r--r--x2p/walk.c31
7 files changed, 739 insertions, 128 deletions
diff --git a/dolist.c b/dolist.c
index 0e74a569d4..3d32d9877d 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 bee7bbaddf..07d49d40f6 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 9705476214..466db5fd0f 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 0000000000..8eb0b4cb3c
--- /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 <signal.h>
+#ifdef I_VFORK
+#include <vfork.h>
+#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 0000000000..a8274fbd97
--- /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 07e057b907..ca7a6a4b49 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 <signal.h>
+ * 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 <signal.h>
+#endif
#ifdef I_VFORK
# include <vfork.h>
@@ -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 58494c9d78..ce164530b4 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);
}
View Lorry Controller Status