-char rcsid[] = "$Header: perly.c,v 3.0.1.1 89/11/11 04:50:04 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.5 90/03/27 16:20:57 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perly.c,v $
+ * Revision 3.0.1.5 90/03/27 16:20:57 lwall
+ * patch16: MSDOS support
+ * patch16: do FILE inside eval blows up
+ *
+ * Revision 3.0.1.4 90/02/28 18:06:41 lwall
+ * patch9: perl can now start up other interpreters scripts
+ * patch9: nested evals clobbered their longjmp environment
+ * patch9: eval could mistakenly return undef in array context
+ *
+ * Revision 3.0.1.3 89/12/21 20:15:41 lwall
+ * patch7: ANSI strerror() is now supported
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: allowed setuid scripts to have a space after #!
+ *
+ * Revision 3.0.1.2 89/11/17 15:34:42 lwall
+ * patch5: fixed possible confusion about current effective gid
+ *
* Revision 3.0.1.1 89/11/11 04:50:04 lwall
* patch2: moved yydebug to where its type didn't matter
*
register char *s;
char *index(), *strcpy(), *getenv();
bool dosearch = FALSE;
- char **origargv = argv;
#ifdef DOSUID
char *validarg = "";
#endif
#endif
#endif
+ origargv = argv;
+ origargc = argc;
uid = (int)getuid();
euid = (int)geteuid();
gid = (int)getgid();
egid = (int)getegid();
+#ifdef MSDOS
+ /*
+ * There is no way we can refer to them from Perl so close them to save
+ * space. The other alternative would be to provide STDAUX and STDPRN
+ * filehandles.
+ */
+ (void)fclose(stdaux);
+ (void)fclose(stdprn);
+#endif
if (do_undump) {
do_undump = 0;
- loop_ptr = 0; /* start label stack again */
+ loop_ptr = -1; /* start label stack again */
goto just_doit;
}
(void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
goto reswitch;
case 'v':
fputs(rcsid,stdout);
- fputs("\nCopyright (c) 1989, Larry Wall\n\n\
+ fputs("\nCopyright (c) 1989, 1990, Larry Wall\n",stdout);
+#ifdef MSDOS
+ fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
+ stdout);
+#endif
+ fputs("\n\
Perl may be copied only under the terms of the GNU General Public License,\n\
a copy of which can be found with the Perl 3.0 distribution kit.\n",stdout);
exit(0);
else
rsfp = fopen(argv[0],"r");
if (rsfp == Nullfp) {
- extern char *sys_errlist[];
- extern int errno;
-
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
if (euid && stat(filename,&statbuf) >= 0 &&
#endif
#endif
fatal("Can't open perl script \"%s\": %s\n",
- filename, sys_errlist[errno]);
+ filename, strerror(errno));
}
str_free(str); /* free -I directories */
if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */
fatal("No #! line");
- for (s = tokenbuf+2; !isspace(*s); s++) ;
+ s = tokenbuf+2;
+ if (*s == ' ') s++;
+ while (!isspace(*s)) s++;
if (strnNE(s-4,"perl",4)) /* sanity check */
fatal("Not a perl script");
while (*s == ' ' || *s == '\t') s++;
fatal("Can't do setuid\n");
}
- if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid())
+ if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid)
#ifdef SETEGID
(void)setegid(statbuf.st_gid);
#else
setuid((UIDTYPE)uid);
#endif
#endif
+ uid = (int)getuid();
euid = (int)geteuid();
+ gid = (int)getgid();
+ egid = (int)getegid();
if (!cando(S_IEXEC,TRUE,&statbuf))
fatal("Permission denied\n"); /* they can't do this */
}
str_numset(STAB_STR(tmpstab),(double)getpid());
if (setjmp(top_env)) /* sets goto_targ on longjump */
- loop_ptr = 0; /* start label stack again */
+ loop_ptr = -1; /* start label stack again */
#ifdef DEBUGGING
if (debug & 1024)
CMD *myroot;
ARRAY *ar;
int i;
- char *oldfile = filename;
- line_t oldline = line;
- int oldtmps_base = tmps_base;
- int oldsave = savestack->ary_fill;
- SPAT *oldspat = curspat;
+ char * VOLATILE oldfile = filename;
+ VOLATILE line_t oldline = line;
+ VOLATILE int oldtmps_base = tmps_base;
+ VOLATILE int oldsave = savestack->ary_fill;
+ SPAT * VOLATILE oldspat = curspat;
static char *last_eval = Nullch;
static CMD *last_root = Nullcmd;
- int sp = arglast[0];
+ VOLATILE int sp = arglast[0];
+ char *tmps;
tmps_base = tmps_max;
if (curstash != stash) {
str_cat(linestr,";"); /* be kind to them */
}
else {
- if (last_root) {
+ if (last_root && !in_eval) {
Safefree(last_eval);
cmd_free(last_root);
last_root = Nullcmd;
in_eval++;
oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
bufend = bufptr + linestr->str_cur;
- if (setjmp(eval_env)) {
+ if (++loop_ptr >= loop_max) {
+ loop_max += 128;
+ Renew(loop_stack, loop_max, struct loop);
+ }
+ loop_stack[loop_ptr].loop_label = "_EVAL_";
+ loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+ if (debug & 4) {
+ deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+ }
+#endif
+ if (setjmp(loop_stack[loop_ptr].loop_env)) {
retval = 1;
last_root = Nullcmd;
}
}
myroot = eval_root; /* in case cmd_exec does another eval! */
if (retval || error_count) {
- str = &str_undef;
+ st = stack->ary_array;
+ sp = arglast[0];
+ if (gimme != G_ARRAY)
+ st[++sp] = &str_undef;
last_root = Nullcmd; /* can't free on error, for some reason */
if (rsfp) {
fclose(rsfp);
cmd_free(myroot);
}
in_eval--;
+#ifdef DEBUGGING
+ if (debug & 4) {
+ tmps = loop_stack[loop_ptr].loop_label;
+ deb("(Popping label #%d %s)\n",loop_ptr,
+ tmps ? tmps : "" );
+ }
+#endif
+ loop_ptr--;
filename = oldfile;
line = oldline;
tmps_base = oldtmps_base;
projects / p5sagit/p5-mst-13.2.git / blobdiff