The following patch has been released by Chip Salzenberg to address
a buffer overrun vulnerability as described in AUSCERT Advisory AA-97.13.
This advisory is available from:

	ftp://ftp.auscert.org.au/pub/auscert/advisory/

=== BEGIN TEXT ===

This is an URGENT SECURITY WARNING AND PATCH for Perl 5.003.

If you have Perl 5.003 installed with the setuid-script emulation
feature, your system is vulnerable to an attack that can yield
superuser access to the attacker.  Any user with an account on the
system can take advantage of this vulnerability.

To determine if your system is vulnerable, look for a program named
"sperl5.003" that is setuid root, probably installed in /usr/bin or
/usr/local/bin.  If you have that program:

   Disable setuid Perl scripts by turning off the setuid bit on
   "sperl5.003".  This action closes the security hole.

If you would like to keep using setuid Perl scripts with Perl 5.003,
then you must get fixed Perl binaries from your vendor, or else fix
Perl yourself by following these steps:

  1. Go to your Perl 5.003 source directory, or else obtain a fresh
     Perl 5.003 distribution from:
         http://www.perl.com/CPAN/src/5.0/perl5.003.tar.gz
     This file is approximately 1.5 megabytes in size.

  2. Using the "patch" program, apply the patch that is enclosed below.

  3. Build and install the patched Perl 5.003.  (If you have never
     built Perl before, be sure to read the "INSTALL" file first.)

Perl 5.003 binaries that have had this patch applied, and which are
therefore safe from all known attacks, can be identified by the output
of the "perl -v" command: the "locally applied patches" list will
include "SUIDBUF - Buffer overflow fixes for suidperl security".

Patch follows.

--------------------------------------------------------------------------

Index: patchlevel.h
***************
*** 41,42 ****
--- 41,43 ----
+ 	,"SUIDBUF - Buffer overflow fixes for suidperl security"
  	,NULL
  };

Index: perl.c
*************** char *s;
*** 1212,1216 ****
  #  endif
  #endif
! 	fputs("\n\t+ suidperl security patch", stdout);
  	fputs("\n\nCopyright 1987-1996, Larry Wall\n",stdout);
  #ifdef MSDOS
--- 1212,1216 ----
  #  endif
  #endif
! 	fputs("\n\t+ two suidperl security patches", stdout);
  	fputs("\n\nCopyright 1987-1996, Larry Wall\n",stdout);
  #ifdef MSDOS

Index: gv.c
*************** gv_fetchfile(name)
*** 59,67 ****
  char *name;
  {
!     char tmpbuf[1200];
      GV *gv;
  
!     sprintf(tmpbuf,"::_<%s", name);
      gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
      sv_setpv(GvSV(gv), name);
      if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))
--- 59,78 ----
  char *name;
  {
!     char smallbuf[256];
!     char *tmpbuf;
!     STRLEN tmplen;
      GV *gv;
  
!     tmplen = strlen(name) + 2;
!     if (tmplen < sizeof smallbuf)
! 	tmpbuf = smallbuf;
!     else
! 	New(603, tmpbuf, tmplen + 1, char);
!     tmpbuf[0] = '_';
!     tmpbuf[1] = '<';
!     strcpy(tmpbuf + 2, name);
      gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
+     if (tmpbuf != smallbuf)
+ 	Safefree(tmpbuf);
      sv_setpv(GvSV(gv), name);
      if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))

Index: toke.c
*************** static char *scan_const _((char *start))
*** 22,26 ****
  static char *scan_formline _((char *s));
  static char *scan_heredoc _((char *s));
! static char *scan_ident _((char *s, char *send, char *dest, I32 ck_uni));
  static char *scan_inputsymbol _((char *start));
  static char *scan_pat _((char *start));
--- 22,27 ----
  static char *scan_formline _((char *s));
  static char *scan_heredoc _((char *s));
! static char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen,
! 			   I32 ck_uni));
  static char *scan_inputsymbol _((char *start));
  static char *scan_pat _((char *start));
*************** static char *scan_str _((char *start));
*** 28,32 ****
  static char *scan_subst _((char *start));
  static char *scan_trans _((char *start));
! static char *scan_word _((char *s, char *dest, int allow_package, STRLEN *slp));
  static char *skipspace _((char *s));
  static void checkcomma _((char *s, char *name, char *what));
--- 29,34 ----
  static char *scan_subst _((char *start));
  static char *scan_trans _((char *start));
! static char *scan_word _((char *s, char *dest, STRLEN destlen,
! 			  int allow_package, STRLEN *slp));
  static char *skipspace _((char *s));
  static void checkcomma _((char *s, char *name, char *what));
*************** static char * filter_gets _((SV *sv, FIL
*** 47,50 ****
--- 49,54 ----
  static void restore_rsfp _((void *f));
  
+ static char too_long[] = "Identifier too long";
+ 
  /* The following are arranged oddly so that the guard on the switch statement
   * can get by with a single comparison (if the compiler is smart enough).
*************** int allow_tick;
*** 475,479 ****
  	(allow_tick && *s == '\'') )
      {
! 	s = scan_word(s, tokenbuf, allow_pack, &len);
  	if (check_keyword && keyword(tokenbuf, len))
  	    return start;
--- 479,483 ----
  	(allow_tick && *s == '\'') )
      {
! 	s = scan_word(s, tokenbuf, sizeof tokenbuf, allow_pack, &len);
  	if (check_keyword && keyword(tokenbuf, len))
  	    return start;
*************** register char *s;
*** 847,851 ****
  	unsigned char un_char = 0, last_un_char;
  	char *send = strchr(s,']');
! 	char tmpbuf[512];
  
  	if (!send)		/* has to be an expression */
--- 851,855 ----
  	unsigned char un_char = 0, last_un_char;
  	char *send = strchr(s,']');
! 	char tmpbuf[sizeof tokenbuf * 4];
  
  	if (!send)		/* has to be an expression */
*************** register char *s;
*** 872,876 ****
  		weight -= seen[un_char] * 10;
  		if (isALNUM(s[1])) {
! 		    scan_ident(s,send,tmpbuf,FALSE);
  		    if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
  			weight -= 100;
--- 876,880 ----
  		weight -= seen[un_char] * 10;
  		if (isALNUM(s[1])) {
! 		    scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
  		    if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
  			weight -= 100;
*************** GV *gv;
*** 942,946 ****
  {
      char *s = start + (*start == '$');
!     char tmpbuf[1024];
      STRLEN len;
      GV* indirgv;
--- 946,950 ----
  {
      char *s = start + (*start == '$');
!     char tmpbuf[sizeof tokenbuf];
      STRLEN len;
      GV* indirgv;
*************** GV *gv;
*** 952,956 ****
  	    gv = 0;
      }
!     s = scan_word(s, tmpbuf, TRUE, &len);
      if (*start == '$') {
  	if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf))
--- 956,960 ----
  	    gv = 0;
      }
!     s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
      if (*start == '$') {
  	if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf))
*************** yylex()
*** 1629,1633 ****
      case '*':
  	if (expect != XOPERATOR) {
! 	    s = scan_ident(s, bufend, tokenbuf, TRUE);
  	    expect = XOPERATOR;
  	    force_ident(tokenbuf, '*');
--- 1633,1637 ----
      case '*':
  	if (expect != XOPERATOR) {
! 	    s = scan_ident(s, bufend, tokenbuf, sizeof tokenbuf, TRUE);
  	    expect = XOPERATOR;
  	    force_ident(tokenbuf, '*');
*************** yylex()
*** 1645,1649 ****
      case '%':
  	if (expect != XOPERATOR) {
! 	    s = scan_ident(s, bufend, tokenbuf + 1, TRUE);
  	    if (tokenbuf[1]) {
  		expect = XOPERATOR;
--- 1649,1653 ----
      case '%':
  	if (expect != XOPERATOR) {
! 	    s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, TRUE);
  	    if (tokenbuf[1]) {
  		expect = XOPERATOR;
*************** yylex()
*** 1748,1752 ****
  		s++;
  	    if (s < bufend && isALPHA(*s)) {
! 		d = scan_word(s, tokenbuf, FALSE, &len);
  		while (d < bufend && (*d == ' ' || *d == '\t'))
  		    d++;
--- 1752,1756 ----
  		s++;
  	    if (s < bufend && isALPHA(*s)) {
! 		d = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
  		while (d < bufend && (*d == ' ' || *d == '\t'))
  		    d++;
*************** yylex()
*** 1847,1851 ****
  	}
  
! 	s = scan_ident(s-1, bufend, tokenbuf, TRUE);
  	if (*tokenbuf) {
  	    expect = XOPERATOR;
--- 1851,1855 ----
  	}
  
! 	s = scan_ident(s - 1, bufend, tokenbuf, sizeof tokenbuf, TRUE);
  	if (*tokenbuf) {
  	    expect = XOPERATOR;
*************** yylex()
*** 1956,1960 ****
      case '$':
  	if (s[1] == '#'  && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
! 	    s = scan_ident(s+1, bufend, tokenbuf+1, FALSE);
  	    if (expect == XOPERATOR) {
  		if (lex_formbrack && lex_brackets == lex_formbrack) {
--- 1960,1965 ----
      case '$':
  	if (s[1] == '#'  && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
! 	    s = scan_ident(s + 1, bufend, tokenbuf + 1, sizeof tokenbuf - 1,
! 			   FALSE);
  	    if (expect == XOPERATOR) {
  		if (lex_formbrack && lex_brackets == lex_formbrack) {
*************** yylex()
*** 1982,1986 ****
  	    TOKEN(DOLSHARP);
  	}
! 	s = scan_ident(s, bufend, tokenbuf+1, FALSE);
  	if (expect == XOPERATOR) {
  	    if (lex_formbrack && lex_brackets == lex_formbrack) {
--- 1987,1991 ----
  	    TOKEN(DOLSHARP);
  	}
! 	s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
  	if (expect == XOPERATOR) {
  	    if (lex_formbrack && lex_brackets == lex_formbrack) {
*************** yylex()
*** 2016,2024 ****
  		if (*s == '{' && strEQ(tokenbuf, "$SIG") &&
  		  (t = strchr(s,'}')) && (t = strchr(t,'='))) {
! 		    char tmpbuf[1024];
  		    STRLEN len;
  		    for (t++; isSPACE(*t); t++) ;
  		    if (isIDFIRST(*t)) {
! 			t = scan_word(t, tmpbuf, TRUE, &len);
  			if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
  			    warn("You need to quote \"%s\"", tmpbuf);
--- 2021,2029 ----
  		if (*s == '{' && strEQ(tokenbuf, "$SIG") &&
  		  (t = strchr(s,'}')) && (t = strchr(t,'='))) {
! 		    char tmpbuf[sizeof tokenbuf];
  		    STRLEN len;
  		    for (t++; isSPACE(*t); t++) ;
  		    if (isIDFIRST(*t)) {
! 			t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
  			if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
  			    warn("You need to quote \"%s\"", tmpbuf);
*************** yylex()
*** 2093,2097 ****
  
      case '@':
! 	s = scan_ident(s, bufend, tokenbuf+1, FALSE);
  	if (expect == XOPERATOR)
  	    no_op("Array",s);
--- 2098,2102 ----
  
      case '@':
! 	s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
  	if (expect == XOPERATOR)
  	    no_op("Array",s);
*************** yylex()
*** 2129,2133 ****
  			: !GvHV(gv) )))
  	    {
! 		char tmpbuf[1024];
  		sprintf(tmpbuf, "Literal @%s now requires backslash",tokenbuf+1);
  		yyerror(tmpbuf);
--- 2134,2138 ----
  			: !GvHV(gv) )))
  	    {
! 		char tmpbuf[sizeof tokenbuf + 40];
  		sprintf(tmpbuf, "Literal @%s now requires backslash",tokenbuf+1);
  		yyerror(tmpbuf);
*************** yylex()
*** 2293,2297 ****
        keylookup:
  	bufptr = s;
! 	s = scan_word(s, tokenbuf, FALSE, &len);
  	
  	if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
--- 2298,2302 ----
        keylookup:
  	bufptr = s;
! 	s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
  	
  	if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
*************** yylex()
*** 2338,2342 ****
  
  		if (*s == '\'' || *s == ':' && s[1] == ':') {
! 		    s = scan_word(s, tokenbuf + len, TRUE, &len);
  		    if (!len)
  			croak("Bad name after %s::", tokenbuf);
--- 2343,2348 ----
  
  		if (*s == '\'' || *s == ':' && s[1] == ':') {
! 		    s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
! 				  TRUE, &len);
  		    if (!len)
  			croak("Bad name after %s::", tokenbuf);
*************** yylex()
*** 2557,2561 ****
  		s += 2;
  		d = s;
! 		s = scan_word(s, tokenbuf, FALSE, &len);
  		tmp = keyword(tokenbuf, len);
  		if (tmp < 0)
--- 2563,2567 ----
  		s += 2;
  		d = s;
! 		s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
  		tmp = keyword(tokenbuf, len);
  		if (tmp < 0)
*************** yylex()
*** 3244,3250 ****
  
  	    if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
! 		char tmpbuf[128];
  		expect = XBLOCK;
! 		d = scan_word(s, tmpbuf, TRUE, &len);
  		if (strchr(tmpbuf, ':'))
  		    sv_setpv(subname, tmpbuf);
--- 3250,3256 ----
  
  	    if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
! 		char tmpbuf[sizeof tokenbuf];
  		expect = XBLOCK;
! 		d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
  		if (strchr(tmpbuf, ':'))
  		    sv_setpv(subname, tmpbuf);
*************** char *what;
*** 4091,4102 ****
  
  static char *
! scan_word(s, dest, allow_package, slp)
  register char *s;
  char *dest;
  int allow_package;
  STRLEN *slp;
  {
      register char *d = dest;
      for (;;) {
  	if (isALNUM(*s))
  	    *d++ = *s++;
--- 4097,4112 ----
  
  static char *
! scan_word(s, dest, destlen, allow_package, slp)
  register char *s;
  char *dest;
+ STRLEN destlen;
  int allow_package;
  STRLEN *slp;
  {
      register char *d = dest;
+     register char *e = d + destlen - 3;  /* two-character token, ending NUL */
      for (;;) {
+ 	if (d >= e)
+ 	    croak(too_long);
  	if (isALNUM(*s))
  	    *d++ = *s++;
*************** STRLEN *slp;
*** 4119,4129 ****
  
  static char *
! scan_ident(s,send,dest,ck_uni)
  register char *s;
  register char *send;
  char *dest;
  I32 ck_uni;
  {
      register char *d;
      char *bracket = 0;
      char funny = *s++;
--- 4129,4141 ----
  
  static char *
! scan_ident(s, send, dest, destlen, ck_uni)
  register char *s;
  register char *send;
  char *dest;
+ STRLEN destlen;
  I32 ck_uni;
  {
      register char *d;
+     register char *e;
      char *bracket = 0;
      char funny = *s++;
*************** I32 ck_uni;
*** 4134,4143 ****
  	s = skipspace(s);
      d = dest;
      if (isDIGIT(*s)) {
! 	while (isDIGIT(*s))
  	    *d++ = *s++;
      }
      else {
  	for (;;) {
  	    if (isALNUM(*s))
  		*d++ = *s++;
--- 4146,4161 ----
  	s = skipspace(s);
      d = dest;
+     e = d + destlen - 3;	/* two-character token, ending NUL */
      if (isDIGIT(*s)) {
! 	while (isDIGIT(*s)) {
! 	    if (d >= e)
! 		croak(too_long);
  	    *d++ = *s++;
+ 	}
      }
      else {
  	for (;;) {
+ 	    if (d >= e)
+ 		croak(too_long);
  	    if (isALNUM(*s))
  		*d++ = *s++;

--------------------------------------------------------------------------

End of patch.

==== END TEXT ====
