Fix for " CERT Advisory CA-96.12 - Vulnerability in suidperl"

Submitted by:	The Perl Gods as described in the advisory

1 files changed, 50 insertions, 5 deletions

diff --git a/gnu/usr.bin/perl/perl/perl.c b/gnu/usr.bin/perl/perl/perl.c
index 3d87cb4..aebbc7a 100644
--- a/gnu/usr.bin/perl/perl/perl.c
+++ b/gnu/usr.bin/perl/perl/perl.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$RCSfile: perl.c,v $$Revision: 1.4 $$Date: 1995/05/30 05:03:10 $\nPatch level: ###\n";
+char rcsid[] = "$RCSfile: perl.c,v $$Revision: 1.5 $$Date: 1996/06/02 19:59:24 $\nPatch level: ###\n";
 /*
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@ char rcsid[] = "$RCSfile: perl.c,v $$Revision: 1.4 $$Date: 1995/05/30 05:03:10 $
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log: perl.c,v $
+ * Revision 1.5  1996/06/02 19:59:24  gpalmer
+ * Use setreuid instead of seteuid for permissions management
+ *
  * Revision 1.4  1995/05/30 05:03:10  rgrimes
  * Remove trailing whitespace.
  *
@@ -102,6 +105,7 @@ static char patchlevel[6];
 static char *nrs = "\n";
 static int nrschar = '\n';      /* final char of rs, or 0777 if none */
 static int nrslen = 1;
+static int fdscript = -1;
 
 main(argc,argv,env)
 register int argc;
@@ -116,6 +120,7 @@ register char **env;
 #ifdef DOSUID
     char *validarg = "";
 #endif
+    int which;
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef IAMSUID
@@ -363,11 +368,27 @@ setuid perl scripts securely.\n");
     fdpid = anew(Nullstab);	/* for remembering popen pids by fd */
     pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
 
+    if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
+	char *s = scriptname + 8;
+	fdscript = atoi(s);
+	while (isDIGIT(*s))
+	    s++;
+	if (*s)
+	    scriptname = s + 1;
+    }
+    else
+	fdscript = -1;
     origfilename = savestr(scriptname);
     curcmd->c_filestab = fstab(origfilename);
     if (strEQ(origfilename,"-"))
 	scriptname = "";
-    if (preprocess) {
+    if (fdscript >= 0) {
+	rsfp = fdopen(fdscript,"r");
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+	fcntl(fileno(rsfp),F_SETFD,1);	/* ensure close-on-exec */
+#endif
+    }
+    else if (preprocess) {
 	char *cpp = CPPSTDIN;
 
 	if (strEQ(cpp,"cppstdin"))
@@ -444,8 +465,12 @@ sed %s -e \"/^[^#]/b\" \
 #endif
 	rsfp = stdin;
     }
-    else
+    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 */
@@ -493,7 +518,7 @@ sed %s -e \"/^[^#]/b\" \
 #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)) {
+    if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	int len;
 
 #ifdef IAMSUID
@@ -636,8 +661,28 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #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 */
@@ -1395,6 +1440,7 @@ char *s;
     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",
@@ -1462,4 +1508,3 @@ my_unexec()
 #endif /* ! MSDOS */
 #endif
 }
-