[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

diff --git a/embedvar.h b/embedvar.h
index 9df0554..69dcc3c 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -109,8 +109,7 @@
 #define doswitches             (curinterp->Idoswitches)
 #define dowarn                 (curinterp->Idowarn)
 #define dumplvl                        (curinterp->Idumplvl)
-#define e_fp                   (curinterp->Ie_fp)
-#define e_tmpname              (curinterp->Ie_tmpname)
+#define e_script               (curinterp->Ie_script)
 #define endav                  (curinterp->Iendav)
 #define envgv                  (curinterp->Ienvgv)
 #define errgv                  (curinterp->Ierrgv)
@@ -229,8 +228,7 @@
 #define Idoswitches            doswitches
 #define Idowarn                        dowarn
 #define Idumplvl               dumplvl
-#define Ie_fp                  e_fp
-#define Ie_tmpname             e_tmpname
+#define Ie_script              e_script
 #define Iendav                 endav
 #define Ienvgv                 envgv
 #define Ierrgv                 errgv
@@ -411,8 +409,7 @@
 #define doswitches             Perl_doswitches
 #define dowarn                 Perl_dowarn
 #define dumplvl                        Perl_dumplvl
-#define e_fp                   Perl_e_fp
-#define e_tmpname              Perl_e_tmpname
+#define e_script               Perl_e_script
 #define endav                  Perl_endav
 #define envgv                  Perl_envgv
 #define errgv                  Perl_errgv

diff --git a/interp.sym b/interp.sym
index ce9ca77..f54fcf0 100644 (file)
--- a/interp.sym
+++ b/interp.sym
@@ -37,8 +37,7 @@ doextract
 doswitches
 dowarn
 dumplvl
-e_fp
-e_tmpname
+e_script
 endav
 envgv
 errgv

diff --git a/intrpvar.h b/intrpvar.h
index c1a7b36..a1ec59b 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -31,8 +31,7 @@ PERLVAR(Isawstudy,    bool)           /* do fbm_instr on all strings */
 PERLVAR(Isawvec,       bool)           
 PERLVAR(Iunsafe,       bool)           
 PERLVAR(Iinplace,      char *)         
-PERLVAR(Ie_tmpname,    char *)         
-PERLVAR(Ie_fp,         PerlIO *)               
+PERLVAR(Ie_script,     SV *)           
 PERLVAR(Iperldb,       U32)            
 
 /* This value may be raised by extensions for testing purposes */

diff --git a/perl.c b/perl.c
index dbe06dd..3cdbcfa 100644 (file)
--- 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);