[win32] merge change#995 from maintbranch, tweak interp.sym and

run embed.pl

p4raw-link: @995 on //depot/maint-5.004/perl: eed40d4c6e2818f110664d5fbaa0edac73f6b1a6

p4raw-id: //depot/win32/perl@1005

1 files changed, 37 insertions, 68 deletions

diff --git a/perl.c b/perl.c
index dbe06dd933..3cdbcfab42 100644
--- a/perl.c
+++ b/perl.c
@@ -87,6 +87,7 @@ static void nuke_stacks _((void));
 static void open_script _((char *, bool, SV *));
 static void usage _((char *));
 static void validate_suid _((char *, char*));
+static I32 read_e_script _((int idx, SV *buf_sv, int maxlen));
 
 static int fdscript = -1;
 
@@ -395,12 +396,9 @@ perl_destruct(register PerlInterpreter *sv_interp)
     Safefree(inplace);
     inplace = Nullch;
 
-    Safefree(e_tmpname);
-    e_tmpname = Nullch;
-
-    if (e_fp) {
-	PerlIO_close(e_fp);
-	e_fp = Nullfp;
+    if (e_script) {
+	SvREFCNT_dec(e_script);
+	e_script = Nullsv;
     }
 
     /* magical thingies */
@@ -579,7 +577,6 @@ perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **a
     char *validarg = "";
     I32 oldscope;
     AV* comppadlist;
-    int e_tmpfd = -1;
     dJMPENV;
     int ret;
 
@@ -604,7 +601,6 @@ setuid perl scripts securely.\n");
 #ifndef VMS  /* VMS doesn't have environ array */
     origenviron = environ;
 #endif
-    e_tmpname = Nullch;
 
     if (do_undump) {
 
@@ -699,48 +695,21 @@ setuid perl scripts securely.\n");
 	case 'e':
 	    if (euid != uid || egid != gid)
 		croak("No -e allowed in setuid scripts");
-	    if (!e_fp) {
-#if defined(HAS_UMASK) && !defined(VMS)
-		int oldumask = PerlLIO_umask(0177);
-#endif
-	        e_tmpname = savepv(TMPPATH);
-#ifdef HAS_MKSTEMP
-		e_tmpfd = PerlLIO_mkstemp(e_tmpname);
-#else /* use mktemp() */
-		(void)PerlLIO_mktemp(e_tmpname);
-		if (!*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
-#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 create temporary file \"%s\"", e_tmpname);
-#if defined(HAS_UMASK) && !defined(VMS)
-		(void)PerlLIO_umask(oldumask);
-#endif
+	    if (!e_script) {
+	        e_script = newSVpv("",0);
+		filter_add(read_e_script, NULL);
 	    }
 	    if (*++s)
-		PerlIO_puts(e_fp,s);
+		sv_catpv(e_script, s);
 	    else if (argv[1]) {
-		PerlIO_puts(e_fp,argv[1]);
+		sv_catpv(e_script, argv[1]);
 		argc--,argv++;
 	    }
 	    else
 		croak("No code specified for -e");
-	    (void)PerlIO_putc(e_fp,'\n');
+	    sv_catpv(e_script, "\n");
 	    break;
+
 	case 'I':	/* -I handled both here and in moreswitches() */
 	    forbid_setid("-I");
 	    if (!*++s && (s=argv[1]) != Nullch) {
@@ -875,16 +844,9 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     if (!scriptname)
 	scriptname = argv[0];
-    if (e_fp) {
-	if (PerlIO_flush(e_fp) || PerlIO_error(e_fp) || PerlIO_close(e_fp)) {
-#ifndef MULTIPLICITY
-	    warn("Did you forget to compile with -DMULTIPLICITY?");
-#endif	    
-	    croak("Can't write to temp file for -e: %s", Strerror(errno));
-	}
-	e_fp = Nullfp;
+    if (e_script) {
 	argc++,argv--;
-	scriptname = e_tmpname;
+	scriptname = BIT_BUCKET;	/* don't look for script or read stdin */
     }
     else if (scriptname == Nullch) {
 #ifdef MSDOS
@@ -960,11 +922,9 @@ print \"  \\@INC:\\n    @INC\\n\";");
     curcop->cop_line = 0;
     curstash = defstash;
     preprocess = FALSE;
-    if (e_tmpname) {
-	(void)UNLINK(e_tmpname);
-	Safefree(e_tmpname);
-	e_tmpname = Nullch;
-	e_tmpfd = -1;
+    if (e_script) {
+	SvREFCNT_dec(e_script);
+	e_script = Nullsv;
     }
 
     /* now that script is parsed, we can modify record separator */
@@ -1828,7 +1788,7 @@ open_script(char *scriptname, bool dosearch, SV *sv)
     }
     else
 	fdscript = -1;
-    origfilename = savepv(e_tmpname ? "-e" : scriptname);
+    origfilename = savepv(e_script ? "-e" : scriptname);
     curcop->cop_filegv = gv_fetchfile(origfilename);
     if (strEQ(origfilename,"-"))
 	scriptname = "";
@@ -1923,9 +1883,6 @@ sed %s -e \"/^[^#]/b\" \
 	    fcntl(PerlIO_fileno(rsfp),F_SETFD,1);  /* ensure close-on-exec */
 #endif
     }
-    if (e_tmpname) {
-	e_fp = rsfp;
-    }
     if (!rsfp) {
 #ifdef DOSUID
 #ifndef IAMSUID		/* in case script is not readable before setuid */
@@ -2211,6 +2168,23 @@ find_beginning(void)
     }
 }
 
+
+static I32
+read_e_script(int idx, SV *buf_sv, int maxlen)
+{
+    char *p, *nl;
+    FILTER_READ(idx+1, buf_sv, maxlen);
+    p  = SvPVX(e_script);
+    nl = strchr(p, '\n');
+    nl = (nl) ? nl+1 : SvEND(e_script);
+    if (nl-p == 0)
+	return 0;
+    sv_catpvn(buf_sv, p, nl-p);
+    sv_chop(e_script, nl);
+    return 1;
+}
+
+
 static void
 init_ids(void)
 {
@@ -2825,14 +2799,9 @@ my_exit_jump(void)
     I32 gimme;
     SV **newsp;
 
-    if (e_tmpname) {
-	if (e_fp) {
-	    PerlIO_close(e_fp);
-	    e_fp = Nullfp;
-	}
-	(void)UNLINK(e_tmpname);
-	Safefree(e_tmpname);
-	e_tmpname = Nullch;
+    if (e_script) {
+	SvREFCNT_dec(e_script);
+	e_script = Nullsv;
     }
 
     POPSTACK_TO(mainstack);