X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=d769b44e39eded254dd79393bfa14d0c064e0515;hb=94d58c47cfbe97ca0a689bcd5b7f9132f7918fee;hp=360f9a01ce68c3780532f8cc35a9c9ac5703efca;hpb=c07a80fdfe3926b5eb0585b674aa5d1f57b32ade;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 360f9a0..d769b44 100644 --- a/perl.c +++ b/perl.c @@ -46,6 +46,7 @@ static void init_postdump_symbols _((int, char **, char **)); static void init_predump_symbols _((void)); static void init_stacks _((void)); static void open_script _((char *, bool, SV *)); +static void usage _((char *)); static void validate_suid _((char *)); PerlInterpreter * @@ -114,7 +115,17 @@ register PerlInterpreter *sv_interp; #endif init_ids(); + +#if defined(SUBVERSION) && SUBVERSION > 0 + sprintf(patchlevel, "%7.5f", 5.0 + (PATCHLEVEL / 1000.0) + + (SUBVERSION / 100000.0)); +#else sprintf(patchlevel, "%5.3f", 5.0 + (PATCHLEVEL / 1000.0)); +#endif + +#if defined(LOCAL_PATCH_COUNT) + Ilocalpatches = local_patches; /* For possible -v */ +#endif fdpid = newAV(); /* for remembering popen pids by fd */ pidstatus = newHV();/* for remembering status of dead pids */ @@ -246,6 +257,7 @@ setuid perl scripts securely.\n"); #ifndef VMS /* VMS doesn't have environ array */ origenviron = environ; #endif + e_tmpname = Nullch; if (do_undump) { @@ -263,7 +275,7 @@ setuid perl scripts securely.\n"); op_free(main_root); main_root = 0; - switch (setjmp(top_env)) { + switch (Sigsetjmp(top_env,1)) { case 1: #ifdef VMS statusvalue = 255; @@ -397,8 +409,9 @@ setuid perl scripts securely.\n"); if (!scriptname) scriptname = argv[0]; if (e_fp) { - if (fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) + if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) croak("Can't write to temp file for -e: %s", Strerror(errno)); + e_fp = Nullfp; argc++,argv--; scriptname = e_tmpname; } @@ -464,9 +477,10 @@ setuid perl scripts securely.\n"); curcop->cop_line = 0; curstash = defstash; preprocess = FALSE; - if (e_fp) { - e_fp = Nullfp; + if (e_tmpname) { (void)UNLINK(e_tmpname); + Safefree(e_tmpname); + e_tmpname = Nullch; } /* now that script is parsed, we can modify record separator */ @@ -499,7 +513,7 @@ PerlInterpreter *sv_interp; { if (!(curinterp = sv_interp)) return 255; - switch (setjmp(top_env)) { + switch (Sigsetjmp(top_env,1)) { case 1: cxstack_ix = -1; /* start context stack again */ break; @@ -543,11 +557,11 @@ PerlInterpreter *sv_interp; if (restartop) { op = restartop; restartop = 0; - run(); + runops(); } else if (main_start) { op = main_start; - run(); + runops(); } my_exit(0); @@ -569,7 +583,7 @@ U32 status; POPBLOCK(cx,curpm); LEAVE; } - longjmp(top_env, 2); + Siglongjmp(top_env, 2); } SV* @@ -679,7 +693,7 @@ I32 flags; /* See G_* flags in cop.h */ SV** sp = stack_sp; I32 oldmark = TOPMARK; I32 retval; - jmp_buf oldtop; + Sigjmp_buf oldtop; I32 oldscope; if (flags & G_DISCARD) { @@ -702,7 +716,7 @@ I32 flags; /* See G_* flags in cop.h */ myop.op_flags |= OPf_LIST; if (flags & G_EVAL) { - Copy(top_env, oldtop, 1, jmp_buf); + Copy(top_env, oldtop, 1, Sigjmp_buf); cLOGOP->op_other = op; markstack_ptr--; @@ -728,7 +742,7 @@ I32 flags; /* See G_* flags in cop.h */ markstack_ptr++; restart: - switch (setjmp(top_env)) { + switch (Sigsetjmp(top_env,1)) { case 0: break; case 1: @@ -742,7 +756,7 @@ I32 flags; /* See G_* flags in cop.h */ /* my_exit() was called */ curstash = defstash; FREETMPS; - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); if (statusvalue) croak("Callback called exit"); my_exit(statusvalue); @@ -767,7 +781,7 @@ I32 flags; /* See G_* flags in cop.h */ if (op == (OP*)&myop) op = pp_entersub(); if (op) - run(); + runops(); retval = stack_sp - (stack_base + oldmark); if ((flags & G_EVAL) && !(flags & G_KEEPERR)) sv_setpv(GvSV(errgv),""); @@ -787,7 +801,7 @@ I32 flags; /* See G_* flags in cop.h */ curpm = newpm; LEAVE; } - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); } if (flags & G_DISCARD) { stack_sp = stack_base + oldmark; @@ -809,7 +823,7 @@ I32 flags; /* See G_* flags in cop.h */ SV** sp = stack_sp; I32 oldmark = sp - stack_base; I32 retval; - jmp_buf oldtop; + Sigjmp_buf oldtop; I32 oldscope; if (flags & G_DISCARD) { @@ -831,10 +845,10 @@ I32 flags; /* See G_* flags in cop.h */ if (flags & G_ARRAY) myop.op_flags |= OPf_LIST; - Copy(top_env, oldtop, 1, jmp_buf); + Copy(top_env, oldtop, 1, Sigjmp_buf); restart: - switch (setjmp(top_env)) { + switch (Sigsetjmp(top_env,1)) { case 0: break; case 1: @@ -848,7 +862,7 @@ restart: /* my_exit() was called */ curstash = defstash; FREETMPS; - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); if (statusvalue) croak("Callback called exit"); my_exit(statusvalue); @@ -872,13 +886,13 @@ restart: if (op == (OP*)&myop) op = pp_entereval(); if (op) - run(); + runops(); retval = stack_sp - (stack_base + oldmark); if ((flags & G_EVAL) && !(flags & G_KEEPERR)) sv_setpv(GvSV(errgv),""); cleanup: - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); if (flags & G_DISCARD) { stack_sp = stack_base + oldmark; retval = 0; @@ -950,22 +964,24 @@ char *p; } } -void +static void usage(name) /* XXX move this out into a module ? */ char *name; { - printf("\nUsage: %s [switches] [filename] [arguments]\n",name); + /* This message really ought to be max 23 lines. + * Removed -h because the user already knows that opton. Others? */ + printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name); printf("\n -0[octal] specify record separator (\\0, if no argument)"); - printf("\n -a autosplit mode with -n or -p"); + printf("\n -a autosplit mode with -n or -p (splits $_ into @F)"); printf("\n -c check syntax only (runs BEGIN and END blocks)"); printf("\n -d[:debugger] run scripts under debugger"); printf("\n -D[number/list] set debugging flags (argument is a bit mask or flags)"); - printf("\n -e command one line of script, multiple -e options are allowed"); - printf("\n [filename] can be ommitted when -e is used"); - printf("\n -F regexp regular expression for autosplit (-a)"); + printf("\n -e 'command' one line of script. Several -e's allowed. Omit [programfile]."); + printf("\n -F/pattern/ split() pattern for autosplit (-a). The //'s are optional."); printf("\n -i[extension] edit <> files in place (make backup if extension supplied)"); - printf("\n -Idirectory specify include directory (may be used more then once)"); + printf("\n -Idirectory specify @INC/#include directory (may be used more then once)"); printf("\n -l[octal] enable line ending processing, specifies line teminator"); + printf("\n -[mM][-]module.. executes `use/no module...' before executing your script."); printf("\n -n assume 'while (<>) { ... }' loop arround your script"); printf("\n -p assume loop like -n but print line also like sed"); printf("\n -P run script through C preprocessor before compilation"); @@ -979,7 +995,7 @@ char *name; printf("\n -U allow unsafe operations"); printf("\n -v print version number and patchlevel of perl"); printf("\n -V[:variable] print perl configuration information"); - printf("\n -w turn warnings on for compilation of your script"); + printf("\n -w TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT."); printf("\n -x[directory] strip off text before #!perl line and perhaps cd to directory\n"); } @@ -1101,8 +1117,12 @@ char *s; case 'm': taint_not("-m"); /* XXX ? */ if (*++s) { - char *start = s; - Sv = newSVpv("use ",4); + char *start; + char *use = "use "; + /* -M-foo == 'no foo' */ + if (*s == '-') { use = "no "; ++s; } + Sv = newSVpv(use,0); + start = s; /* We allow -M'Module qw(Foo Bar)' */ while(isALNUM(*s) || *s==':') ++s; if (*s != '=') { @@ -1114,9 +1134,9 @@ char *s; } } else { sv_catpvn(Sv, start, s-start); - sv_catpv(Sv, " qw("); + sv_catpv(Sv, " split(/,/,q{"); sv_catpv(Sv, ++s); - sv_catpv(Sv, ")"); + sv_catpv(Sv, "})"); } s += strlen(s); if (preambleav == NULL) @@ -1152,7 +1172,11 @@ char *s; s++; return s; case 'v': - printf("\nThis is perl, version %s beta3",patchlevel); +#if defined(SUBVERSION) && SUBVERSION > 0 + printf("\nThis is perl, version 5.%03d_%02d", PATCHLEVEL, SUBVERSION); +#else + printf("\nThis is perl, version %s",patchlevel); +#endif #if defined(DEBUGGING) || defined(EMBED) || defined(MULTIPLICITY) fputs(" with", stdout); @@ -1167,6 +1191,24 @@ char *s; #endif #endif +#if defined(LOCAL_PATCH_COUNT) + if (LOCAL_PATCH_COUNT > 0) + { int i; + fputs("\n\tLocally applied patches:\n", stdout); + for (i = 1; i <= LOCAL_PATCH_COUNT; i++) { + if (Ilocalpatches[i]) + fprintf(stdout, "\t %s\n", Ilocalpatches[i]); + } + } +#endif + printf("\n\tbuilt under %s",OSNAME); +#ifdef __DATE__ +# ifdef __TIME__ + printf(" at %s %s",__DATE__,__TIME__); +# else + printf(" on %s",__DATE__); +# endif +#endif fputs("\n\nCopyright 1987-1996, Larry Wall\n",stdout); #ifdef MSDOS fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n", @@ -1229,8 +1271,13 @@ my_unexec() fprintf(stderr, "unexec of %s into %s failed!\n", tokenbuf, buf); exit(status); #else +# ifdef VMS +# include + lib$signal(SS$_DEBUG); /* ssdef.h #included from vmsish.h */ +#else ABORT(); /* for use with undump */ #endif +#endif } static void @@ -1245,10 +1292,10 @@ init_main_stash() SvREADONLY_on(gv); HvNAME(defstash) = savepv("main"); incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV))); - SvMULTI_on(incgv); + GvMULTI_on(incgv); defgv = gv_fetchpv("_",TRUE, SVt_PVAV); errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV)); - SvMULTI_on(errgv); + GvMULTI_on(errgv); curstash = defstash; compiling.cop_stash = defstash; debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV)); @@ -1271,6 +1318,18 @@ SV *sv; char *xfailed = Nullch; register char *s; I32 len; + int retval; +#if defined(DOSISH) && !defined(OS2) && !defined(atarist) +#define SEARCH_EXTS ".bat", ".cmd", NULL +#endif +#ifdef VMS +# define SEARCH_EXTS ".pl", ".com", NULL +#endif + /* additional extensions to try in each dir if scriptname not found */ +#ifdef SEARCH_EXTS + char *ext[] = { SEARCH_EXTS }; + int extidx = (strchr(scriptname,'.')) ? -1 : 0; /* has ext already */ +#endif #ifdef VMS if (dosearch && !strpbrk(scriptname,":[ 0) /* reset after previous loop */ + extidx = 0; + do { +#endif + DEBUG_p(fprintf(stderr,"Looking for %s\n",tokenbuf)); + retval = Stat(tokenbuf,&statbuf); +#ifdef SEARCH_EXTS + } while ( retval < 0 /* not there */ + && extidx>=0 && ext[extidx] /* try an extension? */ + && strcpy(tokenbuf+len, ext[extidx++]) + ); +#endif + if (retval < 0) continue; if (S_ISREG(statbuf.st_mode) && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) { @@ -1326,7 +1399,7 @@ SV *sv; scriptname = xfound; } - origfilename = savepv(e_fp ? "-e" : scriptname); + origfilename = savepv(e_tmpname ? "-e" : scriptname); curcop->cop_filegv = gv_fetchfile(origfilename); if (strEQ(origfilename,"-")) scriptname = ""; @@ -1722,9 +1795,9 @@ init_stacks() retstack_ix = 0; retstack_max = 16; - New(50,cxstack,128,CONTEXT); + cxstack_max = 8192 / sizeof(CONTEXT) - 2; /* Use most of 8K. */ + New(50,cxstack,cxstack_max + 1,CONTEXT); cxstack_ix = -1; - cxstack_max = 128; New(50,tmps_stack,128,SV*); tmps_ix = -1; @@ -1756,28 +1829,30 @@ init_predump_symbols() sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1); stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO); - SvMULTI_on(stdingv); + GvMULTI_on(stdingv); IoIFP(GvIOp(stdingv)) = stdin; tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV); + GvMULTI_on(tmpgv); GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(stdingv)); - SvMULTI_on(tmpgv); tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO); - SvMULTI_on(tmpgv); + GvMULTI_on(tmpgv); IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = stdout; setdefout(tmpgv); tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV); + GvMULTI_on(tmpgv); GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(defoutgv)); - SvMULTI_on(tmpgv); othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO); - SvMULTI_on(othergv); + GvMULTI_on(othergv); IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = stderr; tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV); + GvMULTI_on(tmpgv); GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv)); - SvMULTI_on(tmpgv); statname = NEWSV(66,0); /* last filename we did stat on */ + + osname = savepv(OSNAME); } static void @@ -1825,7 +1900,7 @@ register char **env; if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)) sv_setpv(GvSV(tmpgv),origargv[0]); if (argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) { - SvMULTI_on(argvgv); + GvMULTI_on(argvgv); (void)gv_AVadd(argvgv); av_clear(GvAVn(argvgv)); for (; argc > 0; argc--,argv++) { @@ -1834,7 +1909,7 @@ register char **env; } if (envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) { HV *hv; - SvMULTI_on(envgv); + GvMULTI_on(envgv); hv = GvHVn(envgv); hv_clear(hv); #ifndef VMS /* VMS doesn't have environ array */ @@ -1912,25 +1987,25 @@ void calllist(list) AV* list; { - jmp_buf oldtop; + Sigjmp_buf oldtop; STRLEN len; line_t oldline = curcop->cop_line; - Copy(top_env, oldtop, 1, jmp_buf); + Copy(top_env, oldtop, 1, Sigjmp_buf); while (AvFILL(list) >= 0) { CV *cv = (CV*)av_shift(list); SAVEFREESV(cv); - switch (setjmp(top_env)) { + switch (Sigsetjmp(top_env,1)) { case 0: { SV* atsv = GvSV(errgv); PUSHMARK(stack_sp); perl_call_sv((SV*)cv, G_EVAL|G_DISCARD); (void)SvPV(atsv, len); if (len) { - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); curcop = &compiling; curcop->cop_line = oldline; if (list == beginav) @@ -1954,7 +2029,7 @@ AV* list; if (endav) calllist(endav); FREETMPS; - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); curcop = &compiling; curcop->cop_line = oldline; if (statusvalue) { @@ -1972,13 +2047,13 @@ AV* list; FREETMPS; break; } - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); curcop = &compiling; curcop->cop_line = oldline; - longjmp(top_env, 3); + Siglongjmp(top_env, 3); } } - Copy(oldtop, top_env, 1, jmp_buf); + Copy(oldtop, top_env, 1, Sigjmp_buf); }