X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=a4e82333e9c42c72f8e78397966891bfaf53c085;hb=e17cb2a9c513ce1acd034452f9a933fcfa6c0129;hp=f8217ff1fa8a30c96c1d912a93a4f7c65e839687;hpb=c6ed36e16dcdd4c25349e4f9d5c84061095ccffb;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index f8217ff..a4e8233 100644
--- a/perl.c
+++ b/perl.c
@@ -24,6 +24,13 @@
 char *getenv _((char *)); /* Usually in <stdlib.h> */
 #endif
 
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
 dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
 
 #ifdef IAMSUID
@@ -169,6 +176,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 #endif
     }
 
+    init_stacks(ARGS);
 #ifdef MULTIPLICITY
     I_REINIT;
     perl_destruct_level = 1; 
@@ -204,7 +212,6 @@ perl_construct(register PerlInterpreter *sv_interp)
 
     fdpid = newAV();	/* for remembering popen pids by fd */
 
-    init_stacks(ARGS);
     DEBUG( {
 	New(51,debname,128,char);
 	New(52,debdelim,128,char);
@@ -320,6 +327,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
 	op_free(main_root);
 	main_root = Nullop;
     }
+    curcop = &compiling;
     main_start = Nullop;
     SvREFCNT_dec(main_cv);
     main_cv = Nullcv;
@@ -423,10 +431,6 @@ perl_destruct(register PerlInterpreter *sv_interp)
     endav = Nullav;
     initav = Nullav;
 
-    /* temp stack during pp_sort() */
-    SvREFCNT_dec(sortstack);
-    sortstack = Nullav;
-
     /* shortcuts just get cleared */
     envgv = Nullgv;
     siggv = Nullgv;
@@ -679,21 +683,36 @@ setuid perl scripts securely.\n");
 	    if (euid != uid || egid != gid)
 		croak("No -e allowed in setuid scripts");
 	    if (!e_fp) {
+#ifdef HAS_UMASK
+		int oldumask = PerlLIO_umask(0177);
+#endif
 	        e_tmpname = savepv(TMPPATH);
 #ifdef HAS_MKSTEMP
 		e_tmpfd = PerlLIO_mkstemp(e_tmpname);
-
-		if (e_tmpfd < 0)
-		    croak("Can't mkstemp() temporary file \"%s\"", e_tmpname);
-		e_fp = PerlIO_fdopen(e_tmpfd,"w");
 #else /* use mktemp() */
 		(void)PerlLIO_mktemp(e_tmpname);
 		if (!*e_tmpname)
-		    croak("Can't mktemp() temporary file \"%s\"", e_tmpname);
+		    croak("Cannot generate temporary filename");
+# if defined(HAS_OPEN3) && defined(O_EXCL)
+		e_tmpfd = open(e_tmpname,
+			       O_WRONLY | O_CREAT | O_EXCL,
+			       0600);
+# else
+		(void)UNLINK(e_tmpname);
+		/* Yes, potential race.  But at least we can say we tried. */
 		e_fp = PerlIO_open(e_tmpname,"w");
-#endif /* HAS_MKSTEMP */
+# endif
+#endif /* ifdef HAS_MKSTEMP */
+#if defined(HAS_MKSTEMP) || (defined(HAS_OPEN3) && defined(O_EXCL))
+		if (e_tmpfd < 0)
+		    croak("Cannot create temporary file \"%s\"", e_tmpname);
+		e_fp = PerlIO_fdopen(e_tmpfd,"w");
+#endif
   		if (!e_fp)
- 		    croak("Cannot open temporary file \"%s\"", e_tmpname);
+ 		    croak("Cannot create temporary file \"%s\"", e_tmpname);
+#ifdef HAS_UMASK
+		(void)PerlLIO_umask(oldumask);
+#endif
 	    }
 	    if (*++s)
 		PerlIO_puts(e_fp,s);
@@ -955,7 +974,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 int
 perl_run(PerlInterpreter *sv_interp)
 {
-    dTHR;
+    dSP;
     I32 oldscope;
     dJMPENV;
     int ret;
@@ -991,10 +1010,7 @@ perl_run(PerlInterpreter *sv_interp)
 	    JMPENV_POP;
 	    return 1;
 	}
-	if (curstack != mainstack) {
-	    dSP;
-	    SWITCHSTACK(curstack, mainstack);
-	}
+	POPSTACK_TO(mainstack);
 	break;
     }
 
@@ -2410,19 +2426,16 @@ init_debugger(void)
 void
 init_stacks(ARGSproto)
 {
-    curstack = newAV();
+    /* start with 128-item stack and 8K cxstack */
+    curstackinfo = new_stackinfo(REASONABLE(128),
+				 REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
+    curstackinfo->si_type = SI_MAIN;
+    curstack = curstackinfo->si_stack;
     mainstack = curstack;		/* remember in case we switch stacks */
-    AvREAL_off(curstack);		/* not a real array */
-    av_extend(curstack,REASONABLE(127));
 
     stack_base = AvARRAY(curstack);
     stack_sp = stack_base;
-    stack_max = stack_base + REASONABLE(127);
-
-    /* Use most of 8K. */
-    cxstack_max = REASONABLE(8192 / sizeof(PERL_CONTEXT) - 2);
-    New(50,cxstack,cxstack_max + 1,PERL_CONTEXT);
-    cxstack_ix	= -1;
+    stack_max = stack_base + AvMAX(curstack);
 
     New(50,tmps_stack,REASONABLE(128),SV*);
     tmps_floor = -1;
@@ -2442,6 +2455,8 @@ init_stacks(ARGSproto)
 	markstack_max = markstack + REASONABLE(32);
     }
 
+    SET_MARKBASE;
+
     if (scopestack) {
 	scopestack_ix = 0;
     } else {
@@ -2473,7 +2488,15 @@ static void
 nuke_stacks(void)
 {
     dTHR;
-    Safefree(cxstack);
+    while (curstackinfo->si_next)
+	curstackinfo = curstackinfo->si_next;
+    while (curstackinfo) {
+	PERL_SI *p = curstackinfo->si_prev;
+	/* curstackinfo->si_stack got nuked by sv_free_arenas() */
+	Safefree(curstackinfo->si_cxstack);
+	Safefree(curstackinfo);
+	curstackinfo = p;
+    }
     Safefree(tmps_stack);
     DEBUG( {
 	Safefree(debname);
@@ -2956,7 +2979,7 @@ my_failure_exit(void)
 static void
 my_exit_jump(void)
 {
-    dTHR;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
@@ -2971,6 +2994,7 @@ my_exit_jump(void)
 	e_tmpname = Nullch;
     }
 
+    POPSTACK_TO(mainstack);
     if (cxstack_ix >= 0) {
 	if (cxstack_ix > 0)
 	    dounwind(0);