MS-DOS patches to perl. Apply this patch to the standard perl source, version 4, patch level 19, using "patch -p." Do this in the root directory of the perl source distribution. You can cat all these patches together and pipe the output to patch -p. Len Reed Holos Software, Inc. ..!gatech!holos0!lbr holos0!lbr@gatech.edu -------------------------------------- *** perl.c.old Thu Nov 14 07:29:28 1991 --- perl.c Thu Nov 14 08:52:26 1991 *************** *** 50,55 **** --- 50,67 ---- #include "patchlevel.h" #endif + #ifndef PRIVLIB + #define PRIVLIB "/usr/local/lib/perl" + #endif + + #ifdef MSDOS + /* Binary perl.exe is widely distributed to those who can't rebuild it + for lack of tooling. Hence, PRIVLIB can be run-time overridden. + The first directory in $ENV{'PERLLIB'} is used, if it is set. + */ + static char *privlib = PRIVLIB; /* default, if no PERLLIB */ + #endif /* MSDOS */ + char *getenv(); #ifdef IAMSUID *************** *** 72,77 **** --- 84,103 ---- static int nrschar = '\n'; /* final char of rs, or 0777 if none */ static int nrslen = 1; + #ifdef MSDOS + static struct todo *e_t_ptr; /* temp file for -e */ + #define path_sep(s) (index((s), '/') || index((s), '\\') || index((s), ':')) + #define PATH_COMP_SEP ';' + #ifdef MKS_SUPPORT + # define no_mks_args (getenv("MKSARGS") == Nullch) + #else + # define no_mks_args 1 + #endif + #else + #define path_sep(s) index((s), '/') + #define PATH_COMP_SEP ':' + #endif + main(argc,argv,env) register int argc; register char **argv; *************** *** 110,115 **** --- 136,171 ---- */ (void)fclose(stdaux); (void)fclose(stdprn); + + /* Close anything else higher that stdprn for the same reason */ + + { + int nofiles, i; + nofiles = dos_get_nofiles(); + for (i = 5; i < nofiles; i++) + (void) close(i); + } + + /* Duplicate TMP from TMPDIR if only latter exists. Reverse slashes + as a courtesy to desendant processes. + */ + + if (getenv("TMP") == NULL) { /* if no TMP */ + if (s = getenv("TMPDIR")) { /* if TMPDIR */ + /* ( $ENV{'TMP'} = $ENV{'TMPDIR'} ) =~ s,/,\\,g; */ + char *s2; + + s2 = s; + New(1190, s, strlen(s) + 5, char); + (void) strcpy(s, "TMP="); + (void) strcat(s+4, s2); + putenv(s); + for (s += 4; *s; ++s) { + if (*s == '/') + *s = '\\'; + } + } + } #endif if (do_undump) { origfilename = savestr(argv[0]); *************** *** 162,172 **** --- 218,237 ---- fatal("No -e allowed in setuid scripts"); #endif if (!e_fp) { + #ifndef MSDOS e_tmpname = savestr(TMPPATH); + #else + block_signals(); /* prevent untimely ^C */ + e_tmpname = tempnam("", TMPPATH); /* uses env $TMP dir */ + #endif (void)mktemp(e_tmpname); e_fp = fopen(e_tmpname,"w"); if (!e_fp) fatal("Cannot open temporary file"); + #ifdef MSDOS + /* tie into temp file cleanup handler, unblock sigs */ + e_t_ptr = add_temp_file(e_fp, -1, NULL, e_tmpname, fdelete, 0); + #endif } if (argv[1]) { fputs(argv[1],e_fp); *************** *** 239,249 **** scriptname = e_tmpname; } - #ifdef MSDOS - #define PERLLIB_SEP ';' - #else - #define PERLLIB_SEP ':' - #endif #ifndef TAINT /* Can't allow arbitrary PERLLIB in setuid script */ { char * s2 = getenv("PERLLIB"); --- 304,309 ---- *************** *** 252,263 **** /* Break at all separators */ while ( *s2 ) { /* First, skip any consecutive separators */ ! while ( *s2 == PERLLIB_SEP ) { /* Uncomment the next line for PATH semantics */ /* (void)apush(stab_array(incstab),str_make(".",1)); */ s2++; } ! if ( (s = index(s2,PERLLIB_SEP)) != Nullch ) { (void)apush(stab_array(incstab),str_make(s2,(int)(s-s2))); s2 = s+1; } else { --- 312,323 ---- /* Break at all separators */ while ( *s2 ) { /* First, skip any consecutive separators */ ! while ( *s2 == PATH_COMP_SEP ) { /* Uncomment the next line for PATH semantics */ /* (void)apush(stab_array(incstab),str_make(".",1)); */ s2++; } ! if ( (s = index(s2,PATH_COMP_SEP)) != Nullch ) { (void)apush(stab_array(incstab),str_make(s2,(int)(s-s2))); s2 = s+1; } else { *************** *** 265,277 **** break; } } } } #endif /* TAINT */ - #ifndef PRIVLIB - #define PRIVLIB "/usr/local/lib/perl" - #endif (void)apush(stab_array(incstab),str_make(PRIVLIB,0)); (void)apush(stab_array(incstab),str_make(".",1)); --- 325,337 ---- break; } } + #ifdef MSDOS + privlib = str_get(afetch(stab_array(incstab),0,TRUE)); + #endif } } #endif /* TAINT */ (void)apush(stab_array(incstab),str_make(PRIVLIB,0)); (void)apush(stab_array(incstab),str_make(".",1)); *************** *** 290,313 **** #else scriptname = "-"; #endif ! if (dosearch && !index(scriptname, '/') && (s = getenv("PATH"))) { ! char *xfound = Nullch, *xfailed = Nullch; int len; ! bufend = s + strlen(s); ! while (*s) { ! #ifndef MSDOS ! s = cpytill(tokenbuf,s,bufend,':',&len); ! #else ! for (len = 0; *s && *s != ';'; tokenbuf[len++] = *s++); ! tokenbuf[len] = '\0'; #endif if (*s) s++; #ifndef MSDOS if (len && tokenbuf[len-1] != '/') #else ! if (len && tokenbuf[len-1] != '\\') #endif (void)strcat(tokenbuf+len,"/"); (void)strcat(tokenbuf+len,scriptname); --- 350,383 ---- #else scriptname = "-"; #endif ! if (dosearch && !path_sep(scriptname) && (s = getenv("PATH"))) { ! char *xfound = Nullch; ! #ifndef MSDOS ! char *xfailed = Nullch; ! #endif int len; ! #ifdef MSDOS ! /* DOS PATH semantics always look in cur directory 1st: ! Exception: MKS users have Unix-like PATH ! */ ! if (no_mks_args && stat(scriptname,&statbuf) == 0) { ! xfound = scriptname; /* bingo! */ ! *s = '\0'; /* avoid while loop */ ! } ! else /* don't do strlen if we already found file */ #endif + { + bufend = s + strlen(s); + } + while (*s) { + s = cpytill(tokenbuf,s,bufend,PATH_COMP_SEP,&len); if (*s) s++; #ifndef MSDOS if (len && tokenbuf[len-1] != '/') #else ! if (len && tokenbuf[len-1] != '\\' && tokenbuf[len-1] != '/') #endif (void)strcat(tokenbuf+len,"/"); (void)strcat(tokenbuf+len,scriptname); *************** *** 317,322 **** --- 387,393 ---- #endif if (stat(tokenbuf,&statbuf) < 0) /* not there? */ continue; + #ifndef MSDOS if (S_ISREG(statbuf.st_mode) && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) { xfound = tokenbuf; /* bingo! */ *************** *** 324,335 **** } if (!xfailed) xfailed = savestr(tokenbuf); } if (!xfound) fatal("Can't execute %s", xfailed ? xfailed : scriptname ); if (xfailed) Safefree(xfailed); ! scriptname = savestr(xfound); } fdpid = anew(Nullstab); /* for remembering popen pids by fd */ --- 395,417 ---- } if (!xfailed) xfailed = savestr(tokenbuf); + #else + xfound = tokenbuf; /* all files "executable" on MS-DOS */ + break; + #endif } + #ifndef MSDOS if (!xfound) fatal("Can't execute %s", xfailed ? xfailed : scriptname ); if (xfailed) Safefree(xfailed); ! #else ! if (!xfound) ! fatal("Can't execute %s", scriptname ); ! #endif ! if (xfound != scriptname) { ! scriptname = savestr(xfound); ! } } fdpid = anew(Nullstab); /* for remembering popen pids by fd */ *************** *** 340,345 **** --- 422,428 ---- if (strEQ(origfilename,"-")) scriptname = ""; if (preprocess) { + #ifndef MSDOS char *cpp = CPPSTDIN; if (strEQ(cpp,"cppstdin")) *************** *** 361,371 **** -e '/^#[ ]*endif/b' \ -e 's/^[ ]*#.*//' \ %s | %s -C %s %s", - #ifdef MSDOS - "", - #else "/bin/", - #endif (doextract ? "-e '1,/^#/d\n'" : ""), scriptname, tokenbuf, str_get(str), CPPMINUS); #ifdef DEBUGGING --- 444,450 ---- *************** *** 387,392 **** --- 466,477 ---- #endif #endif #endif /* IAMSUID */ + #else /* MSDOS */ + /* MS-DOS system may not have sed but it has perl */ + (void) sprintf(buf, "%s -s %s/doscpp.pl %s %s", + *origargv, privlib, argv[0], + (doextract ? "-x" : "")); + #endif rsfp = mypopen(buf,"r"); } else if (!*scriptname) { *************** *** 396,403 **** #endif rsfp = stdin; } ! else rsfp = fopen(scriptname,"r"); if ((FILE*)rsfp == Nullfp) { #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ --- 481,498 ---- #endif rsfp = stdin; } ! else { ! #ifdef MSDOS ! if (e_fp) { ! block_signals(); ! rsfp = fopen(e_tmpname, "r"); ! e_t_ptr->hfd.f = rsfp; /* new (FILE *) in temp file list */ ! unblock_signals(); ! } ! else /* handle like Unix */ ! #endif /* MSDOS */ rsfp = fopen(scriptname,"r"); + } if ((FILE*)rsfp == Nullfp) { #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ *************** *** 694,701 **** preprocess = FALSE; if (e_fp) { ! e_fp = Nullfp; (void)UNLINK(e_tmpname); } /* initialize everything that won't change if we undump */ --- 789,800 ---- preprocess = FALSE; if (e_fp) { ! #ifndef MSDOS (void)UNLINK(e_tmpname); + #else + mypclose(e_fp); /* this will unlink the temp file */ + #endif + e_fp = Nullfp; } /* initialize everything that won't change if we undump */ *************** *** 1300,1305 **** --- 1399,1406 ---- #ifdef MSDOS fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n", stdout); + fputs("MS-DOS enhancements Copyright (c) 1990, 1991 Leonard Reed\n", + stdout); #ifdef OS2 fputs("OS/2 port Copyright (c) 1990, Raymond Chen, Kai Uwe Rommel\n", stdout); *************** *** 1308,1316 **** fputs("\n\ Perl may be copied only under the terms of either the Artistic License or the\n\ GNU General Public License, which may be found in the Perl 4.0 source kit.\n",stdout); - #ifdef MSDOS - usage(origargv[0]); - #endif exit(0); case 'w': dowarn = TRUE; --- 1409,1414 ---- *************** *** 1359,1362 **** #endif /* ! MSDOS */ #endif } - --- 1457,1459 ----