THIS IS A PATCH FOR PERL 4.0. DO NOT APPLY THIS PATCH TO PERL 5.0.
(See the corresponding Perl 5.0 patch instead.)
Directions:
cd your_perl4_source_directory
patch -N <thisfile
make
Then, as root:
make install
Then double-check your bin directories to make sure that every file
named suidperl or sperl?.??? has been reinstalled. If not, fix the
other versions too.
Index: perl.c
*** perl.c.orig Wed Jun 19 10:00:38 1996
--- perl.c Wed Jun 19 13:57:35 1996
***************
*** 83,88 ****
--- 83,89 ----
static char *nrs = "\n";
static int nrschar = '\n'; /* final char of rs, or 0777 if none */
static int nrslen = 1;
+ static int fdscript = -1;
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
#ifdef IAMSUID
***************
*** 344,354 ****
fdpid = anew(Nullstab); /* for remembering popen pids by fd */
pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
origfilename = savestr(scriptname);
curcmd->c_filestab = fstab(origfilename);
if (strEQ(origfilename,"-"))
scriptname = "";
! if (preprocess) {
char *cpp = CPPSTDIN;
if (strEQ(cpp,"cppstdin"))
--- 346,372 ----
fdpid = anew(Nullstab); /* for remembering popen pids by fd */
pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
if (strEQ(cpp,"cppstdin"))
***************
*** 425,432 ****
#endif
rsfp = stdin;
}
! else
rsfp = fopen(scriptname,"r");
if ((FILE*)rsfp == Nullfp) {
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
--- 443,454 ----
#endif
rsfp = stdin;
}
! else {
rsfp = fopen(scriptname,"r");
+ #if defined(HAS_FCNTL) && defined(F_SETFD)
+ fcntl(fileno(rsfp),F_SETFD,1); /* ensure close-on-exec */
+ #endif
+ }
if ((FILE*)rsfp == Nullfp) {
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
***************
*** 474,480 ****
#ifdef DOSUID
if (fstat(fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
fatal("Can't stat script \"%s\"",origfilename);
! if (statbuf.st_mode & (S_ISUID|S_ISGID)) {
int len;
#ifdef IAMSUID
--- 496,502 ----
#ifdef DOSUID
if (fstat(fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
fatal("Can't stat script \"%s\"",origfilename);
! if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
int len;
#ifdef IAMSUID
***************
*** 617,624 ****
--- 639,666 ----
#ifdef IAMSUID
else if (preprocess)
fatal("-P not allowed for setuid/setgid script\n");
+ else if (fdscript >= 0)
+ fatal("fd script not allowed in suidperl\n");
else
fatal("Script is not setuid/setgid in suidperl\n");
+
+ /* We absolutely must clear out any saved ids here, so we */
+ /* exec taintperl, substituting fd script for scriptname. */
+ /* (We pass script name as "subdir" of fd, which taintperl will grok.) */
+ rewind(rsfp);
+ for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
+ if (!origargv[which])
+ fatal("Permission denied");
+ (void)sprintf(buf, "/dev/fd/%d/%.127s", fileno(rsfp), origargv[which]);
+ origargv[which] = buf;
+
+ #if defined(HAS_FCNTL) && defined(F_SETFD)
+ fcntl(fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */
+ #endif
+
+ (void)sprintf(tokenbuf, "%s/tperl%s", BIN, patchlevel);
+ execv(tokenbuf, origargv); /* try again */
+ fatal("Can't do setuid\n");
#else
#ifndef TAINT /* we aren't taintperl or suidperl */
/* script has a wrapper--can't run suidperl or we lose euid */
***************
*** 1376,1381 ****
--- 1418,1424 ----
case 'v':
fputs("\nThis is perl, version 4.0\n\n",stdout);
fputs(rcsid,stdout);
+ fputs("+ suidperl security patch\n", stdout);
fputs("\nCopyright (c) 1989, 1990, 1991, Larry Wall\n",stdout);
#ifdef MSDOS
fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
***************
*** 1443,1446 ****
#endif /* ! MSDOS */
#endif
}
-
--- 1486,1488 ----
