suidperl goes.

10 files changed, 18 insertions, 931 deletions

diff --git a/Cross/Makefile-cross-SH b/Cross/Makefile-cross-SH
index c6ecf419d4..8ab4d72d85 100755
--- a/Cross/Makefile-cross-SH
+++ b/Cross/Makefile-cross-SH
@@ -29,11 +29,6 @@ case "$0" in
 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
 esac
 
-case "$d_dosuid" in
-*define*) suidperl='suidperl' ;;
-*) suidperl='';;
-esac
-
 linklibperl='$(LIBPERL)'
 shrpldflags='$(LDDLFLAGS)'
 ldlibpth=''
@@ -252,7 +247,7 @@ DYNALOADER = DynaLoader\$(OBJ_EXT)
 
 libs = $perllibs $cryptlib
 
-public = perl\$(EXE_EXT) $suidperl utilities translators
+public = perl\$(EXE_EXT) utilities translators
 
 shellflags = $shellflags
 
@@ -725,26 +720,12 @@ perl.gcov: perl.config.gcov
 microperl:
 	$(MAKE) -f Makefile.micro
 
-# This version, if specified in Configure, does ONLY those scripts which need
-# set-id emulation.  Suidperl must be setuid root.  It contains the "taint"
-# checks as well as the special code to validate that the script in question
-# has been invoked correctly.
-
-suidperl$(EXE_EXT): $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(static_ext) ext.libs $(PERLEXPORT)
-	$(SHRPENV) $(LDLIBPTH) $(CC) -o suidperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
-
 !NO!SUBS!
 
 fi
 
 $spitshell >>$Makefile <<'!NO!SUBS!'
 
-sperl$(OBJ_EXT): perl.c $(h)
-	$(RMS) sperl.c
-	$(LNS) perl.c sperl.c
-	$(CCCMD) -DIAMSUID sperl.c
-	$(RMS) sperl.c
-
 # We have to call our ./makedir because Ultrix 4.3 make can't handle the line
 #	test -d lib/auto || mkdir lib/auto
 # We need to autosplit in two steps because VOS can't handle so many args
@@ -1013,7 +994,7 @@ _mopup:
 	-rm -f perl.pixie lib*.so.perl.pixie lib*.so.Addrs
 	-rm -f perl.Addrs perl.Counts t/perl.Addrs t/perl.Counts *perl.xok
 	-rm -f cygwin.c libperl*.def libperl*.dll cygperl*.dll *.exe.stackdump
-	-rm -f perl$(EXE_EXT) suidperl$(EXE_EXT) miniperl$(EXE_EXT) $(LIBPERL) libperl.* microperl
+	-rm -f perl$(EXE_EXT) miniperl$(EXE_EXT) $(LIBPERL) libperl.* microperl
 	-rm -f opcode.h-old opnames.h-old pp.sym-old pp_proto.h-old
 	-rm -f config.over
 
diff --git a/Makefile.SH b/Makefile.SH
index 79fb16e536..6626e59c07 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -41,11 +41,6 @@ case "$0" in
 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
 esac
 
-case "$d_dosuid" in
-*define*) suidperl='suidperl' ;;
-*) suidperl='';;
-esac
-
 linklibperl='$(LIBPERL)'
 linklibperl_nonshr=''
 shrpldflags='$(LDDLFLAGS)'
@@ -304,7 +299,7 @@ DYNALOADER = DynaLoader\$(OBJ_EXT)
 
 libs = $perllibs $cryptlib
 
-public = perl\$(EXE_EXT) $suidperl utilities translators
+public = perl\$(EXE_EXT) utilities translators
 
 shellflags = $shellflags
 
@@ -532,15 +527,6 @@ all: $(FIRSTMAKEFILE) miniperl$(EXE_EXT) miniperl extra.pods $(private) $(unidat
 	@echo " ";
 	@echo "	Everything is up to date. Type '$(MAKE) test' to run test suite."
 
-sperl$(OBJ_EXT): perl.c $(h)
-	$(RMS) sperl.c
-	$(LNS) perl.c sperl.c
-	$(CCCMD) -DIAMSUID sperl.c
-	$(RMS) sperl.c
-
-sperl.i: perl.c $(h)
-	$(CCCMDSRC) -DIAMSUID -E perl.c > sperl.i
-
 .PHONY: all translators utilities
 
 git_version.h: miniperl$(EXE_EXT) make_patchnum.pl
@@ -548,7 +534,6 @@ git_version.h: miniperl$(EXE_EXT) make_patchnum.pl
 
 # make sure that we recompile perl.c if the git version changes
 perl$(OBJ_EXT): git_version.h
-sperl$(OBJ_EXT): git_version.h
 
 translators:	miniperl$(EXE_EXT) $(CONFIGPM) FORCE
 	@echo " "; echo "	Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all
@@ -919,30 +904,8 @@ perl.gcov: perl.config.gcov
 microperl:
 	$(MAKE) -f Makefile.micro
 
-# This version, if specified in Configure, does ONLY those scripts which need
-# set-id emulation.  Suidperl must be setuid root.  It contains the "taint"
-# checks as well as the special code to validate that the script in question
-# has been invoked correctly.
-
 !NO!SUBS!
 
-case "${osname}" in
-aix*)
-$spitshell >>Makefile <<'!NO!SUBS!'
-suidperl$(EXE_EXT): $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(static_ext) ext.libs $(PERLEXPORT)
-	$(SHRPENV) $(LDLIBPTH) $(CC) -o suidperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(static_ext) $(LLIBPERL_NONSHR) $(LLIBPERL) `cat ext.libs` $(libs)
-
-!NO!SUBS!
-;;
-*)
-$spitshell >>Makefile <<'!NO!SUBS!'
-suidperl$(EXE_EXT): $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(static_ext) ext.libs $(PERLEXPORT)
-	$(SHRPENV) $(LDLIBPTH) $(CC) -o suidperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
-
-!NO!SUBS!
-;;
-esac
-
 fi
 
 # Some environment have no system(), which mkpport uses.
@@ -1222,7 +1185,7 @@ _mopup:
 	-rm -f perl.pixie lib*.so.perl.pixie lib*.so.Addrs
 	-rm -f perl.Addrs perl.Counts t/perl.Addrs t/perl.Counts *perl.xok
 	-rm -f cygwin.c libperl*.def libperl*.dll cygperl*.dll *.exe.stackdump
-	-rm -f perl$(EXE_EXT) suidperl$(EXE_EXT) miniperl$(EXE_EXT) $(LIBPERL) libperl.* microperl
+	-rm -f perl$(EXE_EXT) miniperl$(EXE_EXT) $(LIBPERL) libperl.* microperl
 	-rm -f opcode.h-old opnames.h-old pp.sym-old pp_proto.h-old
 	-rm -f config.arch config.over $(DTRACE_H)
 
diff --git a/embed.fnc b/embed.fnc
index 45d8923668..162bca7cf6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1485,27 +1485,10 @@ s	|void	|nuke_stacks
 s	|int	|open_script	|NN const char *scriptname|bool dosearch \
 				|NN bool *suidscript|NN PerlIO **rsfpp
 s	|void	|usage		|NN const char *name
-#ifdef DOSUID
-#  ifdef IAMSUID
-so	|void	|validate_suid	|NN const char *validarg \
-				|int fdscript \
-				|bool suidscript|NN SV* linestr_sv \
-				|NN PerlIO *rsfp
-#  else
-so	|void	|validate_suid	|NN const char *validarg \
-				|NN const char *scriptname|int fdscript \
-				|NN SV* linestr_sv \
-				|NN PerlIO *rsfp
-#  endif
-#else
-#  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
 so	|void	|validate_suid	|NN PerlIO *rsfp
-#  endif
 #endif
 
-#  if defined(IAMSUID)
-s	|int	|fd_on_nosuid_fs|int fd
-#  endif
 s	|void*	|parse_body	|NULLOK char **env|XSINIT_t xsinit
 rs	|void	|run_body	|I32 oldscope
 s	|SV *	|incpush_if_exists|NN SV *dir
diff --git a/embed.h b/embed.h
index d7a437ee4b..de4f11f3d1 100644
--- a/embed.h
+++ b/embed.h
@@ -1299,19 +1299,8 @@
 #define open_script		S_open_script
 #define usage			S_usage
 #endif
-#ifdef DOSUID
-#  ifdef IAMSUID
-#  else
-#  endif
-#else
-#  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
-#  endif
+#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
 #endif
-#  if defined(IAMSUID)
-#ifdef PERL_CORE
-#define fd_on_nosuid_fs		S_fd_on_nosuid_fs
-#endif
-#  endif
 #ifdef PERL_CORE
 #define parse_body		S_parse_body
 #define run_body		S_run_body
@@ -3648,25 +3637,10 @@
 #define open_script(a,b,c,d)	S_open_script(aTHX_ a,b,c,d)
 #define usage(a)		S_usage(aTHX_ a)
 #endif
-#ifdef DOSUID
-#  ifdef IAMSUID
-#ifdef PERL_CORE
-#endif
-#  else
+#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef PERL_CORE
 #endif
-#  endif
-#else
-#  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
-#ifdef PERL_CORE
 #endif
-#  endif
-#endif
-#  if defined(IAMSUID)
-#ifdef PERL_CORE
-#define fd_on_nosuid_fs(a)	S_fd_on_nosuid_fs(aTHX_ a)
-#endif
-#  endif
 #ifdef PERL_CORE
 #define parse_body(a,b)		S_parse_body(aTHX_ a,b)
 #define run_body(a)		S_run_body(aTHX_ a)
diff --git a/installperl b/installperl
index d8d36be7d6..93c0c9fa67 100755
--- a/installperl
+++ b/installperl
@@ -217,7 +217,6 @@ if ($nwinstall) {
     $installsitelib = $Config{installnwlib};
 }
 
-my $d_dosuid = $Config{d_dosuid};
 my $binexp = $Config{binexp};
 
 if ($Is_VMS) {  # Hang in there until File::Spec hits the big time
@@ -230,8 +229,6 @@ if ($Is_VMS) {  # Hang in there until File::Spec hits the big time
 
 # Do some quick sanity checks.
 
-if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
-
    $installbin		|| die "No installbin directory in config.sh\n";
 -d $installbin		|| mkpath($installbin, $opts{verbose}, 0777);
 -d $installbin		|| $opts{notify} || die "$installbin is not a directory\n";
@@ -248,7 +245,6 @@ else {
         -x $dbg . 'perl' . $exe_ext	|| die "${dbg}perl$exe_ext isn't executable!\n";
     }
 }
--x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
 
 -f 't/rantests'		|| $Is_W32
 			|| warn "WARNING: You've never run 'make test' or",
@@ -336,12 +332,6 @@ else {
     copy("perl.exe", "$installbin/$perl.exe");
 }
 
-safe_unlink("$installbin/s$perl_verbase$ver$exe_ext");
-if ($d_dosuid) {
-    copy("suidperl$exe_ext", "$installbin/s$perl_verbase$ver$exe_ext");
-    chmod(04711, "$installbin/s$perl_verbase$ver$exe_ext");
-}
-
 # Install library files.
 
 my ($do_installarchlib, $do_installprivlib) = (0, 0);
@@ -437,9 +427,6 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VM
 	link("$installbin/$perl_verbase$ver$exe_ext",
 		"$installbin/$perl$exe_ext");
     }
-    link("$installbin/$perl_verbase$ver$exe_ext",
-	    "$installbin/suid$perl$exe_ext")
-      if $d_dosuid;
 }
 
 # For development purposes it can be very useful to have multiple perls
diff --git a/perl.c b/perl.c
index fc8e6555d9..4eb5148b5e 100644
--- a/perl.c
+++ b/perl.c
@@ -22,65 +22,6 @@
  * function of the interpreter; that can be found in perlmain.c
  */
 
-/* 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, opens script and notices it 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 (see comments elsewhere).
- * 
- * References:
- * Original bug report:
- *   http://bugs.perl.org/index.html?req=bug_id&bug_id=20010322.218
- *   http://rt.perl.org/rt2/Ticket/Display.html?id=6511
- * Comments and discussion with Debian:
- *   http://bugs.debian.org/203426
- *   http://bugs.debian.org/220486
- * Debian Security Advisory DSA 431-1 (does not fully fix problem):
- *   http://www.debian.org/security/2004/dsa-431
- * CVE candidate:
- *   http://cve.mitre.org/cgi-bin/cvename.cgi?name=CAN-2003-0618
- * Previous versions of this patch sent to perl5-porters:
- *   http://www.mail-archive.com/perl5-porters@perl.org/msg71953.html
- *   http://www.mail-archive.com/perl5-porters@perl.org/msg75245.html
- *   http://www.mail-archive.com/perl5-porters@perl.org/msg75563.html
- *   http://www.mail-archive.com/perl5-porters@perl.org/msg75635.html
- * 
-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 Feb 04
- * Use global(?), thread-local fdscript for easier checks.
- * (I do not understand how we could possibly get a thread race:
- * do not all threads go through the same initialization? Or in
- * fact, are not threads started only after we get the script and
- * so know what to do? Oh well, make things super-safe...)
- */
-
 #include "EXTERN.h"
 #define PERL_IN_PERL_C
 #include "perl.h"
@@ -129,22 +70,12 @@ char *getenv (char *); /* Usually in <stdlib.h> */
 
 static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 
-#ifdef DOSUID
-#  ifdef IAMSUID
-/* Drop scriptname */
-#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ validarg, fdscript, suidscript, linestr_sv, rsfp)
-#  else
-/* Drop suidscript */
-#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ validarg, scriptname, fdscript, linestr_sv, rsfp)
-#  endif
-#else
-#  ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 /* Drop everything. Heck, don't even try to call it */
-#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) NOOP
-#  else
+#  define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) NOOP
+#else
 /* Drop almost everything */
-#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp)
-#  endif
+#  define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp)
 #endif
 
 #define CALL_BODY_EVAL(myop) \
@@ -1524,11 +1455,6 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     PERL_UNUSED_ARG(my_perl);
 #endif
 
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
-    Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now "
-	       "execute\nsetuid perl scripts securely.\n");
-#endif
-
 #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
     /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0
      * This MUST be done before any hash stores or fetches take place.
@@ -1709,9 +1635,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     char **argv = PL_origargv;
     const char *scriptname = NULL;
     VOL bool dosearch = FALSE;
-#ifdef DOSUID
-    const char *validarg = "";
-#endif
     register SV *sv;
     register char c;
     const char *cddir = NULL;
@@ -1733,18 +1656,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     for (argc--,argv++; argc > 0; argc--,argv++) {
 	if (argv[0][0] != '-' || !argv[0][1])
 	    break;
-#ifdef DOSUID
-    if (*validarg)
-	validarg = " PHOOEY ";
-    else
-	validarg = argv[0];
-    /*
-     * Can we rely on the kernel to start scripts with argv[1] set to
-     * contain all #! line switches (the whole line)? (argv[0] is set to
-     * the interpreter name, argv[2] to the script name; argv[3] and
-     * above may contain other arguments.)
-     */
-#endif
 	s = argv[0]+1;
       reswitch:
 	switch ((c = *s)) {
@@ -2070,13 +1981,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     {
 	bool suidscript = FALSE;
 
-#ifdef DOSUID
-	const int fdscript =
-#endif
-	    open_script(scriptname, dosearch, &suidscript, &rsfp);
+	open_script(scriptname, dosearch, &suidscript, &rsfp);
 
 	validate_suid(validarg, scriptname, fdscript, suidscript,
-		linestr_sv, rsfp);
+		      linestr_sv, rsfp);
 
 #ifndef PERL_MICRO
 #  if defined(SIGCHLD) || defined(SIGCLD)
@@ -3657,23 +3565,6 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
 	        fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
 #       endif
     }
-#ifdef IAMSUID
-    else {
-	Perl_croak(aTHX_ "sperl needs fd script\n"
-		   "You should not call sperl directly; do you need to "
-		   "change a #! line\nfrom sperl to perl?\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.
- */
-    }
-    if (!*suidscript) {
-	Perl_croak(aTHX_ "suidperl needs (suid) fd script\n");
-    }
-#else /* IAMSUID */
     else if (!*scriptname) {
 	forbid_setid(0, *suidscript);
 	*rsfpp = PerlIO_stdin();
@@ -3726,7 +3617,6 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
 	        fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
 #       endif
     }
-#endif /* IAMSUID */
     if (!*rsfpp) {
 	/* PSz 16 Sep 03  Keep neat error message */
 	if (PL_e_script)
@@ -3745,525 +3635,10 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
  * I_MNTENT	HAS_GETMNTENT	HAS_HASMNTOPT
  * here so that metaconfig picks them up. */
 
-#ifdef IAMSUID
-STATIC int
-S_fd_on_nosuid_fs(pTHX_ int fd)
-{
-/* PSz 27 Feb 04
- * We used to do this as "plain" user (after swapping UIDs with setreuid);
- * but is needed also on machines without setreuid.
- * Seems safe enough to run as root.
- */
-    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
-     * Need to check noexec also: nosuid might not be set, the average
-     * sysadmin would say that nosuid is irrelevant once he sets noexec.
-     */
-    int on_noexec  = 0; /* the fd is on a noexec fs */
-
-/*
- * Preferred order: fstatvfs(), fstatfs(), ustat()+getmnt(), getmntent().
- * fstatvfs() is UNIX98.
- * fstatfs() is 4.3 BSD.
- * ustat()+getmnt() is pre-4.3 BSD.
- * getmntent() is O(number-of-mounted-filesystems) and can hang on
- * an irrelevant filesystem while trying to reach the right one.
- */
-
-#undef FD_ON_NOSUID_CHECK_OKAY  /* found the syscalls to do the check? */
-
-#   if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
-        defined(HAS_FSTATVFS)
-#   define FD_ON_NOSUID_CHECK_OKAY
-    struct statvfs stfs;
-
-    check_okay = fstatvfs(fd, &stfs) == 0;
-    on_nosuid  = check_okay && (stfs.f_flag  & ST_NOSUID);
-#ifdef ST_NOEXEC
-    /* ST_NOEXEC certainly absent on AIX 5.1, and doesn't seem to be documented
-       on platforms where it is present.  */
-    on_noexec  = check_okay && (stfs.f_flag  & ST_NOEXEC);
-#endif
-#   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)
-#   define FD_ON_NOSUID_CHECK_OKAY
-    struct statfs  stfs;
-
-    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)		&& \
-        defined(HAS_STRUCT_FS_DATA)	&& \
-        defined(NOSTAT_ONE)
-#   define FD_ON_NOSUID_CHECK_OKAY
-    Stat_t fdst;
-
-    if (fstat(fd, &fdst) == 0) {
-        struct ustat us;
-        if (ustat(fdst.st_dev, &us) == 0) {
-            struct fs_data fsd;
-            /* NOSTAT_ONE here because we're not examining fields which
-             * vary between that case and STAT_ONE. */
-            if (getmnt((int*)0, &fsd, (int)0, NOSTAT_ONE, us.f_fname) == 0) {
-                size_t cmplen = sizeof(us.f_fname);
-                if (sizeof(fsd.fd_req.path) < cmplen)
-                    cmplen = sizeof(fsd.fd_req.path);
-                if (strnEQ(fsd.fd_req.path, us.f_fname, cmplen) &&
-                    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;
-                }
-            }
-        }
-    }
-#   endif /* fstat+ustat+getmnt */
-
-#   if !defined(FD_ON_NOSUID_CHECK_OKAY) && \
-        defined(HAS_GETMNTENT)		&& \
-        defined(HAS_HASMNTOPT)		&& \
-        defined(MNTOPT_NOSUID)		&& \
-        defined(MNTOPT_NOEXEC)
-#   define FD_ON_NOSUID_CHECK_OKAY
-    FILE                *mtab = fopen("/etc/mtab", "r");
-    struct mntent       *entry;
-    Stat_t              stb, fsb;
-
-    if (mtab && (fstat(fd, &stb) == 0)) {
-        while (entry = getmntent(mtab)) {
-            if (stat(entry->mnt_dir, &fsb) == 0
-                && fsb.st_dev == stb.st_dev)
-            {
-                /* found the filesystem */
-                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(). */
-        }
-    }
-    if (mtab)
-        fclose(mtab);
-#   endif /* getmntent+hasmntopt */
-
-    if (!check_okay)
-	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 */
 
-#ifdef DOSUID
-STATIC void
-S_validate_suid(pTHX_ const char *validarg,
-#  ifndef IAMSUID
-		const char *scriptname,
-#  endif
-		int fdscript,
-#  ifdef IAMSUID
-		bool suidscript,
-#  endif
-		SV *linestr_sv, PerlIO *rsfp)
-{
-    dVAR;
-    const char *s, *s2;
-
-    PERL_ARGS_ASSERT_VALIDATE_SUID;
-
-    /* do we need to emulate setuid on scripts? */
-
-    /* This code is for those BSD systems that have setuid #! scripts disabled
-     * in the kernel because of a security problem.  Merely defining DOSUID
-     * in perl will not fix that problem, but if you have disabled setuid
-     * scripts in the kernel, this will attempt to emulate setuid and setgid
-     * on scripts that have those now-otherwise-useless bits set.  The setuid
-     * root version must be called suidperl or sperlN.NNN.  If regular perl
-     * discovers that it has opened a setuid script, it calls suidperl with
-     * the same argv that it had.  If suidperl finds that the script it has
-     * just opened is NOT setuid root, it sets the effective uid back to the
-     * uid.  We don't just make perl setuid root because that loses the
-     * effective uid we had before invoking perl, if it was different from the
-     * uid.
-     * PSz 27 Feb 04
-     * Description/comments above do not match current workings:
-     *   suidperl must be hardlinked to sperlN.NNN (that is what we exec);
-     *   suidperl called with script open and name changed to /dev/fd/N/X;
-     *   suidperl croaks if script is not setuid;
-     *   making perl setuid would be a huge security risk (and yes, that
-     *     would lose any euid we might have had).
-     *
-     * DOSUID must be defined in both perl and suidperl, and IAMSUID must
-     * be defined in suidperl only.  suidperl must be setuid root.  The
-     * Configure script will set this up for you if you want it.
-     */
-
-    if (PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf) < 0)	/* normal stat is insecure */
-	Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename);
-    if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
-	I32 len;
-	const char *linestr;
-	const char *s_end;
-
-#  ifdef IAMSUID
-	if (fdscript < 0 || !suidscript)
-	    Perl_croak(aTHX_ "Need (suid) fdscript 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(?!).
-	 */
-	/* PSz 27 Feb 04
-	 * Do checks even for systems with no HAS_SETREUID.
-	 * We used to swap, then re-swap UIDs with
-#    ifdef HAS_SETREUID
-	    if (setreuid(PL_euid,PL_uid) < 0
-		|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
-		Perl_croak(aTHX_ "Can't swap uid and euid");
-#    endif
-#    ifdef HAS_SETREUID
-	    if (setreuid(PL_uid,PL_euid) < 0
-		|| PerlProc_getuid() != PL_uid || PerlProc_geteuid() != PL_euid)
-		Perl_croak(aTHX_ "Can't reswap uid and euid");
-#    endif
-	 */
-
-	/* On this access check to make sure the directories are readable,
-	 * there is actually a small window that the user could use to make
-	 * filename point to an accessible directory.  So there is a faint
-	 * chance that someone could execute a setuid script down in a
-	 * non-accessible directory.  I don't know what to do about that.
-	 * But I don't think it's too important.  The manual lies when
-	 * it says access() is useful in setuid programs.
-	 * 
-	 * So, access() is pretty useless... but not harmful... do anyway.
-	 */
-	if (PerlLIO_access(CopFILE(PL_curcop),1)) { /*double check*/
-	    Perl_croak(aTHX_ "Can't access() script\n");
-	}
-
-	/* 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.
-	 * 
-	 * PSz 24 Feb 04
-	 * As the script is opened by perl, not suidperl, we do not need to
-	 * care much about access rights.
-	 * 
-	 * The 'script changed' check is needed, or we can get lied to
-	 * about $0 with e.g.
-	 *  suidperl /dev/fd/4//bin/x 4<setuidscript
-	 * Without HAS_SETREUID, is it safe to stat() as root?
-	 * 
-	 * 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.
-	 * 
-	 * This is one place where we must "lie" about return status: not
-	 * say if the stat() failed. We are doing this as root, and could
-	 * be tricked into reporting existence or not of files that the
-	 * "plain" user cannot even see.
-	 */
-	{
-	    Stat_t tmpstatbuf;
-	    if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0 ||
-		tmpstatbuf.st_dev != PL_statbuf.st_dev ||
-		tmpstatbuf.st_ino != PL_statbuf.st_ino) {
-		Perl_croak(aTHX_ "Setuid script changed\n");
-	    }
-
-	}
-	if (!cando(S_IXUSR,FALSE,&PL_statbuf))		/* can real uid exec? */
-	    Perl_croak(aTHX_ "Real UID cannot exec script\n");
-
-	/* PSz 27 Feb 04
-	 * We used to do this check as the "plain" user (after swapping
-	 * UIDs). But the check for nosuid and noexec filesystem is needed,
-	 * and should be done even without HAS_SETREUID. (Maybe those
-	 * operating systems do not have such mount options anyway...)
-	 * Seems safe enough to do as root.
-	 */
-#    if !defined(NO_NOSUID_CHECK)
-	if (fd_on_nosuid_fs(PerlIO_fileno(rsfp))) {
-	    Perl_croak(aTHX_ "Setuid script on nosuid or noexec filesystem\n");
-	}
-#    endif
-#  endif /* IAMSUID */
-
-	if (!S_ISREG(PL_statbuf.st_mode)) {
-	    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(linestr_sv, rsfp, 0) == NULL)
-	    Perl_croak(aTHX_ "No #! line");
-	linestr = SvPV_nolen_const(linestr_sv);
-	/* required even on Sys V */
-	if (!*linestr || !linestr[1] || strnNE(linestr,"#!",2))
-	    Perl_croak(aTHX_ "No #! line");
-	linestr += 2;
-	s = linestr;
-	/* PSz 27 Feb 04 */
-	/* Sanity check on line length */
-	s_end = s + strlen(s);
-	if (s_end == s || (s_end - s) > 4000)
-	    Perl_croak(aTHX_ "Very long #! line");
-	/* Allow more than a single space after #! */
-	while (isSPACE(*s)) s++;
-	/* Sanity check on buffer end */
-	while ((*s) && !isSPACE(*s)) s++;
-	for (s2 = s;  (s2 > linestr &&
-		       (isDIGIT(s2[-1]) || s2[-1] == '.' || s2[-1] == '_'
-			|| s2[-1] == '-'));  s2--) ;
-	/* Sanity check on buffer start */
-	if ( (s2-4 < linestr || strnNE(s2-4,"perl",4)) &&
-	      (s-9 < linestr || strnNE(s-9,"perl",4)) )
-	    Perl_croak(aTHX_ "Not a perl script");
-	while (*s == ' ' || *s == '\t') s++;
-	/*
-	 * #! arg must be what we saw above.  They can invoke it by
-	 * mentioning suidperl explicitly, but they may not add any strange
-	 * arguments beyond what #! says if they do invoke suidperl that way.
-	 */
-	/*
-	 * The way validarg was set up, we rely on the kernel to start
-	 * scripts with argv[1] set to contain all #! line switches (the
-	 * whole line).
-	 */
-	/*
-	 * Check that we got all the arguments listed in the #! line (not
-	 * just that there are no extraneous arguments). Might not matter
-	 * much, as switches from #! line seem to be acted upon (also), and
-	 * so may be checked and trapped in perl. But, security checks must
-	 * be done in suidperl and not deferred to perl. Note that suidperl
-	 * does not get around to parsing (and checking) the switches on
-	 * the #! line (but execs perl sooner).
-	 * Allow (require) a trailing newline (which may be of two
-	 * characters on some architectures?) (but no other trailing
-	 * whitespace).
-	 */
-	len = strlen(validarg);
-	if (strEQ(validarg," PHOOEY ") ||
-	    strnNE(s,validarg,len) || !isSPACE(s[len]) ||
-	    !((s_end - s) == len+1
-	      || ((s_end - s) == len+2 && isSPACE(s[len+1]))))
-	    Perl_croak(aTHX_ "Args must match #! line");
-
-#  ifndef IAMSUID
-	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 (fdscript < 0 &&
-	    PL_euid) {	/* oops, we're not the setuid root perl */
-	    /* PSz 18 Feb 04
-	     * When root runs a setuid script, we do not go through the same
-	     * steps of execing sperl and then perl with fd scripts, but
-	     * simply set up UIDs within the same perl invocation; so do
-	     * not have the same checks (on options, whatever) that we have
-	     * for plain users. No problem really: would have to be a script
-	     * that does not actually work for plain users; and if root is
-	     * foolish and can be persuaded to run such an unsafe script, he
-	     * might run also non-setuid ones, and deserves what he gets.
-	     * 
-	     * Or, we might drop the PL_euid check above (and rely just on
-	     * fdscript to avoid loops), and do the execs
-	     * even for root.
-	     */
-#  ifndef IAMSUID
-	    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;
-	     * in fact will use that to distinguish this from "normal"
-	     * usage, see comments above.
-	     */
-	    PerlIO_rewind(rsfp);
-	    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
-	    /* PSz 27 Feb 04  Sanity checks on scriptname */
-	    if ((!scriptname) || (!*scriptname) ) {
-		Perl_croak(aTHX_ "No setuid script name\n");
-	    }
-	    if (*scriptname == '-') {
-		Perl_croak(aTHX_ "Setuid script name may not begin with dash\n");
-		/* Or we might confuse it with an option when replacing
-		 * name in argument list, below (though we do pointer, not
-		 * string, comparisons).
-		 */
-	    }
-	    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(rsfp), PL_origargv[which]));
-#    if defined(HAS_FCNTL) && defined(F_SETFD)
-	    fcntl(PerlIO_fileno(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 /* 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) {
-/* PSz 26 Feb 04
- * This seems back to front: we try HAS_SETEGID first; if not available
- * then try HAS_SETREGID; as a last chance we try HAS_SETRESGID. May be OK
- * in the sense that we only want to set EGID; but are there any machines
- * with either of the latter, but not the former? Same with UID, later.
- */
-#  ifdef HAS_SETEGID
-	    (void)setegid(PL_statbuf.st_gid);
-#  else
-#    ifdef HAS_SETREGID
-           (void)setregid((Gid_t)-1,PL_statbuf.st_gid);
-#    else
-#      ifdef HAS_SETRESGID
-           (void)setresgid((Gid_t)-1,PL_statbuf.st_gid,(Gid_t)-1);
-#      else
-	    PerlProc_setgid(PL_statbuf.st_gid);
-#      endif
-#    endif
-#  endif
-	    if (PerlProc_getegid() != PL_statbuf.st_gid)
-		Perl_croak(aTHX_ "Can't do setegid!\n");
-	}
-	if (PL_statbuf.st_mode & S_ISUID) {
-	    if (PL_statbuf.st_uid != PL_euid)
-#  ifdef HAS_SETEUID
-		(void)seteuid(PL_statbuf.st_uid);	/* all that for this */
-#  else
-#    ifdef HAS_SETREUID
-                (void)setreuid((Uid_t)-1,PL_statbuf.st_uid);
-#    else
-#      ifdef HAS_SETRESUID
-                (void)setresuid((Uid_t)-1,PL_statbuf.st_uid,(Uid_t)-1);
-#      else
-		PerlProc_setuid(PL_statbuf.st_uid);
-#      endif
-#    endif
-#  endif
-	    if (PerlProc_geteuid() != PL_statbuf.st_uid)
-		Perl_croak(aTHX_ "Can't do seteuid!\n");
-	}
-	else if (PL_uid) {			/* oops, mustn't run as root */
-#  ifdef HAS_SETEUID
-          (void)seteuid((Uid_t)PL_uid);
-#  else
-#    ifdef HAS_SETREUID
-          (void)setreuid((Uid_t)-1,(Uid_t)PL_uid);
-#    else
-#      ifdef HAS_SETRESUID
-          (void)setresuid((Uid_t)-1,(Uid_t)PL_uid,(Uid_t)-1);
-#      else
-          PerlProc_setuid((Uid_t)PL_uid);
-#      endif
-#    endif
-#  endif
-	    if (PerlProc_geteuid() != PL_uid)
-		Perl_croak(aTHX_ "Can't do seteuid!\n");
-	}
-	init_ids();
-	if (!cando(S_IXUSR,TRUE,&PL_statbuf))
-	    Perl_croak(aTHX_ "Effective UID cannot exec script\n");	/* they can't do this */
-    }
-#  ifdef IAMSUID
-    else if (fdscript < 0 || !suidscript)
-	/* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
-	Perl_croak(aTHX_ "(suid) fdscript needed in suidperl\n");
-    else {
-/* 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 */
-    /* exec the real perl, substituting fd script for scriptname. */
-    /* (We pass script name as "subdir" of fd, which perl will grok.) */
-    /* 
-     * It might be thought that using setresgid and/or setresuid (changed to
-     * set the saved IDs) above might obviate the need to exec, and we could
-     * go on to "do the perl thing".
-     * 
-     * Is there such a thing as "saved GID", and is that set for setuid (but
-     * not setgid) execution like suidperl? Without exec, it would not be
-     * cleared for setuid (but not setgid) scripts (or might need a dummy
-     * setresgid).
-     * 
-     * We need suidperl to do the exact same argument checking that perl
-     * does. Thus it cannot be very small; while it could be significantly
-     * smaller, it is safer (simpler?) to make it essentially the same
-     * binary as perl (but they are not identical). - 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. Such deferral
-     * would make suidperl security rely on perl, a design no-no.
-     * 
-     * Setuid things should be short and simple, thus easy to understand and
-     * verify. They should do their "own thing", without influence by
-     * attackers. It may help if their internal execution flow is fixed,
-     * regardless of platform: it may be best to exec anyway.
-     * 
-     * Suidperl should at least be conceptually simple: a wrapper only,
-     * never to do any real perl. Maybe we should put
-     * #ifdef IAMSUID
-     *         Perl_croak(aTHX_ "Suidperl should never do real perl\n");
-     * #endif
-     * into the perly bits.
-     */
-    PerlIO_rewind(rsfp);
-    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
-    /* PSz 11 Nov 03
-     * Keep original arguments: suidperl already has fd script.
-     */
-#  if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(PerlIO_fileno(rsfp),F_SETFD,0);	/* ensure no close-on-exec */
-#  endif
-    PERL_FPU_PRE_EXEC
-    PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
-			     (int)PERL_REVISION, (int)PERL_VERSION,
-			     (int)PERL_SUBVERSION), PL_origargv);/* try again */
-    PERL_FPU_POST_EXEC
-    Perl_croak(aTHX_ "Can't do setuid (suidperl cannot exec perl)\n");
-#  endif /* IAMSUID */
-}
-
-#else /* !DOSUID */
-
-#  ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 /* Don't even need this function.  */
-#  else
+#else
 STATIC void
 S_validate_suid(pTHX_ PerlIO *rsfp)
 {
@@ -4283,8 +3658,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	/* not set-id, must be wrapped */
     }
 }
-#  endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
-#endif /* DOSUID */
+#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
 
 STATIC void
 S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
@@ -4442,34 +3816,8 @@ S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */
     if (PL_egid != PL_gid)
         Perl_croak(aTHX_ "No %s allowed while running setgid", message);
 #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
-    /* PSz 29 Feb 04
-     * Checks for UID/GID above "wrong": why disallow
-     *   perl -e 'print "Hello\n"'
-     * from within setuid things?? Simply drop them: replaced by
-     * fdscript/suidscript and #ifdef IAMSUID checks below.
-     * 
-     * This may be too late for command-line switches. Will catch those on
-     * the #! line, after finding the script name and setting up
-     * fdscript/suidscript. Note that suidperl does not get around to
-     * parsing (and checking) the switches on the #! line, but checks that
-     * the two sets are identical.
-     * 
-     * With SETUID_SCRIPTS_ARE_SECURE_NOW, could we use fdscript, also or
-     * instead, or would that be "too late"? (We never have suidscript, can
-     * we be sure to have fdscript?)
-     * 
-     * Catch things with suidscript (in descendant of suidperl), even with
-     * right UID/GID. Was already checked in suidperl, with #ifdef IAMSUID,
-     * below; but I am paranoid.
-     * 
-     * Also see comments about root running a setuid script, elsewhere.
-     */
     if (suidscript)
         Perl_croak(aTHX_ "No %s allowed with (suid) fdscript", message);
-#ifdef IAMSUID
-    /* PSz 11 Nov 03  Catch it in suidperl, always! */
-    Perl_croak(aTHX_ "No %s allowed in suidperl", message);
-#endif /* IAMSUID */
 }
 
 void
diff --git a/perl.h b/perl.h
index 52d90f89f0..982db702cf 100644
--- a/perl.h
+++ b/perl.h
@@ -41,24 +41,6 @@
 #   endif
 #endif
 
-/* This logic needs to come after reading config.h, but before including
-   proto.h  */
-#ifdef IAMSUID
-#  ifndef DOSUID
-#    define DOSUID
-#  endif
-#endif
-
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-#  ifdef DOSUID
-#    undef DOSUID
-#  endif
-#  ifdef IAMSUID
-#    undef IAMSUID
-#    define SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
-#  endif
-#endif
-
 /* See L<perlguts/"The Perl API"> for detailed notes on
  * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
 
@@ -5749,64 +5731,6 @@ int flock(int fd, int op);
 #   endif
 #endif
 
-#ifdef IAMSUID
-
-#ifdef I_SYS_STATVFS
-#   if defined(PERL_SCO) && !defined(_SVID3)
-#       define _SVID3
-#   endif
-#   include <sys/statvfs.h>     /* for f?statvfs() */
-#endif
-#ifdef I_SYS_MOUNT
-#   include <sys/mount.h>       /* for *BSD f?statfs() */
-#endif
-#ifdef I_MNTENT
-#   include <mntent.h>          /* for getmntent() */
-#endif
-#ifdef I_SYS_STATFS
-#   include <sys/statfs.h>      /* for some statfs() */
-#endif
-#ifdef I_SYS_VFS
-#  ifdef __sgi
-#    define sv IRIX_sv		/* kludge: IRIX has an sv of its own */
-#  endif
-#    include <sys/vfs.h>	/* for some statfs() */
-#  ifdef __sgi
-#    undef IRIX_sv
-#  endif
-#endif
-#ifdef I_USTAT
-#   include <ustat.h>           /* for ustat() */
-#endif
-
-#if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID)
-#    define PERL_MOUNT_NOSUID MOUNT_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
-#    define PERL_MOUNT_NOSUID MNT_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
-#   define PERL_MOUNT_NOSUID MS_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
-#   define PERL_MOUNT_NOSUID M_NOSUID
-#endif
-
-#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
-
-#endif /* IAMSUID */
-
 #ifdef I_LIBUTIL
 #   include <libutil.h>		/* setproctitle() in some FreeBSDs */
 #endif
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 5a3fed57dc..9aeaff7a0d 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -651,24 +651,6 @@ inplace editing with the B<-i> switch.  The file was ignored.
 regexp to match something 0 times, just put {0}. The <-- HERE shows in the
 regular expression about where the problem was discovered. See L<perlre>.
 
-=item Can't do setegid!
-
-(P) The setegid() call failed for some reason in the setuid emulator of
-suidperl.
-
-=item Can't do seteuid!
-
-(P) The setuid emulator of suidperl failed for some reason.
-
-=item Can't do setuid
-
-(F) This typically means that ordinary perl tried to exec suidperl to do
-setuid emulation, but couldn't exec it.  It looks for a name of the form
-sperl5.000 in the same directory that the perl executable resides under
-the name perl5.000, typically /usr/local/bin on Unix machines.  If the
-file is there, check the execute permissions.  If it isn't, ask your
-sysadmin why he and/or she removed it.
-
 =item Can't do waitpid with flags
 
 (F) This machine doesn't have either waitpid() or wait4(), so only
@@ -1042,11 +1024,6 @@ to reopen it to accept binary data.  Alas, it failed.
 to a subroutine reference): no such method callable via the package. If
 method name is C<???>, this is an internal error.
 
-=item Can't reswap uid and euid
-
-(P) The setreuid() call failed for some reason in the setuid emulator of
-suidperl.
-
 =item Can't return %s from lvalue subroutine
 
 (F) Perl detected an attempt to return illegal lvalues (such as
@@ -1071,11 +1048,6 @@ list context.
 (P) For some reason you can't fstat() the script even though you have it
 open already.  Bizarre.
 
-=item Can't swap uid and euid
-
-(P) The setreuid() call failed for some reason in the setuid emulator of
-suidperl.
-
 =item Can't take log of %g
 
 (F) For ordinary real numbers, you can't take the logarithm of a
@@ -3297,10 +3269,6 @@ the problem, however, you will get the same error message each time
 you run Perl.  How to really fix the problem can be found in
 L<perllocale> section B<LOCALE PROBLEMS>.
 
-=item Permission denied
-
-(F) The setuid emulator in suidperl decided you were up to no good.
-
 =item pid %x not a child
 
 (W exec) A warning peculiar to VMS.  Waitpid() was asked to wait for a
@@ -3725,11 +3693,6 @@ as a list, you need to look into how references work, because Perl will
 not magically convert between scalars and lists for you.  See
 L<perlref>.
 
-=item Script is not setuid/setgid in suidperl
-
-(F) Oddly, the suidperl program was invoked on a script without a setuid
-or setgid bit set.  This doesn't make much sense.
-
 =item Search pattern not terminated
 
 (F) The lexer couldn't find the final delimiter of a // or m{}
@@ -4017,11 +3980,6 @@ length of the string.  See L<perlfunc/substr>.  This warning is fatal if
 substr is used in an lvalue context (as the left hand side of an
 assignment or as a subroutine argument for example).
 
-=item suidperl is no longer needed since %s
-
-(F) Your Perl was compiled with B<-D>SETUID_SCRIPTS_ARE_SECURE_NOW, but
-a version of the setuid emulator somehow got run anyway.
-
 =item sv_upgrade from type %d down to type %d
 
 (P) Perl tried to force the upgrade an SV to a type which was actually
diff --git a/pod/perlsec.pod b/pod/perlsec.pod
index 59980d6a86..05d95887d5 100644
--- a/pod/perlsec.pod
+++ b/pod/perlsec.pod
@@ -352,11 +352,7 @@ changed, especially if you have symbolic links on your system.
 Fortunately, sometimes this kernel "feature" can be disabled.
 Unfortunately, there are two ways to disable it.  The system can simply
 outlaw scripts with any set-id bit set, which doesn't help much.
-Alternately, it can simply ignore the set-id bits on scripts.  If the
-latter is true, Perl can emulate the setuid and setgid mechanism when it
-notices the otherwise useless setuid/gid bits on Perl scripts.  It does
-this via a special executable called F<suidperl> that is automatically
-invoked for you if it's needed.
+Alternately, it can simply ignore the set-id bits on scripts.
 
 However, if the kernel set-id script feature isn't disabled, Perl will
 complain loudly that your set-id script is insecure.  You'll need to
@@ -387,9 +383,6 @@ program that builds Perl tries to figure this out for itself, so you
 should never have to specify this yourself.  Most modern releases of
 SysVr4 and BSD 4.4 use this approach to avoid the kernel race condition.
 
-Prior to release 5.6.1 of Perl, bugs in the code of F<suidperl> could
-introduce a security hole.
-
 =head2 Protecting Your Programs
 
 There are a number of ways to hide the source to your Perl programs,
diff --git a/proto.h b/proto.h
index dd927faf62..157038ff4b 100644
--- a/proto.h
+++ b/proto.h
@@ -4786,38 +4786,14 @@ STATIC void	S_usage(pTHX_ const char *name)
 #define PERL_ARGS_ASSERT_USAGE	\
 	assert(name)
 
-#ifdef DOSUID
-#  ifdef IAMSUID
-STATIC void	S_validate_suid(pTHX_ const char *validarg, int fdscript, bool suidscript, SV* linestr_sv, PerlIO *rsfp)
-			__attribute__nonnull__(pTHX_1)
-			__attribute__nonnull__(pTHX_4)
-			__attribute__nonnull__(pTHX_5);
-#define PERL_ARGS_ASSERT_VALIDATE_SUID	\
-	assert(validarg); assert(linestr_sv); assert(rsfp)
-
-#  else
-STATIC void	S_validate_suid(pTHX_ const char *validarg, const char *scriptname, int fdscript, SV* linestr_sv, PerlIO *rsfp)
-			__attribute__nonnull__(pTHX_1)
-			__attribute__nonnull__(pTHX_2)
-			__attribute__nonnull__(pTHX_4)
-			__attribute__nonnull__(pTHX_5);
-#define PERL_ARGS_ASSERT_VALIDATE_SUID	\
-	assert(validarg); assert(scriptname); assert(linestr_sv); assert(rsfp)
-
-#  endif
-#else
-#  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
 STATIC void	S_validate_suid(pTHX_ PerlIO *rsfp)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_VALIDATE_SUID	\
 	assert(rsfp)
 
-#  endif
 #endif
 
-#  if defined(IAMSUID)
-STATIC int	S_fd_on_nosuid_fs(pTHX_ int fd);
-#  endif
 STATIC void*	S_parse_body(pTHX_ char **env, XSINIT_t xsinit);
 STATIC void	S_run_body(pTHX_ I32 oldscope)
 			__attribute__noreturn__;