develooper Front page | perl.perl5.porters | Postings from November 2003

[PATCH] suidperl security

From:
psz
Date:
November 18, 2003 02:08
Subject:
[PATCH] suidperl security
Message ID:
200311180301.hAI31L5238139@milan.maths.usyd.edu.au
Dear Perl Gurus,

I humbly submit the following patch to perl.c (against version 5.8.2) to
solve various security issues in suidperl.

Please send email direct to me, as I am not subscribed to perl5-porters.

Thanks,

Paul Szabo - psz@maths.usyd.edu.au  http://www.maths.usyd.edu.au:8000/u/psz/
School of Mathematics and Statistics  University of Sydney   2006  Australia


--- perl.c-5.8.2	Mon Nov  3 19:04:27 2003
+++ perl.c	Tue Nov 18 12:52:41 2003
@@ -12,6 +12,50 @@
  * "A ship then new they built for him/of mithril and of elven glass" --Bilbo
  */
 
+/* PSz 12 Nov 03
+ * 
+ * Be proud that perl(1) may proclaim:
+ *   Setuid Perl scripts are safer than C programs ...
+ * Do not abandon (deprecate) suidperl. Do not advocate C wrappers.
+ * 
+ * The flow was: perl starts, notices script is suid, execs suidperl with same
+ * arguments; suidperl opens script, checks many things, sets itself with
+ * right UID, execs perl with similar arguments but with script pre-opened on
+ * /dev/fd/xxx; perl checks script is as should be and does work. This was
+ * insecure: see perlsec(1) for many problems with this approach.
+ * 
+ * The "correct" flow should be: perl starts, notices script is suid, checks
+ * many things, execs suidperl with similar arguments but with script on
+ * /dev/fd/xxx; suidperl checks script and /dev/fd/xxx object are same, checks
+ * arguments match #! line, sets itself with right UID, execs perl with same
+ * arguments; perl checks many things and does work.
+ * 
+ * (Opening the script in perl instead of suidperl, we "lose" scripts that
+ * are readable to the target UID but not to the invoker. Where did
+ * unreadable scripts work anyway?)
+ * 
+ * For now, suidperl and perl are pretty much the same large and cumbersome
+ * program, so suidperl can check its argument list. Maybe could defer that
+ * check to the invoked perl, and suidperl be a tiny wrapper instead; but
+ * prefer to do thorough checks in suidperl itself.
+ * 
+ * See also
+ *   http://bugs.debian.org/203426
+ *   http://bugs.debian.org/220486
+ * for further comments.
+ * 
+Paul Szabo - psz@maths.usyd.edu.au  http://www.maths.usyd.edu.au:8000/u/psz/
+School of Mathematics and Statistics  University of Sydney   2006  Australia
+ * 
+ */
+/* PSz 13 Nov 03
+ * Use truthful, neat, specific error messages.
+ * Cannot always hide the truth; security must not depend on doing so.
+ */
+
+/* PSz 18 Nov 03  global fdscript for easier checks */
+static int fdscript;
+
 #include "EXTERN.h"
 #define PERL_IN_PERL_C
 #include "perl.h"
@@ -49,7 +93,7 @@
 #ifndef DOSUID
 #define DOSUID
 #endif
-#endif
+#endif /* IAMSUID */
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef DOSUID
@@ -1065,7 +1109,7 @@
 #undef IAMSUID
     Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now execute\n\
 setuid perl scripts securely.\n");
-#endif
+#endif /* IAMSUID */
 #endif
 
 #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
@@ -1256,13 +1300,13 @@
     int argc = PL_origargc;
     char **argv = PL_origargv;
     char *scriptname = NULL;
-    int fdscript = -1;
     VOL bool dosearch = FALSE;
     char *validarg = "";
     register SV *sv;
     register char *s;
     char *cddir = Nullch;
 
+    fdscript = -1;
     sv_setpvn(PL_linestr,"",0);
     sv = newSVpvn("",0);		/* first used for -I flags */
     SAVEFREESV(sv);
@@ -1330,8 +1374,7 @@
 	    if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
 		break;
 #endif
-	    if (PL_euid != PL_uid || PL_egid != PL_gid)
-		Perl_croak(aTHX_ "No -e allowed in setuid scripts");
+	    forbid_setid("-e");
 	    if (!PL_e_script) {
 		PL_e_script = newSVpvn("",0);
 		filter_add(read_e_script, NULL);
@@ -2981,15 +3024,16 @@
     sv_setpvn(get_sv("/", TRUE), "\n", 1);
 }
 
+/* PSz 18 Nov 03  fdscript now global but do not change prototype */
 STATIC void
-S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
+S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *was_fdscript)
 {
     char *quote;
     char *code;
     char *cpp_discard_flag;
     char *perl;
 
-    *fdscript = -1;
+    fdscript = -1;
 
     if (PL_e_script) {
 	PL_origfilename = savepv("-e");
@@ -3000,7 +3044,7 @@
 
 	if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
 	    char *s = scriptname + 8;
-	    *fdscript = atoi(s);
+	    fdscript = atoi(s);
 	    while (isDIGIT(*s))
 		s++;
 	    if (*s) {
@@ -3015,14 +3059,25 @@
     CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
 	scriptname = "";
-    if (*fdscript >= 0) {
-	PL_rsfp = PerlIO_fdopen(*fdscript,PERL_SCRIPT_MODE);
+    if (fdscript >= 0) {
+	PL_rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
 #       if defined(HAS_FCNTL) && defined(F_SETFD)
 	    if (PL_rsfp)
                 /* ensure close-on-exec */
 	        fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
 #       endif
     }
+#ifdef IAMSUID
+    else {
+	Perl_croak(aTHX_ "suidperl needs fd script\n");
+/* PSz 11 Nov 03
+ * Do not open (or do other fancy stuff) while setuid.
+ * Perl does the open, and hands script to suidperl on a fd;
+ * suidperl only does some checks, sets up UIDs and re-execs
+ * perl with that fd as it has always done.
+ */
+    }
+#else /* IAMSUID */
     else if (PL_preprocess) {
 	char *cpp_cfg = CPPSTDIN;
 	SV *cpp = newSVpvn("",0);
@@ -3079,25 +3134,6 @@
                        cpp_discard_flag, sv, CPPMINUS);
 
 	PL_doextract = FALSE;
-#       ifdef IAMSUID			/* actually, this is caught earlier */
-	    if (PL_euid != PL_uid && !PL_euid) {  /* if running suidperl */
-#               ifdef HAS_SETEUID
-	            (void)seteuid(PL_uid);	  /* musn't stay setuid root */
-#               else
-#               ifdef HAS_SETREUID
-	            (void)setreuid((Uid_t)-1, PL_uid);
-#               else
-#               ifdef HAS_SETRESUID
-	            (void)setresuid((Uid_t)-1, PL_uid, (Uid_t)-1);
-#               else
-	            PerlProc_setuid(PL_uid);
-#               endif
-#               endif
-#               endif
-	    if (PerlProc_geteuid() != PL_uid)
-		Perl_croak(aTHX_ "Can't do seteuid!\n");
-	}
-#       endif /* IAMSUID */
 
         DEBUG_P(PerlIO_printf(Perl_debug_log,
                               "PL_preprocess: cmd=\"%s\"\n",
@@ -3119,31 +3155,11 @@
 	        fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
 #       endif
     }
+#endif /* IAMSUID */
     if (!PL_rsfp) {
-#       ifdef DOSUID
-#       ifndef IAMSUID	/* in case script is not readable before setuid */
-	    if (PL_euid &&
-                PerlLIO_stat(CopFILE(PL_curcop),&PL_statbuf) >= 0 &&
-                PL_statbuf.st_mode & (S_ISUID|S_ISGID))
-            {
-                /* try again */
-                PERL_FPU_PRE_EXEC
-                PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT,
-                                         BIN_EXP, (int)PERL_REVISION,
-                                         (int)PERL_VERSION,
-                                         (int)PERL_SUBVERSION), PL_origargv);
-                PERL_FPU_POST_EXEC
-                Perl_croak(aTHX_ "Can't do setuid\n");
-            }
-#       endif
-#       endif
-#       ifdef IAMSUID
-            errno = EPERM;
-            Perl_croak(aTHX_ "Permission denied\n");
-#       else
+/* PSz 16 Sep 03  Keep neat error message */
             Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                        CopFILE(PL_curcop), Strerror(errno));
-#       endif
     }
 }
 
@@ -3160,6 +3176,21 @@
 {
     int check_okay = 0; /* able to do all the required sys/libcalls */
     int on_nosuid  = 0; /* the fd is on a nosuid fs */
+    /* PSz 12 Nov 03  Check noexec also */
+    int on_noexec  = 0; /* the fd is on a noexec fs */
+/* This bit should go in perl.h but am too lazy to modify two files */
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC)
+#    define PERL_MOUNT_NOEXEC MOUNT_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC)
+#    define PERL_MOUNT_NOEXEC MNT_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC)
+#   define PERL_MOUNT_NOEXEC MS_NOEXEC
+#endif
+#if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC)
+#   define PERL_MOUNT_NOEXEC M_NOEXEC
+#endif
 /*
  * Preferred order: fstatvfs(), fstatfs(), ustat()+getmnt(), getmntent().
  * fstatvfs() is UNIX98.
@@ -3178,10 +3209,12 @@
 
     check_okay = fstatvfs(fd, &stfs) == 0;
     on_nosuid  = check_okay && (stfs.f_flag  & ST_NOSUID);
+    on_noexec  = check_okay && (stfs.f_flag  & ST_NOEXEC);
 #   endif /* fstatvfs */
 
 #   if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
         defined(PERL_MOUNT_NOSUID)	&& \
+        defined(PERL_MOUNT_NOEXEC)	&& \
         defined(HAS_FSTATFS) 		&& \
         defined(HAS_STRUCT_STATFS)	&& \
         defined(HAS_STRUCT_STATFS_F_FLAGS)
@@ -3190,10 +3223,12 @@
 
     check_okay = fstatfs(fd, &stfs)  == 0;
     on_nosuid  = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
+    on_noexec  = check_okay && (stfs.f_flags & PERL_MOUNT_NOEXEC);
 #   endif /* fstatfs */
 
 #   if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
         defined(PERL_MOUNT_NOSUID)	&& \
+        defined(PERL_MOUNT_NOEXEC)	&& \
         defined(HAS_FSTAT)		&& \
         defined(HAS_USTAT)		&& \
         defined(HAS_GETMNT)		&& \
@@ -3216,6 +3251,7 @@
                     fdst.st_dev == fsd.fd_req.dev) {
                         check_okay = 1;
                         on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID;
+                        on_noexec = fsd.fd_req.flags & PERL_MOUNT_NOEXEC;
                     }
                 }
             }
@@ -3226,7 +3262,8 @@
 #   if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
         defined(HAS_GETMNTENT)		&& \
         defined(HAS_HASMNTOPT)		&& \
-        defined(MNTOPT_NOSUID)
+        defined(MNTOPT_NOSUID)		&& \
+        defined(MNTOPT_NOEXEC)
 #   define FD_ON_NOSUID_CHECK_OKAY
     FILE                *mtab = fopen("/etc/mtab", "r");
     struct mntent       *entry;
@@ -3241,6 +3278,8 @@
                 check_okay = 1;
                 if (hasmntopt(entry, MNTOPT_NOSUID))
                     on_nosuid = 1;
+                if (hasmntopt(entry, MNTOPT_NOEXEC))
+                    on_noexec = 1;
                 break;
             } /* A single fs may well fail its stat(). */
         }
@@ -3250,17 +3289,22 @@
 #   endif /* getmntent+hasmntopt */
 
     if (!check_okay)
-	Perl_croak(aTHX_ "Can't check filesystem of script \"%s\" for nosuid", PL_origfilename);
-    return on_nosuid;
+	Perl_croak(aTHX_ "Can't check filesystem of script \"%s\" for nosuid/noexec", PL_origfilename);
+    if (on_nosuid)
+	Perl_croak(aTHX_ "Setuid script \"%s\" on nosuid filesystem", PL_origfilename);
+    if (on_noexec)
+	Perl_croak(aTHX_ "Setuid script \"%s\" on noexec filesystem", PL_origfilename);
+    return ((!check_okay) || on_nosuid || on_noexec);
 }
 #endif /* IAMSUID */
 
+/* PSz 18 Nov 03  fdscript now global but do not change prototype */
 STATIC void
-S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
+S_validate_suid(pTHX_ char *validarg, char *scriptname, int was_fdscript)
 {
 #ifdef IAMSUID
-    int which;
-#endif
+    /* int which; */
+#endif /* IAMSUID */
 
     /* do we need to emulate setuid on scripts? */
 
@@ -3287,11 +3331,23 @@
 
     if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0)	/* normal stat is insecure */
 	Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename);
-    if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
+    if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	I32 len;
 	STRLEN n_a;
 
 #ifdef IAMSUID
+	if (fdscript < 0)
+	    Perl_croak(aTHX_ "Need fd script in suidperl\n");	/* We already checked this */
+	/* PSz 11 Nov 03
+	 * Since the script is opened by perl, not suidperl, some of these
+	 * checks are superfluous. Leaving them in probably does not lower
+	 * security(?!).
+	 */
+	/* BUG */
+	/* Note that check for nosuid and noexec filesystem is needed,
+	 * and should be done even without HAS_SETREUID (or maybe those
+	 * operating systems do not have such mount options anyway...).
+	 */
 #ifndef HAS_SETREUID
 	/* On this access check to make sure the directories are readable,
 	 * there is actually a small window that the user could use to make
@@ -3302,67 +3358,63 @@
 	 * it says access() is useful in setuid programs.
 	 */
 	if (PerlLIO_access(CopFILE(PL_curcop),1)) { /*double check*/
-            errno = EPERM;
-	    Perl_croak(aTHX_ "Permission denied\n");
+	    Perl_croak(aTHX_ "Can't access() script\n");
 	}
 #else
 	/* If we can swap euid and uid, then we can determine access rights
 	 * with a simple stat of the file, and then compare device and
 	 * inode to make sure we did stat() on the same file we opened.
 	 * Then we just have to make sure he or she can execute it.
+	 * 
+	 * Are there any operating systems that pass /dev/fd/xxx for setuid
+	 * scripts, as suggested/described in perlsec(1)? Surely they do not
+	 * pass the script name as we do, so the "script changed" test would
+	 * fail for them... but we never get here with
+	 * SETUID_SCRIPTS_ARE_SECURE_NOW defined.
 	 */
 	{
 	    Stat_t tmpstatbuf;
 
+	    /* PSz 11 Nov 03
+	     * Fix broken ifdef nesting: we know HAS_SETREUID is defined */
 	    if (
-#ifdef HAS_SETREUID
 		setreuid(PL_euid,PL_uid) < 0
-#else
-# if HAS_SETRESUID
-		setresuid(PL_euid,PL_uid,(Uid_t)-1) < 0
-# endif
-#endif
 		|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
 		Perl_croak(aTHX_ "Can't swap uid and euid");	/* really paranoid */
 	    if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0) {
-		errno = EPERM;
-		Perl_croak(aTHX_ "Permission denied\n");	/* testing full pathname here */
+		Perl_croak(aTHX_ "Can't stat() script\n");	/* testing full pathname here */
 	    }
-#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
+	    /* PSz 11 Nov 03
+	     * Fix broken ifdef nesting: we know IAMSUID is defined */
+#if !defined(NO_NOSUID_CHECK)
 	    if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) {
-		errno = EPERM;
-		Perl_croak(aTHX_ "Permission denied\n");
+		Perl_croak(aTHX_ "Setuid script on nosuid or noexec filesystem\n");
 	    }
 #endif
 	    if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
 		tmpstatbuf.st_ino != PL_statbuf.st_ino) {
 		(void)PerlIO_close(PL_rsfp);
-		errno = EPERM;
-		Perl_croak(aTHX_ "Permission denied\n");
+		Perl_croak(aTHX_ "Setuid script changed\n");
 	    }
+	    /* PSz 11 Nov 03
+	     * Fix broken ifdef nesting: we know HAS_SETREUID is defined */
 	    if (
-#ifdef HAS_SETREUID
               setreuid(PL_uid,PL_euid) < 0
-#else
-# if defined(HAS_SETRESUID)
-              setresuid(PL_uid,PL_euid,(Uid_t)-1) < 0
-# endif
-#endif
               || PerlProc_getuid() != PL_uid || PerlProc_geteuid() != PL_euid)
 		Perl_croak(aTHX_ "Can't reswap uid and euid");
 	    if (!cando(S_IXUSR,FALSE,&PL_statbuf))		/* can real uid exec? */
-		Perl_croak(aTHX_ "Permission denied\n");
+		Perl_croak(aTHX_ "Real UID cannot exec script\n");
 	}
 #endif /* HAS_SETREUID */
 #endif /* IAMSUID */
 
 	if (!S_ISREG(PL_statbuf.st_mode)) {
-            errno = EPERM;
-	    Perl_croak(aTHX_ "Permission denied\n");
+	    Perl_croak(aTHX_ "Setuid script not plain file\n");
 	}
 	if (PL_statbuf.st_mode & S_IWOTH)
 	    Perl_croak(aTHX_ "Setuid/gid script is writable by world");
 	PL_doswitches = FALSE;		/* -s is insecure in suid */
+	/* PSz 13 Nov 03  But -s was caught elsewhere ... so unsetting it here is useless(?!) */
 	CopLINE_inc(PL_curcop);
 	if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
 	  strnNE(SvPV(PL_linestr,n_a),"#!",2) )	/* required even on Sys V */
@@ -3386,24 +3438,40 @@
 	    Perl_croak(aTHX_ "Args must match #! line");
 
 #ifndef IAMSUID
-	if (PL_euid != PL_uid && (PL_statbuf.st_mode & S_ISUID) &&
+	if (fdscript < 0 &&
+	    PL_euid != PL_uid && (PL_statbuf.st_mode & S_ISUID) &&
 	    PL_euid == PL_statbuf.st_uid)
 	    if (!PL_do_undump)
 		Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 #endif /* IAMSUID */
 
-	if (PL_euid) {	/* oops, we're not the setuid root perl */
-	    (void)PerlIO_close(PL_rsfp);
+	if (fdscript < 0 &&
+	    PL_euid) {	/* oops, we're not the setuid root perl */
 #ifndef IAMSUID
-	    /* try again */
+	    int which;
+	    /* PSz 11 Nov 03
+	     * Pass fd script to suidperl.
+	     * Exec suidperl, substituting fd script for scriptname.
+	     * (Pass script name as "subdir" of fd, which perl will grok.) */
+	    PerlIO_rewind(PL_rsfp);
+	    PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
+	    for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;
+	    if (!PL_origargv[which]) {
+		Perl_croak(aTHX_ "Can't change argv to have fd script\n");
+	    }
+	    PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",
+					  PerlIO_fileno(PL_rsfp), PL_origargv[which]));
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+	    fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
+#endif
 	    PERL_FPU_PRE_EXEC
 	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
 				     (int)PERL_REVISION, (int)PERL_VERSION,
 				     (int)PERL_SUBVERSION), PL_origargv);
 	    PERL_FPU_POST_EXEC
-#endif
-	    Perl_croak(aTHX_ "Can't do setuid\n");
+#endif /* IAMSUID */
+	    Perl_croak(aTHX_ "Can't do setuid (cannot exec sperl)\n");
 	}
 
 	if (PL_statbuf.st_mode & S_ISGID && PL_statbuf.st_gid != PL_egid) {
@@ -3460,16 +3528,16 @@
 	}
 	init_ids();
 	if (!cando(S_IXUSR,TRUE,&PL_statbuf))
-	    Perl_croak(aTHX_ "Permission denied\n");	/* they can't do this */
+	    Perl_croak(aTHX_ "Effective UID cannot exec script\n");	/* they can't do this */
     }
 #ifdef IAMSUID
-    else if (PL_preprocess)
+    else if (PL_preprocess)	/* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
 	Perl_croak(aTHX_ "-P not allowed for setuid/setgid script\n");
-    else if (fdscript >= 0)
-	Perl_croak(aTHX_ "fd script not allowed in suidperl\n");
+    else if (fdscript < 0)	/* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
+	Perl_croak(aTHX_ "fd script needed in suidperl\n");
     else {
-	errno = EPERM;
-	Perl_croak(aTHX_ "Permission denied\n");
+/* PSz 16 Sep 03  Keep neat error message */
+	Perl_croak(aTHX_ "Script is not setuid/setgid in suidperl\n");
     }
 
     /* We absolutely must clear out any saved ids here, so we */
@@ -3477,13 +3545,16 @@
     /* (We pass script name as "subdir" of fd, which perl will grok.) */
     PerlIO_rewind(PL_rsfp);
     PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
-    for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;
-    if (!PL_origargv[which]) {
-	errno = EPERM;
-	Perl_croak(aTHX_ "Permission denied\n");
-    }
-    PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",
-				  PerlIO_fileno(PL_rsfp), PL_origargv[which]));
+    /* PSz 11 Nov 03
+     * Keep original arguments: suidperl already has fd script.
+     */
+/*  for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;	*/
+/*  if (!PL_origargv[which]) {						*/
+/*	errno = EPERM;							*/
+/*	Perl_croak(aTHX_ "Permission denied\n");			*/
+/*  }									*/
+/*  PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",	*/
+/*				  PerlIO_fileno(PL_rsfp), PL_origargv[which]));	*/
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
 #endif
@@ -3492,7 +3563,7 @@
 			     (int)PERL_REVISION, (int)PERL_VERSION,
 			     (int)PERL_SUBVERSION), PL_origargv);/* try again */
     PERL_FPU_POST_EXEC
-    Perl_croak(aTHX_ "Can't do setuid\n");
+    Perl_croak(aTHX_ "Can't do setuid (suidperl cannot exec perl)\n");
 #endif /* IAMSUID */
 #else /* !DOSUID */
     if (PL_euid != PL_uid || PL_egid != PL_gid) {	/* (suidperl doesn't exist, in fact) */
@@ -3638,6 +3709,18 @@
         Perl_croak(aTHX_ "No %s allowed while running setuid", s);
     if (PL_egid != PL_gid)
         Perl_croak(aTHX_ "No %s allowed while running setgid", s);
+    /* PSz 17 Nov 03
+     * Should catch it with fdscript (in suidperl and descendant), even
+     * with right UID/GID. Checks for UID/GID above "wrong": why disallow
+     *   perl -e 'print "Hello\n"'
+     * from within setuid things?? (No matter: was like that for ages.)
+     */
+    if (fdscript >= 0)
+        Perl_croak(aTHX_ "No %s allowed with fdscript", s);
+#ifdef IAMSUID
+    /* PSz 11 Nov 03  Catch it in suidperl, always! */
+    Perl_croak(aTHX_ "No %s allowed in suidperl", s);
+#endif /* IAMSUID */
 }
 
 void



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About