Fix a buffer overflow condition (that causes a security hole in suidperl).

Closes: CERT Advisory CA-97.17 - Vulnerability in suidperl
Obtained from: (partly) the fix in CA-97.17

3 files changed, 34 insertions, 16 deletions

diff --git a/gnu/usr.bin/perl/perl/consarg.c b/gnu/usr.bin/perl/perl/consarg.c
index d0d59b7..f673863 100644
--- a/gnu/usr.bin/perl/perl/consarg.c
+++ b/gnu/usr.bin/perl/perl/consarg.c
@@ -1,4 +1,4 @@
-/* $RCSfile: consarg.c,v $$Revision: 1.2 $$Date: 1994/09/11 03:17:29 $
+/* $RCSfile: consarg.c,v $$Revision: 1.3 $$Date: 1995/05/30 05:02:57 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log: consarg.c,v $
+ * Revision 1.3  1995/05/30 05:02:57  rgrimes
+ * Remove trailing whitespace.
+ *
  * Revision 1.2  1994/09/11  03:17:29  gclarkii
  * Changed AF_LOCAL to AF_LOCAL_XX so as not to conflict with 4.4 socket.h
  * Added casts to shutup warnings in doio.c
@@ -1237,7 +1240,7 @@ int marking;
 
 		while (*s) {
 		    if (*s == '$' && s[1]) {
-			s = scanident(s,send,tokenbuf);
+			s = scanident(s,send,tokenbuf,sizeof tokenbuf);
 			stab = stabent(tokenbuf,TRUE);
 			if (marking)
 			    stab_lastexpr(stab) = exprnum;
diff --git a/gnu/usr.bin/perl/perl/str.c b/gnu/usr.bin/perl/perl/str.c
index 0f8b36d..4d3bb5a 100644
--- a/gnu/usr.bin/perl/perl/str.c
+++ b/gnu/usr.bin/perl/perl/str.c
@@ -1,4 +1,4 @@
-/* $RCSfile: str.c,v $$Revision: 1.1.1.1 $$Date: 1994/09/10 06:27:33 $
+/* $RCSfile: str.c,v $$Revision: 1.2 $$Date: 1995/05/30 05:03:21 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log: str.c,v $
+ * Revision 1.2  1995/05/30 05:03:21  rgrimes
+ * Remove trailing whitespace.
+ *
  * Revision 1.1.1.1  1994/09/10  06:27:33  gclarkii
  * Initial import of Perl 4.046 bmaked
  *
@@ -1024,7 +1027,7 @@ STR *src;
 	    t = s;
 	    if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
 		s++;
-	    s = scanident(s,send,tokenbuf);
+	    s = scanident(s,send,tokenbuf,sizeof tokenbuf);
 	    if (*t == '@' &&
 	      (!(stab = stabent(tokenbuf,FALSE)) ||
 		 (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
@@ -1058,7 +1061,7 @@ STR *src;
 		    case '@':
 		    case '&':
 		    case '*':
-			s = scanident(s,send,tokenbuf);
+			s = scanident(s,send,tokenbuf,sizeof tokenbuf);
 			continue;
 		    case '\'':
 		    case '"':
@@ -1112,7 +1115,7 @@ STR *src;
 			    case '$':
 				weight -= seen[un_char] * 10;
 				if (isALNUM(d[1])) {
-				    d = scanident(d,s,tokenbuf);
+				    d = scanident(d,s,tokenbuf,sizeof tokenbuf);
 				    if (stabent(tokenbuf,FALSE))
 					weight -= 100;
 				    else
diff --git a/gnu/usr.bin/perl/perl/toke.c b/gnu/usr.bin/perl/perl/toke.c
index bf2e116..78cd195 100644
--- a/gnu/usr.bin/perl/perl/toke.c
+++ b/gnu/usr.bin/perl/perl/toke.c
@@ -1,4 +1,4 @@
-/* $RCSfile: toke.c,v $$Revision: 1.1.1.1 $$Date: 1994/09/10 06:27:34 $
+/* $RCSfile: toke.c,v $$Revision: 1.2 $$Date: 1995/05/30 05:03:26 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log: toke.c,v $
+ * Revision 1.2  1995/05/30 05:03:26  rgrimes
+ * Remove trailing whitespace.
+ *
  * Revision 1.1.1.1  1994/09/10  06:27:34  gclarkii
  * Initial import of Perl 4.046 bmaked
  *
@@ -515,7 +518,7 @@ yylex()
     case '*':
 	if (expectterm) {
 	    check_uni();
-	    s = scanident(s,bufend,tokenbuf);
+	    s = scanident(s,bufend,tokenbuf,sizeof tokenbuf);
 	    yylval.stabval = stabent(tokenbuf,TRUE);
 	    TERM(STAR);
 	}
@@ -529,7 +532,7 @@ yylex()
 	if (expectterm) {
 	    if (!isALPHA(s[1]))
 		check_uni();
-	    s = scanident(s,bufend,tokenbuf);
+	    s = scanident(s,bufend,tokenbuf,sizeof tokenbuf);
 	    yylval.stabval = hadd(stabent(tokenbuf,TRUE));
 	    TERM(HSH);
 	}
@@ -647,12 +650,12 @@ yylex()
     case '$':
 	if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
 	    s++;
-	    s = scanident(s,bufend,tokenbuf);
+	    s = scanident(s,bufend,tokenbuf,sizeof tokenbuf);
 	    yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 	    TERM(ARYLEN);
 	}
 	d = s;
-	s = scanident(s,bufend,tokenbuf);
+	s = scanident(s,bufend,tokenbuf,sizeof tokenbuf);
 	if (reparse) {		/* turn ${foo[bar]} into ($foo[bar]) */
 	  do_reparse:
 	    s[-1] = ')';
@@ -680,7 +683,7 @@ yylex()
 
     case '@':
 	d = s;
-	s = scanident(s,bufend,tokenbuf);
+	s = scanident(s,bufend,tokenbuf,sizeof tokenbuf);
 	if (reparse)
 	    goto do_reparse;
 	yylval.stabval = aadd(stabent(tokenbuf,TRUE));
@@ -1539,24 +1542,33 @@ char *what;
 }
 
 char *
-scanident(s,send,dest)
+scanident(s,send,dest,destlen)
 register char *s;
 register char *send;
 char *dest;
+STRLEN destlen;
 {
     register char *d;
+    register char *e;
     int brackets = 0;
 
     reparse = Nullch;
     s++;
     d = dest;
+    e = d + destlen - 3;	/* two-character token, ending NUL */
     if (isDIGIT(*s)) {
-	while (isDIGIT(*s))
-	    *d++ = *s++;
+	while (isDIGIT(*s)) {
+	    if (d >= e)
+		fatal("Identifier too long");
+            *d++ = *s++;
+	}
     }
     else {
-	while (isALNUM(*s) || *s == '\'')
+	while (isALNUM(*s) || *s == '\'') {
+	    if (d >= e)
+		fatal("Identifier too long");
 	    *d++ = *s++;
+	}
     }
     while (d > dest+1 && d[-1] == '\'')
 	d--,s--;