perl 3.0 patch #27 patch #19, continued

See patch #19.

diff --git a/dolist.c b/dolist.c
index 0e74a56..3d32d98 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 <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 (file)
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 (file)
--- 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 58494c9..ce16453 100644 (file)
--- 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);
 }