perl 4.0 patch 21: patch #20, continued
[perl.git] / perl.c
1 char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45 $\nPatch level: ###\n";
2 /*
3  *    Copyright (c) 1991, Larry Wall
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  * $Log:        perl.c,v $
9  * Revision 4.0.1.6  91/11/11  16:38:45  lwall
10  * patch19: default arg for shift was wrong after first subroutine definition
11  * patch19: op/regexp.t failed from missing arg to bcmp()
12  * 
13  * Revision 4.0.1.5  91/11/05  18:03:32  lwall
14  * patch11: random cleanup
15  * patch11: $0 was being truncated at times
16  * patch11: cppstdin now installed outside of source directory
17  * patch11: -P didn't allow use of #elif or #undef
18  * patch11: prepared for ctype implementations that don't define isascii()
19  * patch11: added eval {}
20  * patch11: eval confused by string containing null
21  * 
22  * Revision 4.0.1.4  91/06/10  01:23:07  lwall
23  * patch10: perl -v printed incorrect copyright notice
24  * 
25  * Revision 4.0.1.3  91/06/07  11:40:18  lwall
26  * patch4: changed old $^P to $^X
27  * 
28  * Revision 4.0.1.2  91/06/07  11:26:16  lwall
29  * patch4: new copyright notice
30  * patch4: added $^P variable to control calling of perldb routines
31  * patch4: added $^F variable to specify maximum system fd, default 2
32  * patch4: debugger lost track of lines in eval
33  * 
34  * Revision 4.0.1.1  91/04/11  17:49:05  lwall
35  * patch1: fixed undefined environ problem
36  * 
37  * Revision 4.0  91/03/20  01:37:44  lwall
38  * 4.0 baseline.
39  * 
40  */
41
42 /*SUPPRESS 560*/
43
44 #include "EXTERN.h"
45 #include "perl.h"
46 #include "perly.h"
47 #ifdef MSDOS
48 #include "patchlev.h"
49 #else
50 #include "patchlevel.h"
51 #endif
52
53 char *getenv();
54
55 #ifdef IAMSUID
56 #ifndef DOSUID
57 #define DOSUID
58 #endif
59 #endif
60
61 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
62 #ifdef DOSUID
63 #undef DOSUID
64 #endif
65 #endif
66
67 static char* moreswitches();
68 static char* cddir;
69 static bool minus_c;
70 static char patchlevel[6];
71 static char *nrs = "\n";
72 static int nrschar = '\n';      /* final char of rs, or 0777 if none */
73 static int nrslen = 1;
74
75 main(argc,argv,env)
76 register int argc;
77 register char **argv;
78 register char **env;
79 {
80     register STR *str;
81     register char *s;
82     char *scriptname;
83     char *getenv();
84     bool dosearch = FALSE;
85 #ifdef DOSUID
86     char *validarg = "";
87 #endif
88
89 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
90 #ifdef IAMSUID
91 #undef IAMSUID
92     fatal("suidperl is no longer needed since the kernel can now execute\n\
93 setuid perl scripts securely.\n");
94 #endif
95 #endif
96
97     origargv = argv;
98     origargc = argc;
99     origenviron = environ;
100     uid = (int)getuid();
101     euid = (int)geteuid();
102     gid = (int)getgid();
103     egid = (int)getegid();
104     sprintf(patchlevel,"%3.3s%2.2d", index(rcsid,'4'), PATCHLEVEL);
105 #ifdef MSDOS
106     /*
107      * There is no way we can refer to them from Perl so close them to save
108      * space.  The other alternative would be to provide STDAUX and STDPRN
109      * filehandles.
110      */
111     (void)fclose(stdaux);
112     (void)fclose(stdprn);
113 #endif
114     if (do_undump) {
115         origfilename = savestr(argv[0]);
116         do_undump = 0;
117         loop_ptr = -1;          /* start label stack again */
118         goto just_doit;
119     }
120     (void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
121     linestr = Str_new(65,80);
122     str_nset(linestr,"",0);
123     str = str_make("",0);               /* first used for -I flags */
124     curstash = defstash = hnew(0);
125     curstname = str_make("main",4);
126     stab_xhash(stabent("_main",TRUE)) = defstash;
127     defstash->tbl_name = "main";
128     incstab = hadd(aadd(stabent("INC",TRUE)));
129     incstab->str_pok |= SP_MULTI;
130     for (argc--,argv++; argc > 0; argc--,argv++) {
131         if (argv[0][0] != '-' || !argv[0][1])
132             break;
133 #ifdef DOSUID
134     if (*validarg)
135         validarg = " PHOOEY ";
136     else
137         validarg = argv[0];
138 #endif
139         s = argv[0]+1;
140       reswitch:
141         switch (*s) {
142         case '0':
143         case 'a':
144         case 'c':
145         case 'd':
146         case 'D':
147         case 'i':
148         case 'l':
149         case 'n':
150         case 'p':
151         case 'u':
152         case 'U':
153         case 'v':
154         case 'w':
155             if (s = moreswitches(s))
156                 goto reswitch;
157             break;
158
159         case 'e':
160 #ifdef TAINT
161             if (euid != uid || egid != gid)
162                 fatal("No -e allowed in setuid scripts");
163 #endif
164             if (!e_fp) {
165                 e_tmpname = savestr(TMPPATH);
166                 (void)mktemp(e_tmpname);
167                 e_fp = fopen(e_tmpname,"w");
168                 if (!e_fp)
169                     fatal("Cannot open temporary file");
170             }
171             if (argv[1]) {
172                 fputs(argv[1],e_fp);
173                 argc--,argv++;
174             }
175             (void)putc('\n', e_fp);
176             break;
177         case 'I':
178 #ifdef TAINT
179             if (euid != uid || egid != gid)
180                 fatal("No -I allowed in setuid scripts");
181 #endif
182             str_cat(str,"-");
183             str_cat(str,s);
184             str_cat(str," ");
185             if (*++s) {
186                 (void)apush(stab_array(incstab),str_make(s,0));
187             }
188             else if (argv[1]) {
189                 (void)apush(stab_array(incstab),str_make(argv[1],0));
190                 str_cat(str,argv[1]);
191                 argc--,argv++;
192                 str_cat(str," ");
193             }
194             break;
195         case 'P':
196 #ifdef TAINT
197             if (euid != uid || egid != gid)
198                 fatal("No -P allowed in setuid scripts");
199 #endif
200             preprocess = TRUE;
201             s++;
202             goto reswitch;
203         case 's':
204 #ifdef TAINT
205             if (euid != uid || egid != gid)
206                 fatal("No -s allowed in setuid scripts");
207 #endif
208             doswitches = TRUE;
209             s++;
210             goto reswitch;
211         case 'S':
212 #ifdef TAINT
213             if (euid != uid || egid != gid)
214                 fatal("No -S allowed in setuid scripts");
215 #endif
216             dosearch = TRUE;
217             s++;
218             goto reswitch;
219         case 'x':
220             doextract = TRUE;
221             s++;
222             if (*s)
223                 cddir = savestr(s);
224             break;
225         case '-':
226             argc--,argv++;
227             goto switch_end;
228         case 0:
229             break;
230         default:
231             fatal("Unrecognized switch: -%s",s);
232         }
233     }
234   switch_end:
235     scriptname = argv[0];
236     if (e_fp) {
237         (void)fclose(e_fp);
238         argc++,argv--;
239         scriptname = e_tmpname;
240     }
241
242 #ifdef MSDOS
243 #define PERLLIB_SEP ';'
244 #else
245 #define PERLLIB_SEP ':'
246 #endif
247 #ifndef TAINT           /* Can't allow arbitrary PERLLIB in setuid script */
248     {
249         char * s2 = getenv("PERLLIB");
250
251         if ( s2 ) {
252             /* Break at all separators */
253             while ( *s2 ) {
254                 /* First, skip any consecutive separators */
255                 while ( *s2 == PERLLIB_SEP ) {
256                     /* Uncomment the next line for PATH semantics */
257                     /* (void)apush(stab_array(incstab),str_make(".",1)); */
258                     s2++;
259                 }
260                 if ( (s = index(s2,PERLLIB_SEP)) != Nullch ) {
261                     (void)apush(stab_array(incstab),str_make(s2,(int)(s-s2)));
262                     s2 = s+1;
263                 } else {
264                     (void)apush(stab_array(incstab),str_make(s2,0));
265                     break;
266                 }
267             }
268         }
269     }
270 #endif /* TAINT */
271
272 #ifndef PRIVLIB
273 #define PRIVLIB "/usr/local/lib/perl"
274 #endif
275     (void)apush(stab_array(incstab),str_make(PRIVLIB,0));
276     (void)apush(stab_array(incstab),str_make(".",1));
277
278     str_set(&str_no,No);
279     str_set(&str_yes,Yes);
280
281     /* open script */
282
283     if (scriptname == Nullch)
284 #ifdef MSDOS
285     {
286         if ( isatty(fileno(stdin)) )
287           moreswitches("v");
288         scriptname = "-";
289     }
290 #else
291         scriptname = "-";
292 #endif
293     if (dosearch && !index(scriptname, '/') && (s = getenv("PATH"))) {
294         char *xfound = Nullch, *xfailed = Nullch;
295         int len;
296
297         bufend = s + strlen(s);
298         while (*s) {
299 #ifndef MSDOS
300             s = cpytill(tokenbuf,s,bufend,':',&len);
301 #else
302             for (len = 0; *s && *s != ';'; tokenbuf[len++] = *s++);
303             tokenbuf[len] = '\0';
304 #endif
305             if (*s)
306                 s++;
307 #ifndef MSDOS
308             if (len && tokenbuf[len-1] != '/')
309 #else
310             if (len && tokenbuf[len-1] != '\\')
311 #endif
312                 (void)strcat(tokenbuf+len,"/");
313             (void)strcat(tokenbuf+len,scriptname);
314 #ifdef DEBUGGING
315             if (debug & 1)
316                 fprintf(stderr,"Looking for %s\n",tokenbuf);
317 #endif
318             if (stat(tokenbuf,&statbuf) < 0)            /* not there? */
319                 continue;
320             if (S_ISREG(statbuf.st_mode)
321              && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) {
322                 xfound = tokenbuf;              /* bingo! */
323                 break;
324             }
325             if (!xfailed)
326                 xfailed = savestr(tokenbuf);
327         }
328         if (!xfound)
329             fatal("Can't execute %s", xfailed ? xfailed : scriptname );
330         if (xfailed)
331             Safefree(xfailed);
332         scriptname = savestr(xfound);
333     }
334
335     fdpid = anew(Nullstab);     /* for remembering popen pids by fd */
336     pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
337
338     origfilename = savestr(scriptname);
339     curcmd->c_filestab = fstab(origfilename);
340     if (strEQ(origfilename,"-"))
341         scriptname = "";
342     if (preprocess) {
343         char *cpp = CPPSTDIN;
344
345         if (strEQ(cpp,"cppstdin"))
346             sprintf(tokenbuf, "%s/%s", SCRIPTDIR, cpp);
347         else
348             sprintf(tokenbuf, "%s", cpp);
349         str_cat(str,"-I");
350         str_cat(str,PRIVLIB);
351         (void)sprintf(buf, "\
352 %ssed %s -e '/^[^#]/b' \
353  -e '/^#[       ]*include[      ]/b' \
354  -e '/^#[       ]*define[       ]/b' \
355  -e '/^#[       ]*if[   ]/b' \
356  -e '/^#[       ]*ifdef[        ]/b' \
357  -e '/^#[       ]*ifndef[       ]/b' \
358  -e '/^#[       ]*else/b' \
359  -e '/^#[       ]*elif[         ]/b' \
360  -e '/^#[       ]*undef[        ]/b' \
361  -e '/^#[       ]*endif/b' \
362  -e 's/^[       ]*#.*//' \
363  %s | %s -C %s %s",
364 #ifdef MSDOS
365           "",
366 #else
367           "/bin/",
368 #endif
369           (doextract ? "-e '1,/^#/d\n'" : ""),
370           scriptname, tokenbuf, str_get(str), CPPMINUS);
371 #ifdef DEBUGGING
372         if (debug & 64) {
373             fputs(buf,stderr);
374             fputs("\n",stderr);
375         }
376 #endif
377         doextract = FALSE;
378 #ifdef IAMSUID                          /* actually, this is caught earlier */
379         if (euid != uid && !euid)       /* if running suidperl */
380 #ifdef HAS_SETEUID
381             (void)seteuid(uid);         /* musn't stay setuid root */
382 #else
383 #ifdef HAS_SETREUID
384             (void)setreuid(-1, uid);
385 #else
386             setuid(uid);
387 #endif
388 #endif
389 #endif /* IAMSUID */
390         rsfp = mypopen(buf,"r");
391     }
392     else if (!*scriptname) {
393 #ifdef TAINT
394         if (euid != uid || egid != gid)
395             fatal("Can't take set-id script from stdin");
396 #endif
397         rsfp = stdin;
398     }
399     else
400         rsfp = fopen(scriptname,"r");
401     if ((FILE*)rsfp == Nullfp) {
402 #ifdef DOSUID
403 #ifndef IAMSUID         /* in case script is not readable before setuid */
404         if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
405           statbuf.st_mode & (S_ISUID|S_ISGID)) {
406             (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
407             execv(buf, origargv);       /* try again */
408             fatal("Can't do setuid\n");
409         }
410 #endif
411 #endif
412         fatal("Can't open perl script \"%s\": %s\n",
413           stab_val(curcmd->c_filestab)->str_ptr, strerror(errno));
414     }
415     str_free(str);              /* free -I directories */
416     str = Nullstr;
417
418     /* do we need to emulate setuid on scripts? */
419
420     /* This code is for those BSD systems that have setuid #! scripts disabled
421      * in the kernel because of a security problem.  Merely defining DOSUID
422      * in perl will not fix that problem, but if you have disabled setuid
423      * scripts in the kernel, this will attempt to emulate setuid and setgid
424      * on scripts that have those now-otherwise-useless bits set.  The setuid
425      * root version must be called suidperl or sperlN.NNN.  If regular perl
426      * discovers that it has opened a setuid script, it calls suidperl with
427      * the same argv that it had.  If suidperl finds that the script it has
428      * just opened is NOT setuid root, it sets the effective uid back to the
429      * uid.  We don't just make perl setuid root because that loses the
430      * effective uid we had before invoking perl, if it was different from the
431      * uid.
432      *
433      * DOSUID must be defined in both perl and suidperl, and IAMSUID must
434      * be defined in suidperl only.  suidperl must be setuid root.  The
435      * Configure script will set this up for you if you want it.
436      *
437      * There is also the possibility of have a script which is running
438      * set-id due to a C wrapper.  We want to do the TAINT checks
439      * on these set-id scripts, but don't want to have the overhead of
440      * them in normal perl, and can't use suidperl because it will lose
441      * the effective uid info, so we have an additional non-setuid root
442      * version called taintperl or tperlN.NNN that just does the TAINT checks.
443      */
444
445 #ifdef DOSUID
446     if (fstat(fileno(rsfp),&statbuf) < 0)       /* normal stat is insecure */
447         fatal("Can't stat script \"%s\"",origfilename);
448     if (statbuf.st_mode & (S_ISUID|S_ISGID)) {
449         int len;
450
451 #ifdef IAMSUID
452 #ifndef HAS_SETREUID
453         /* On this access check to make sure the directories are readable,
454          * there is actually a small window that the user could use to make
455          * filename point to an accessible directory.  So there is a faint
456          * chance that someone could execute a setuid script down in a
457          * non-accessible directory.  I don't know what to do about that.
458          * But I don't think it's too important.  The manual lies when
459          * it says access() is useful in setuid programs.
460          */
461         if (access(stab_val(curcmd->c_filestab)->str_ptr,1))    /*double check*/
462             fatal("Permission denied");
463 #else
464         /* If we can swap euid and uid, then we can determine access rights
465          * with a simple stat of the file, and then compare device and
466          * inode to make sure we did stat() on the same file we opened.
467          * Then we just have to make sure he or she can execute it.
468          */
469         {
470             struct stat tmpstatbuf;
471
472             if (setreuid(euid,uid) < 0 || getuid() != euid || geteuid() != uid)
473                 fatal("Can't swap uid and euid");       /* really paranoid */
474             if (stat(stab_val(curcmd->c_filestab)->str_ptr,&tmpstatbuf) < 0)
475                 fatal("Permission denied");     /* testing full pathname here */
476             if (tmpstatbuf.st_dev != statbuf.st_dev ||
477                 tmpstatbuf.st_ino != statbuf.st_ino) {
478                 (void)fclose(rsfp);
479                 if (rsfp = mypopen("/bin/mail root","w")) {     /* heh, heh */
480                     fprintf(rsfp,
481 "User %d tried to run dev %d ino %d in place of dev %d ino %d!\n\
482 (Filename of set-id script was %s, uid %d gid %d.)\n\nSincerely,\nperl\n",
483                         uid,tmpstatbuf.st_dev, tmpstatbuf.st_ino,
484                         statbuf.st_dev, statbuf.st_ino,
485                         stab_val(curcmd->c_filestab)->str_ptr,
486                         statbuf.st_uid, statbuf.st_gid);
487                     (void)mypclose(rsfp);
488                 }
489                 fatal("Permission denied\n");
490             }
491             if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid)
492                 fatal("Can't reswap uid and euid");
493             if (!cando(S_IXUSR,FALSE,&statbuf))         /* can real uid exec? */
494                 fatal("Permission denied\n");
495         }
496 #endif /* HAS_SETREUID */
497 #endif /* IAMSUID */
498
499         if (!S_ISREG(statbuf.st_mode))
500             fatal("Permission denied");
501         if (statbuf.st_mode & S_IWOTH)
502             fatal("Setuid/gid script is writable by world");
503         doswitches = FALSE;             /* -s is insecure in suid */
504         curcmd->c_line++;
505         if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
506           strnNE(tokenbuf,"#!",2) )     /* required even on Sys V */
507             fatal("No #! line");
508         s = tokenbuf+2;
509         if (*s == ' ') s++;
510         while (!isSPACE(*s)) s++;
511         if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
512             fatal("Not a perl script");
513         while (*s == ' ' || *s == '\t') s++;
514         /*
515          * #! arg must be what we saw above.  They can invoke it by
516          * mentioning suidperl explicitly, but they may not add any strange
517          * arguments beyond what #! says if they do invoke suidperl that way.
518          */
519         len = strlen(validarg);
520         if (strEQ(validarg," PHOOEY ") ||
521             strnNE(s,validarg,len) || !isSPACE(s[len]))
522             fatal("Args must match #! line");
523
524 #ifndef IAMSUID
525         if (euid != uid && (statbuf.st_mode & S_ISUID) &&
526             euid == statbuf.st_uid)
527             if (!do_undump)
528                 fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
529 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
530 #endif /* IAMSUID */
531
532         if (euid) {     /* oops, we're not the setuid root perl */
533             (void)fclose(rsfp);
534 #ifndef IAMSUID
535             (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
536             execv(buf, origargv);       /* try again */
537 #endif
538             fatal("Can't do setuid\n");
539         }
540
541         if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid)
542 #ifdef HAS_SETEGID
543             (void)setegid(statbuf.st_gid);
544 #else
545 #ifdef HAS_SETREGID
546             (void)setregid((GIDTYPE)-1,statbuf.st_gid);
547 #else
548             setgid(statbuf.st_gid);
549 #endif
550 #endif
551         if (statbuf.st_mode & S_ISUID) {
552             if (statbuf.st_uid != euid)
553 #ifdef HAS_SETEUID
554                 (void)seteuid(statbuf.st_uid);  /* all that for this */
555 #else
556 #ifdef HAS_SETREUID
557                 (void)setreuid((UIDTYPE)-1,statbuf.st_uid);
558 #else
559                 setuid(statbuf.st_uid);
560 #endif
561 #endif
562         }
563         else if (uid)                   /* oops, mustn't run as root */
564 #ifdef HAS_SETEUID
565             (void)seteuid((UIDTYPE)uid);
566 #else
567 #ifdef HAS_SETREUID
568             (void)setreuid((UIDTYPE)-1,(UIDTYPE)uid);
569 #else
570             setuid((UIDTYPE)uid);
571 #endif
572 #endif
573         uid = (int)getuid();
574         euid = (int)geteuid();
575         gid = (int)getgid();
576         egid = (int)getegid();
577         if (!cando(S_IXUSR,TRUE,&statbuf))
578             fatal("Permission denied\n");       /* they can't do this */
579     }
580 #ifdef IAMSUID
581     else if (preprocess)
582         fatal("-P not allowed for setuid/setgid script\n");
583     else
584         fatal("Script is not setuid/setgid in suidperl\n");
585 #else
586 #ifndef TAINT           /* we aren't taintperl or suidperl */
587     /* script has a wrapper--can't run suidperl or we lose euid */
588     else if (euid != uid || egid != gid) {
589         (void)fclose(rsfp);
590         (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
591         execv(buf, origargv);   /* try again */
592         fatal("Can't run setuid script with taint checks");
593     }
594 #endif /* TAINT */
595 #endif /* IAMSUID */
596 #else /* !DOSUID */
597 #ifndef TAINT           /* we aren't taintperl or suidperl */
598     if (euid != uid || egid != gid) {   /* (suidperl doesn't exist, in fact) */
599 #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
600         fstat(fileno(rsfp),&statbuf);   /* may be either wrapped or real suid */
601         if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
602             ||
603             (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
604            )
605             if (!do_undump)
606                 fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
607 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
608 #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
609         /* not set-id, must be wrapped */
610         (void)fclose(rsfp);
611         (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
612         execv(buf, origargv);   /* try again */
613         fatal("Can't run setuid script with taint checks");
614     }
615 #endif /* TAINT */
616 #endif /* DOSUID */
617
618 #if !defined(IAMSUID) && !defined(TAINT)
619
620     /* skip forward in input to the real script? */
621
622     while (doextract) {
623         if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
624             fatal("No Perl script found in input\n");
625         if (*s == '#' && s[1] == '!' && instr(s,"perl")) {
626             ungetc('\n',rsfp);          /* to keep line count right */
627             doextract = FALSE;
628             if (s = instr(s,"perl -")) {
629                 s += 6;
630                 /*SUPPRESS 530*/
631                 while (s = moreswitches(s)) ;
632             }
633             if (cddir && chdir(cddir) < 0)
634                 fatal("Can't chdir to %s",cddir);
635         }
636     }
637 #endif /* !defined(IAMSUID) && !defined(TAINT) */
638
639     defstab = stabent("_",TRUE);
640
641     subname = str_make("main",4);
642     if (perldb) {
643         debstash = hnew(0);
644         stab_xhash(stabent("_DB",TRUE)) = debstash;
645         curstash = debstash;
646         dbargs = stab_xarray(aadd((tmpstab = stabent("args",TRUE))));
647         tmpstab->str_pok |= SP_MULTI;
648         dbargs->ary_flags = 0;
649         DBstab = stabent("DB",TRUE);
650         DBstab->str_pok |= SP_MULTI;
651         DBline = stabent("dbline",TRUE);
652         DBline->str_pok |= SP_MULTI;
653         DBsub = hadd(tmpstab = stabent("sub",TRUE));
654         tmpstab->str_pok |= SP_MULTI;
655         DBsingle = stab_val((tmpstab = stabent("single",TRUE)));
656         tmpstab->str_pok |= SP_MULTI;
657         DBtrace = stab_val((tmpstab = stabent("trace",TRUE)));
658         tmpstab->str_pok |= SP_MULTI;
659         DBsignal = stab_val((tmpstab = stabent("signal",TRUE)));
660         tmpstab->str_pok |= SP_MULTI;
661         curstash = defstash;
662     }
663
664     /* init tokener */
665
666     bufend = bufptr = str_get(linestr);
667
668     savestack = anew(Nullstab);         /* for saving non-local values */
669     stack = anew(Nullstab);             /* for saving non-local values */
670     stack->ary_flags = 0;               /* not a real array */
671     afill(stack,63); afill(stack,-1);   /* preextend stack */
672     afill(savestack,63); afill(savestack,-1);
673
674     /* now parse the script */
675
676     error_count = 0;
677     if (yyparse() || error_count) {
678         if (minus_c)
679             fatal("%s had compilation errors.\n", origfilename);
680         else {
681             fatal("Execution of %s aborted due to compilation errors.\n",
682                 origfilename);
683         }
684     }
685
686     New(50,loop_stack,128,struct loop);
687 #ifdef DEBUGGING
688     if (debug) {
689         New(51,debname,128,char);
690         New(52,debdelim,128,char);
691     }
692 #endif
693     curstash = defstash;
694
695     preprocess = FALSE;
696     if (e_fp) {
697         e_fp = Nullfp;
698         (void)UNLINK(e_tmpname);
699     }
700
701     /* initialize everything that won't change if we undump */
702
703     if (sigstab = stabent("SIG",allstabs)) {
704         sigstab->str_pok |= SP_MULTI;
705         (void)hadd(sigstab);
706     }
707
708     magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006");
709     userinit();         /* in case linked C routines want magical variables */
710
711     amperstab = stabent("&",allstabs);
712     leftstab = stabent("`",allstabs);
713     rightstab = stabent("'",allstabs);
714     sawampersand = (amperstab || leftstab || rightstab);
715     if (tmpstab = stabent(":",allstabs))
716         str_set(STAB_STR(tmpstab),chopset);
717     if (tmpstab = stabent("\024",allstabs))
718         time(&basetime);
719
720     /* these aren't necessarily magical */
721     if (tmpstab = stabent(";",allstabs))
722         str_set(STAB_STR(tmpstab),"\034");
723     if (tmpstab = stabent("]",allstabs)) {
724         str = STAB_STR(tmpstab);
725         str_set(str,rcsid);
726         str->str_u.str_nval = atof(patchlevel);
727         str->str_nok = 1;
728     }
729     str_nset(stab_val(stabent("\"", TRUE)), " ", 1);
730
731     stdinstab = stabent("STDIN",TRUE);
732     stdinstab->str_pok |= SP_MULTI;
733     stab_io(stdinstab) = stio_new();
734     stab_io(stdinstab)->ifp = stdin;
735     tmpstab = stabent("stdin",TRUE);
736     stab_io(tmpstab) = stab_io(stdinstab);
737     tmpstab->str_pok |= SP_MULTI;
738
739     tmpstab = stabent("STDOUT",TRUE);
740     tmpstab->str_pok |= SP_MULTI;
741     stab_io(tmpstab) = stio_new();
742     stab_io(tmpstab)->ofp = stab_io(tmpstab)->ifp = stdout;
743     defoutstab = tmpstab;
744     tmpstab = stabent("stdout",TRUE);
745     stab_io(tmpstab) = stab_io(defoutstab);
746     tmpstab->str_pok |= SP_MULTI;
747
748     curoutstab = stabent("STDERR",TRUE);
749     curoutstab->str_pok |= SP_MULTI;
750     stab_io(curoutstab) = stio_new();
751     stab_io(curoutstab)->ofp = stab_io(curoutstab)->ifp = stderr;
752     tmpstab = stabent("stderr",TRUE);
753     stab_io(tmpstab) = stab_io(curoutstab);
754     tmpstab->str_pok |= SP_MULTI;
755     curoutstab = defoutstab;            /* switch back to STDOUT */
756
757     statname = Str_new(66,0);           /* last filename we did stat on */
758
759     /* now that script is parsed, we can modify record separator */
760
761     rs = nrs;
762     rslen = nrslen;
763     rschar = nrschar;
764     str_nset(stab_val(stabent("/", TRUE)), rs, rslen);
765
766     if (do_undump)
767         my_unexec();
768
769   just_doit:            /* come here if running an undumped a.out */
770     argc--,argv++;      /* skip name of script */
771     if (doswitches) {
772         for (; argc > 0 && **argv == '-'; argc--,argv++) {
773             if (argv[0][1] == '-') {
774                 argc--,argv++;
775                 break;
776             }
777             if (s = index(argv[0], '=')) {
778                 *s++ = '\0';
779                 str_set(stab_val(stabent(argv[0]+1,TRUE)),s);
780             }
781             else
782                 str_numset(stab_val(stabent(argv[0]+1,TRUE)),(double)1.0);
783         }
784     }
785 #ifdef TAINT
786     tainted = 1;
787 #endif
788     if (tmpstab = stabent("0",allstabs)) {
789         str_set(stab_val(tmpstab),origfilename);
790         magicname("0", Nullch, 0);
791     }
792     if (tmpstab = stabent("\030",allstabs))
793         str_set(stab_val(tmpstab),origargv[0]);
794     if (argvstab = stabent("ARGV",allstabs)) {
795         argvstab->str_pok |= SP_MULTI;
796         (void)aadd(argvstab);
797         aclear(stab_array(argvstab));
798         for (; argc > 0; argc--,argv++) {
799             (void)apush(stab_array(argvstab),str_make(argv[0],0));
800         }
801     }
802 #ifdef TAINT
803     (void) stabent("ENV",TRUE);         /* must test PATH and IFS */
804 #endif
805     if (envstab = stabent("ENV",allstabs)) {
806         envstab->str_pok |= SP_MULTI;
807         (void)hadd(envstab);
808         hclear(stab_hash(envstab), FALSE);
809         if (env != environ)
810             environ[0] = Nullch;
811         for (; *env; env++) {
812             if (!(s = index(*env,'=')))
813                 continue;
814             *s++ = '\0';
815             str = str_make(s--,0);
816             str_magic(str, envstab, 'E', *env, s - *env);
817             (void)hstore(stab_hash(envstab), *env, s - *env, str, 0);
818             *s = '=';
819         }
820     }
821 #ifdef TAINT
822     tainted = 0;
823 #endif
824     if (tmpstab = stabent("$",allstabs))
825         str_numset(STAB_STR(tmpstab),(double)getpid());
826
827     if (dowarn) {
828         stab_check('A','Z');
829         stab_check('a','z');
830     }
831
832     if (setjmp(top_env))        /* sets goto_targ on longjump */
833         loop_ptr = -1;          /* start label stack again */
834
835 #ifdef DEBUGGING
836     if (debug & 1024)
837         dump_all();
838     if (debug)
839         fprintf(stderr,"\nEXECUTING...\n\n");
840 #endif
841
842     if (minus_c) {
843         fprintf(stderr,"%s syntax OK\n", origfilename);
844         exit(0);
845     }
846
847     /* do it */
848
849     (void) cmd_exec(main_root,G_SCALAR,-1);
850
851     if (goto_targ)
852         fatal("Can't find label \"%s\"--aborting",goto_targ);
853     exit(0);
854     /* NOTREACHED */
855 }
856
857 void
858 magicalize(list)
859 register char *list;
860 {
861     char sym[2];
862
863     sym[1] = '\0';
864     while (*sym = *list++)
865         magicname(sym, Nullch, 0);
866 }
867
868 void
869 magicname(sym,name,namlen)
870 char *sym;
871 char *name;
872 int namlen;
873 {
874     register STAB *stab;
875
876     if (stab = stabent(sym,allstabs)) {
877         stab_flags(stab) = SF_VMAGIC;
878         str_magic(stab_val(stab), stab, 0, name, namlen);
879     }
880 }
881
882 void
883 savelines(array, str)
884 ARRAY *array;
885 STR *str;
886 {
887     register char *s = str->str_ptr;
888     register char *send = str->str_ptr + str->str_cur;
889     register char *t;
890     register int line = 1;
891
892     while (s && s < send) {
893         STR *tmpstr = Str_new(85,0);
894
895         t = index(s, '\n');
896         if (t)
897             t++;
898         else
899             t = send;
900
901         str_nset(tmpstr, s, t - s);
902         astore(array, line++, tmpstr);
903         s = t;
904     }
905 }
906
907 /* this routine is in perl.c by virtue of being sort of an alternate main() */
908
909 int
910 do_eval(str,optype,stash,savecmd,gimme,arglast)
911 STR *str;
912 int optype;
913 HASH *stash;
914 int savecmd;
915 int gimme;
916 int *arglast;
917 {
918     STR **st = stack->ary_array;
919     int retval;
920     CMD *myroot = Nullcmd;
921     ARRAY *ar;
922     int i;
923     CMD * VOLATILE oldcurcmd = curcmd;
924     VOLATILE int oldtmps_base = tmps_base;
925     VOLATILE int oldsave = savestack->ary_fill;
926     VOLATILE int oldperldb = perldb;
927     SPAT * VOLATILE oldspat = curspat;
928     SPAT * VOLATILE oldlspat = lastspat;
929     static char *last_eval = Nullch;
930     static long last_elen = 0;
931     static CMD *last_root = Nullcmd;
932     VOLATILE int sp = arglast[0];
933     char *specfilename;
934     char *tmpfilename;
935     int parsing = 1;
936
937     tmps_base = tmps_max;
938     if (curstash != stash) {
939         (void)savehptr(&curstash);
940         curstash = stash;
941     }
942     str_set(stab_val(stabent("@",TRUE)),"");
943     if (curcmd->c_line == 0)            /* don't debug debugger... */
944         perldb = FALSE;
945     curcmd = &compiling;
946     if (optype == O_EVAL) {             /* normal eval */
947         curcmd->c_filestab = fstab("(eval)");
948         curcmd->c_line = 1;
949         str_sset(linestr,str);
950         str_cat(linestr,";\n");         /* be kind to them */
951         if (perldb)
952             savelines(stab_xarray(curcmd->c_filestab), linestr);
953     }
954     else {
955         if (last_root && !in_eval) {
956             Safefree(last_eval);
957             last_eval = Nullch;
958             cmd_free(last_root);
959             last_root = Nullcmd;
960         }
961         specfilename = str_get(str);
962         str_set(linestr,"");
963         if (optype == O_REQUIRE && &str_undef !=
964           hfetch(stab_hash(incstab), specfilename, strlen(specfilename), 0)) {
965             curcmd = oldcurcmd;
966             tmps_base = oldtmps_base;
967             st[++sp] = &str_yes;
968             perldb = oldperldb;
969             return sp;
970         }
971         tmpfilename = savestr(specfilename);
972         if (index("/.", *tmpfilename))
973             rsfp = fopen(tmpfilename,"r");
974         else {
975             ar = stab_array(incstab);
976             for (i = 0; i <= ar->ary_fill; i++) {
977                 (void)sprintf(buf, "%s/%s",
978                   str_get(afetch(ar,i,TRUE)), specfilename);
979                 rsfp = fopen(buf,"r");
980                 if (rsfp) {
981                     char *s = buf;
982
983                     if (*s == '.' && s[1] == '/')
984                         s += 2;
985                     Safefree(tmpfilename);
986                     tmpfilename = savestr(s);
987                     break;
988                 }
989             }
990         }
991         curcmd->c_filestab = fstab(tmpfilename);
992         Safefree(tmpfilename);
993         tmpfilename = Nullch;
994         if (!rsfp) {
995             curcmd = oldcurcmd;
996             tmps_base = oldtmps_base;
997             if (optype == O_REQUIRE) {
998                 sprintf(tokenbuf,"Can't locate %s in @INC", specfilename);
999                 if (instr(tokenbuf,".h "))
1000                     strcat(tokenbuf," (change .h to .ph maybe?)");
1001                 if (instr(tokenbuf,".ph "))
1002                     strcat(tokenbuf," (did you run h2ph?)");
1003                 fatal("%s",tokenbuf);
1004             }
1005             if (gimme != G_ARRAY)
1006                 st[++sp] = &str_undef;
1007             perldb = oldperldb;
1008             return sp;
1009         }
1010         curcmd->c_line = 0;
1011     }
1012     in_eval++;
1013     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
1014     bufend = bufptr + linestr->str_cur;
1015     if (++loop_ptr >= loop_max) {
1016         loop_max += 128;
1017         Renew(loop_stack, loop_max, struct loop);
1018     }
1019     loop_stack[loop_ptr].loop_label = "_EVAL_";
1020     loop_stack[loop_ptr].loop_sp = sp;
1021 #ifdef DEBUGGING
1022     if (debug & 4) {
1023         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
1024     }
1025 #endif
1026     eval_root = Nullcmd;
1027     if (setjmp(loop_stack[loop_ptr].loop_env)) {
1028         retval = 1;
1029     }
1030     else {
1031         error_count = 0;
1032         if (rsfp) {
1033             retval = yyparse();
1034             retval |= error_count;
1035         }
1036         else if (last_root && last_elen == bufend - bufptr
1037           && *bufptr == *last_eval && !bcmp(bufptr,last_eval,last_elen)){
1038             retval = 0;
1039             eval_root = last_root;      /* no point in reparsing */
1040         }
1041         else if (in_eval == 1 && !savecmd) {
1042             if (last_root) {
1043                 Safefree(last_eval);
1044                 last_eval = Nullch;
1045                 cmd_free(last_root);
1046             }
1047             last_root = Nullcmd;
1048             last_elen = bufend - bufptr;
1049             last_eval = nsavestr(bufptr, last_elen);
1050             retval = yyparse();
1051             retval |= error_count;
1052             if (!retval)
1053                 last_root = eval_root;
1054             if (!last_root) {
1055                 Safefree(last_eval);
1056                 last_eval = Nullch;
1057             }
1058         }
1059         else
1060             retval = yyparse();
1061     }
1062     myroot = eval_root;         /* in case cmd_exec does another eval! */
1063
1064     if (retval) {
1065         st = stack->ary_array;
1066         sp = arglast[0];
1067         if (gimme != G_ARRAY)
1068             st[++sp] = &str_undef;
1069         if (parsing) {
1070 #ifndef MANGLEDPARSE
1071 #ifdef DEBUGGING
1072             if (debug & 128)
1073                 fprintf(stderr,"Freeing eval_root %lx\n",(long)eval_root);
1074 #endif
1075             cmd_free(eval_root);
1076 #endif
1077             if ((CMD*)eval_root == last_root)
1078                 last_root = Nullcmd;
1079             eval_root = myroot = Nullcmd;
1080         }
1081         if (rsfp) {
1082             fclose(rsfp);
1083             rsfp = 0;
1084         }
1085     }
1086     else {
1087         parsing = 0;
1088         sp = cmd_exec(eval_root,gimme,sp);
1089         st = stack->ary_array;
1090         for (i = arglast[0] + 1; i <= sp; i++)
1091             st[i] = str_mortal(st[i]);
1092                                 /* if we don't save result, free zaps it */
1093         if (savecmd)
1094             eval_root = myroot;
1095         else if (in_eval != 1 && myroot != last_root)
1096             cmd_free(myroot);
1097     }
1098
1099     perldb = oldperldb;
1100     in_eval--;
1101 #ifdef DEBUGGING
1102     if (debug & 4) {
1103         char *tmps = loop_stack[loop_ptr].loop_label;
1104         deb("(Popping label #%d %s)\n",loop_ptr,
1105             tmps ? tmps : "" );
1106     }
1107 #endif
1108     loop_ptr--;
1109     tmps_base = oldtmps_base;
1110     curspat = oldspat;
1111     lastspat = oldlspat;
1112     if (savestack->ary_fill > oldsave)  /* let them use local() */
1113         restorelist(oldsave);
1114
1115     if (optype != O_EVAL) {
1116         if (retval) {
1117             if (optype == O_REQUIRE)
1118                 fatal("%s", str_get(stab_val(stabent("@",TRUE))));
1119         }
1120         else {
1121             curcmd = oldcurcmd;
1122             if (gimme == G_SCALAR ? str_true(st[sp]) : sp > arglast[0]) {
1123                 (void)hstore(stab_hash(incstab), specfilename,
1124                   strlen(specfilename), str_smake(stab_val(curcmd->c_filestab)),
1125                       0 );
1126             }
1127             else if (optype == O_REQUIRE)
1128                 fatal("%s did not return a true value", specfilename);
1129         }
1130     }
1131     curcmd = oldcurcmd;
1132     return sp;
1133 }
1134
1135 int
1136 do_try(cmd,gimme,arglast)
1137 CMD *cmd;
1138 int gimme;
1139 int *arglast;
1140 {
1141     STR **st = stack->ary_array;
1142
1143     CMD * VOLATILE oldcurcmd = curcmd;
1144     VOLATILE int oldtmps_base = tmps_base;
1145     VOLATILE int oldsave = savestack->ary_fill;
1146     SPAT * VOLATILE oldspat = curspat;
1147     SPAT * VOLATILE oldlspat = lastspat;
1148     VOLATILE int sp = arglast[0];
1149
1150     tmps_base = tmps_max;
1151     str_set(stab_val(stabent("@",TRUE)),"");
1152     in_eval++;
1153     if (++loop_ptr >= loop_max) {
1154         loop_max += 128;
1155         Renew(loop_stack, loop_max, struct loop);
1156     }
1157     loop_stack[loop_ptr].loop_label = "_EVAL_";
1158     loop_stack[loop_ptr].loop_sp = sp;
1159 #ifdef DEBUGGING
1160     if (debug & 4) {
1161         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
1162     }
1163 #endif
1164     if (setjmp(loop_stack[loop_ptr].loop_env)) {
1165         st = stack->ary_array;
1166         sp = arglast[0];
1167         if (gimme != G_ARRAY)
1168             st[++sp] = &str_undef;
1169     }
1170     else {
1171         sp = cmd_exec(cmd,gimme,sp);
1172         st = stack->ary_array;
1173 /*      for (i = arglast[0] + 1; i <= sp; i++)
1174             st[i] = str_mortal(st[i]);  not needed, I think */
1175                                 /* if we don't save result, free zaps it */
1176     }
1177
1178     in_eval--;
1179 #ifdef DEBUGGING
1180     if (debug & 4) {
1181         char *tmps = loop_stack[loop_ptr].loop_label;
1182         deb("(Popping label #%d %s)\n",loop_ptr,
1183             tmps ? tmps : "" );
1184     }
1185 #endif
1186     loop_ptr--;
1187     tmps_base = oldtmps_base;
1188     curspat = oldspat;
1189     lastspat = oldlspat;
1190     curcmd = oldcurcmd;
1191     if (savestack->ary_fill > oldsave)  /* let them use local() */
1192         restorelist(oldsave);
1193
1194     return sp;
1195 }
1196
1197 /* This routine handles any switches that can be given during run */
1198
1199 static char *
1200 moreswitches(s)
1201 char *s;
1202 {
1203     int numlen;
1204
1205     switch (*s) {
1206     case '0':
1207         nrschar = scanoct(s, 4, &numlen);
1208         nrs = nsavestr("\n",1);
1209         *nrs = nrschar;
1210         if (nrschar > 0377) {
1211             nrslen = 0;
1212             nrs = "";
1213         }
1214         else if (!nrschar && numlen >= 2) {
1215             nrslen = 2;
1216             nrs = "\n\n";
1217             nrschar = '\n';
1218         }
1219         return s + numlen;
1220     case 'a':
1221         minus_a = TRUE;
1222         s++;
1223         return s;
1224     case 'c':
1225         minus_c = TRUE;
1226         s++;
1227         return s;
1228     case 'd':
1229 #ifdef TAINT
1230         if (euid != uid || egid != gid)
1231             fatal("No -d allowed in setuid scripts");
1232 #endif
1233         perldb = TRUE;
1234         s++;
1235         return s;
1236     case 'D':
1237 #ifdef DEBUGGING
1238 #ifdef TAINT
1239         if (euid != uid || egid != gid)
1240             fatal("No -D allowed in setuid scripts");
1241 #endif
1242         debug = atoi(s+1) | 32768;
1243 #else
1244         warn("Recompile perl with -DDEBUGGING to use -D switch\n");
1245 #endif
1246         /*SUPPRESS 530*/
1247         for (s++; isDIGIT(*s); s++) ;
1248         return s;
1249     case 'i':
1250         inplace = savestr(s+1);
1251         /*SUPPRESS 530*/
1252         for (s = inplace; *s && !isSPACE(*s); s++) ;
1253         *s = '\0';
1254         break;
1255     case 'I':
1256 #ifdef TAINT
1257         if (euid != uid || egid != gid)
1258             fatal("No -I allowed in setuid scripts");
1259 #endif
1260         if (*++s) {
1261             (void)apush(stab_array(incstab),str_make(s,0));
1262         }
1263         else
1264             fatal("No space allowed after -I");
1265         break;
1266     case 'l':
1267         minus_l = TRUE;
1268         s++;
1269         if (isDIGIT(*s)) {
1270             ors = savestr("\n");
1271             orslen = 1;
1272             *ors = scanoct(s, 3 + (*s == '0'), &numlen);
1273             s += numlen;
1274         }
1275         else {
1276             ors = nsavestr(nrs,nrslen);
1277             orslen = nrslen;
1278         }
1279         return s;
1280     case 'n':
1281         minus_n = TRUE;
1282         s++;
1283         return s;
1284     case 'p':
1285         minus_p = TRUE;
1286         s++;
1287         return s;
1288     case 'u':
1289         do_undump = TRUE;
1290         s++;
1291         return s;
1292     case 'U':
1293         unsafe = TRUE;
1294         s++;
1295         return s;
1296     case 'v':
1297         fputs("\nThis is perl, version 4.0\n\n",stdout);
1298         fputs(rcsid,stdout);
1299         fputs("\nCopyright (c) 1989, 1990, 1991, Larry Wall\n",stdout);
1300 #ifdef MSDOS
1301         fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
1302         stdout);
1303 #ifdef OS2
1304         fputs("OS/2 port Copyright (c) 1990, Raymond Chen, Kai Uwe Rommel\n",
1305         stdout);
1306 #endif
1307 #endif
1308         fputs("\n\
1309 Perl may be copied only under the terms of either the Artistic License or the\n\
1310 GNU General Public License, which may be found in the Perl 4.0 source kit.\n",stdout);
1311 #ifdef MSDOS
1312         usage(origargv[0]);
1313 #endif
1314         exit(0);
1315     case 'w':
1316         dowarn = TRUE;
1317         s++;
1318         return s;
1319     case ' ':
1320     case '\n':
1321     case '\t':
1322         break;
1323     default:
1324         fatal("Switch meaningless after -x: -%s",s);
1325     }
1326     return Nullch;
1327 }
1328
1329 /* compliments of Tom Christiansen */
1330
1331 /* unexec() can be found in the Gnu emacs distribution */
1332
1333 my_unexec()
1334 {
1335 #ifdef UNEXEC
1336     int    status;
1337     extern int etext;
1338     static char dumpname[BUFSIZ];
1339     static char perlpath[256];
1340
1341     sprintf (dumpname, "%s.perldump", origfilename);
1342     sprintf (perlpath, "%s/perl", BIN);
1343
1344     status = unexec(dumpname, perlpath, &etext, sbrk(0), 0);
1345     if (status)
1346         fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname);
1347     exit(status);
1348 #else
1349 #ifdef MSDOS
1350     abort();    /* nothing else to do */
1351 #else /* ! MSDOS */
1352 #   ifndef SIGABRT
1353 #       define SIGABRT SIGILL
1354 #   endif
1355 #   ifndef SIGILL
1356 #       define SIGILL 6         /* blech */
1357 #   endif
1358     kill(getpid(),SIGABRT);     /* for use with undump */
1359 #endif /* ! MSDOS */
1360 #endif
1361 }
1362