From: Gurusamy Sarathy Date: Sat, 16 May 1998 21:49:47 +0000 (+0000) Subject: [win32] merge change#995 from maintbranch, tweak interp.sym and X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=afe37c7d6a8905e6a383ca079ae3daa3025fd5e9;p=p5sagit%2Fp5-mst-13.2.git [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 --- 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 --- 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 --- 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 --- 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);