Upgrade to Math::BigInt 1.66.

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 0a3ec0f..acce020 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2877,12 +2877,11 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
     }
     else if (PL_preprocess) {
        char *cpp_cfg = CPPSTDIN;
-
-       if (cpp_cfg[0] == 0) /* PERL_MICRO? */
-            Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined");
        SV *cpp = newSVpvn("",0);
        SV *cmd = NEWSV(0,0);
 
+       if (cpp_cfg[0] == 0) /* PERL_MICRO? */
+            Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined");
        if (strEQ(cpp_cfg, "cppstdin"))
            Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
        sv_catpv(cpp, cpp_cfg);
@@ -2992,8 +2991,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 #       endif
 #       ifdef IAMSUID
             errno = EPERM;
-            Perl_croak(aTHX_ "Can't open perl script: %s\n",
-                       Strerror(errno));
+            Perl_croak(aTHX_ "Permission denied\n");
 #       else
             Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                        CopFILE(PL_curcop), Strerror(errno));
@@ -3155,8 +3153,10 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
         * But I don't think it's too important.  The manual lies when
         * it says access() is useful in setuid programs.
         */
-       if (PerlLIO_access(CopFILE(PL_curcop),1)) /*double check*/
-           Perl_croak(aTHX_ "Permission denied");
+       if (PerlLIO_access(CopFILE(PL_curcop),1)) { /*double check*/
+            errno = EPERM;
+           Perl_croak(aTHX_ "Permission denied\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
@@ -3176,15 +3176,20 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 #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)
-               Perl_croak(aTHX_ "Permission denied");  /* testing full pathname here */
+           if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0) {
+               errno = EPERM;
+               Perl_croak(aTHX_ "Permission denied\n");        /* testing full pathname here */
+           }
 #if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
-           if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
-               Perl_croak(aTHX_ "Permission denied");
+           if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) {
+               errno = EPERM;
+               Perl_croak(aTHX_ "Permission denied\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");
            }
            if (
@@ -3203,8 +3208,10 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 #endif /* HAS_SETREUID */
 #endif /* IAMSUID */
 
-       if (!S_ISREG(PL_statbuf.st_mode))
-           Perl_croak(aTHX_ "Permission denied");
+       if (!S_ISREG(PL_statbuf.st_mode)) {
+            errno = EPERM;
+           Perl_croak(aTHX_ "Permission denied\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 */
@@ -3312,8 +3319,10 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
        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
-       Perl_croak(aTHX_ "Script is not setuid/setgid in suidperl\n");
+    else {
+       errno = EPERM;
+       Perl_croak(aTHX_ "Permission denied\n");
+    }
 
     /* We absolutely must clear out any saved ids here, so we */
     /* exec the real perl, substituting fd script for scriptname. */
@@ -3321,8 +3330,10 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     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_ "Permission denied");
+    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)
@@ -3760,7 +3771,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
          for (; *env; env++) {
            if (!(s = strchr(*env,'=')))
                continue;
-#if defined(MSDOS)
+#if defined(MSDOS) && !defined(DJGPP)
            *s = '\0';
            (void)strupr(*env);
            *s = '=';