*** /dev/null Sat Nov 23 01:12:37 2024
--- - Sat Nov 23 01:12:37 2024
***************
*** 0 ****
--- 1,1261 ----
+ /*
+ ** ____ _
+ ** ___| _ \ ___ _ __| |
+ ** / _ \ |_) / _ \ '__| |
+ ** | __/ __/ __/ | | |
+ ** \___|_| \___|_| |_|
+ **
+ ** ePerl -- Embedded Perl 5 Language
+ **
+ ** ePerl interprets an ASCII file bristled with Perl 5 program statements
+ ** by evaluating the Perl 5 code while passing through the plain ASCII
+ ** data. It can operate both as a standard Unix filter for general file
+ ** generation tasks and as a powerful Webserver scripting language for
+ ** dynamic HTML page programming.
+ **
+ ** ======================================================================
+ **
+ ** Copyright (c) 1996,1997,1998 Ralf S. Engelschall <rse@engelschall.com>
+ **
+ ** This program is free software; it may be redistributed and/or modified
+ ** only under the terms of either the Artistic License or the GNU General
+ ** Public License, which may be found in the ePerl source distribution.
+ ** Look at the files ARTISTIC and COPYING or run ``eperl -l'' to receive
+ ** a built-in copy of both license files.
+ **
+ ** This program is distributed in the hope that it will be useful, but
+ ** WITHOUT ANY WARRANTY; without even the implied warranty of
+ ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
+ ** Artistic License or the GNU General Public License for more details.
+ **
+ ** ======================================================================
+ **
+ ** eperl_main.c -- ePerl main procedure
+ */
+
+ #include "eperl_config.h"
+ #include "eperl_global.h"
+ #include "eperl_security.h"
+ #include "eperl_getopt.h"
+ #include "eperl_perl5.h"
+ #include "eperl_proto.h"
+
+ #define _EPERL_VERSION_C_AS_HEADER_
+ #include "eperl_version.c"
+ #undef _EPERL_VERSION_C_AS_HEADER_
+
+ int mode = MODE_UNKNOWN;
+
+ char *allowed_file_ext[] = LIST_OF_ALLOWED_FILE_EXT;
+ char *allowed_caller_uid[] = LIST_OF_ALLOWED_CALLER_UID;
+
+ /*
+ * Display an error message and a logfile content as a HTML page
+ */
+ void PrintError(int mode, char *scripturl, char *scriptfile, char *logfile, char *str, ...)
+ {
+ va_list ap;
+ char ca[1024];
+ char *cpBuf;
+ char *cp;
+
+ va_start(ap, str);
+ vsprintf(ca, str, ap);
+
+ IO_restore_stdout();
+ IO_restore_stderr();
+
+ if (mode == MODE_CGI || mode == MODE_NPHCGI) {
+ if (mode == MODE_NPHCGI)
+ HTTP_PrintResponseHeaders("");
+ printf("Content-Type: text/html\n\n");
+ printf("<html>\n");
+ printf("<head>\n");
+ printf("<title>ePerl: ERROR: %s</title>\n", ca);
+ printf("</head>\n");
+ printf("<body bgcolor=\"#d0d0d0\">\n");
+ printf("<blockquote>\n");
+ cp = getenv("SCRIPT_NAME");
+ if (cp == NULL)
+ cp = "UNKNOWN_IMG_DIR";
+ printf("<a href=\"http://www.engelschall.com/sw/eperl/\"><img src=\"%s/powered.gif\" alt=\"Powered By ePerl\" align=right border=0></a>\n", cp);
+ printf("<table cellspacing=0 cellpadding=0 border=0>\n");
+ printf("<tr>\n");
+ printf("<td><img src=\"%s/logo.gif\" alt=\"Embedded Perl 5 Language\"></td>\n", cp);
+ printf("</tr>\n");
+ printf("<tr>\n");
+ printf("<td align=right><b>Version %s</b></td>\n", eperl_version.v_short);
+ printf("</tr>\n");
+ printf("</table>\n");
+ printf("<p>\n");
+ printf("<table bgcolor=\"#d0d0f0\" cellspacing=0 cellpadding=10 border=0>\n");
+ printf("<tr><td bgcolor=\"#b0b0d0\">\n");
+ printf("<font face=\"Arial, Helvetica\"><b>ERROR:</b></font>\n");
+ printf("</td></tr>\n");
+ printf("<tr><td>\n");
+ printf("<h1><font color=\"#3333cc\">%s</font></h1>\n", ca);
+ printf("</td></tr>\n");
+ printf("</table>\n");
+ if (logfile != NULL) {
+ if ((cpBuf = ePerl_ReadErrorFile(logfile, scriptfile, scripturl)) != NULL) {
+ printf("<p>");
+ printf("<table bgcolor=\"#e0e0e0\" cellspacing=0 cellpadding=10 border=0>\n");
+ printf("<tr><td bgcolor=\"#c0c0c0\">\n");
+ printf("<font face=\"Arial, Helvetica\"><b>Contents of STDERR channel:</b></font>\n");
+ printf("</td></tr>\n");
+ printf("<tr><td>\n");
+ printf("<pre>\n");
+ printf("%s", cpBuf);
+ printf("</pre>");
+ printf("</td></tr>\n");
+ printf("</table>\n");
+ }
+ }
+ printf("</blockquote>\n");
+ printf("</body>\n");
+ printf("</html>\n");
+ }
+ else {
+ fprintf(stderr, "ePerl:Error: %s\n", ca);
+ if (logfile != NULL) {
+ if ((cpBuf = ePerl_ReadErrorFile(logfile, scriptfile, scripturl)) != NULL) {
+ fprintf(stderr, "\n");
+ fprintf(stderr, "---- Contents of STDERR channel: ---------\n");
+ fprintf(stderr, "%s", cpBuf);
+ if (cpBuf[strlen(cpBuf)-1] != '\n')
+ fprintf(stderr, "\n");
+ fprintf(stderr, "------------------------------------------\n");
+ }
+ }
+ }
+ fflush(stderr);
+ fflush(stdout);
+
+ va_end(ap);
+ return;
+ }
+
+ void give_version(void)
+ {
+ fprintf(stdout, "%s\n", eperl_version.v_tex);
+ fprintf(stdout, "\n");
+ fprintf(stdout, "Copyright (c) 1996-2000 Ralf S. Engelschall <rse@engelschall.com>\n");
+ fprintf(stdout, "\n");
+ fprintf(stdout, "This program is distributed in the hope that it will be useful,\n");
+ fprintf(stdout, "but WITHOUT ANY WARRANTY; without even the implied warranty of\n");
+ fprintf(stdout, "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either\n");
+ fprintf(stdout, "the Artistic License or the GNU General Public License for more details.\n");
+ fprintf(stdout, "\n");
+ }
+
+ void give_version_extended(void)
+ {
+ give_version();
+ fprintf(stdout, "Characteristics of this binary:\n");
+ fprintf(stdout, " Perl Version : %s (%s)\n", AC_perl_vers, AC_perl_prog);
+ fprintf(stdout, " Perl I/O Layer : %s\n", PERL_IO_LAYER_ID);
+ fprintf(stdout, " Perl Library : %s/CORE/libperl.a\n", AC_perl_archlib);
+ fprintf(stdout, " Perl DynaLoader : %s\n", AC_perl_dla);
+ fprintf(stdout, " System Libs : %s\n", AC_perl_libs);
+ fprintf(stdout, " Built User : %s\n", AC_build_user);
+ fprintf(stdout, " Built Time : %s\n", AC_build_time_iso);
+ fprintf(stdout, "\n");
+ }
+
+ void give_readme(void)
+ {
+ fprintf(stdout, ePerl_README);
+ }
+
+ void give_license(void)
+ {
+ fprintf(stdout, ePerl_LICENSE);
+ }
+
+ void give_img_logo(void)
+ {
+ if (mode == MODE_NPHCGI)
+ HTTP_PrintResponseHeaders("");
+ printf("Content-Type: image/gif\n\n");
+ fwrite(ePerl_LOGO_data, ePerl_LOGO_size, 1, stdout);
+ }
+
+ void give_img_powered(void)
+ {
+ if (mode == MODE_NPHCGI)
+ HTTP_PrintResponseHeaders("");
+ printf("Content-Type: image/gif\n\n");
+ fwrite(ePerl_POWERED_data, ePerl_POWERED_size, 1, stdout);
+ }
+
+ void give_usage(char *name)
+ {
+ fprintf(stderr, "Usage: %s [options] [scriptfile]\n", name);
+ fprintf(stderr, "\n");
+ fprintf(stderr, "Input Options:\n");
+ fprintf(stderr, " -d, --define=NAME=VALUE define global Perl variable ($main::name)\n");
+ fprintf(stderr, " -D, --setenv=NAME=VALUE define environment variable ($ENV{'name'})\n");
+ fprintf(stderr, " -I, --includedir=PATH add @INC/#include directory\n");
+ fprintf(stderr, " -B, --block-begin=STR set begin block delimiter\n");
+ fprintf(stderr, " -E, --block-end=STR set end block delimiter\n");
+ fprintf(stderr, " -n, --nocase force block delimiters to be case insensitive\n");
+ fprintf(stderr, " -k, --keepcwd force keeping of current working directory\n");
+ fprintf(stderr, " -P, --preprocess enable ePerl Preprocessor\n");
+ fprintf(stderr, " -C, --convert-entity enable HTML entity conversion for ePerl blocks\n");
+ fprintf(stderr, " -L, --line-continue enable line continuation via backslashes\n");
+ fprintf(stderr, "\n");
+ fprintf(stderr, "Output Options:\n");
+ fprintf(stderr, " -T, --tainting enable Perl Tainting\n");
+ fprintf(stderr, " -w, --warnings enable Perl Warnings\n");
+ fprintf(stderr, " -x, --debug enable ePerl debugging output on console\n");
+ fprintf(stderr, " -m, --mode=STR force runtime mode to FILTER, CGI or NPH-CGI\n");
+ fprintf(stderr, " -o, --outputfile=PATH force the output to be send to this file (default=stdout)\n");
+ fprintf(stderr, " -c, --check run syntax check only and exit (no execution)\n");
+ fprintf(stderr, "\n");
+ fprintf(stderr, "Giving Feedback:\n");
+ fprintf(stderr, " -r, --readme display ePerl README file\n");
+ fprintf(stderr, " -l, --license display ePerl license files (COPYING and ARTISTIC)\n");
+ fprintf(stderr, " -v, --version display ePerl VERSION id\n");
+ fprintf(stderr, " -V, --ingredients display ePerl VERSION id & compilation parameters\n");
+ fprintf(stderr, " -h, --help display ePerl usage list (this one)\n");
+ fprintf(stderr, "\n");
+ }
+
+ char *RememberedINC[1024] = { NULL };
+
+ void RememberINC(char *str)
+ {
+ int i;
+
+ for (i = 0; RememberedINC[i] != NULL; i++)
+ ;
+ RememberedINC[i++] = strdup(str);
+ RememberedINC[i++] = NULL;
+ return;
+ }
+
+ void mysighandler(int rc)
+ {
+ /* ignore more signals */
+ signal(SIGINT, SIG_IGN);
+ signal(SIGTERM, SIG_IGN);
+
+ /* restore filehandles */
+ IO_restore_stdout();
+ IO_restore_stderr();
+
+ /* give interrupt information */
+ fprintf(stderr, "ePerl: **INTERRUPT**\n");
+
+ /* exit immediately */
+ myexit(EX_FAIL);
+ }
+
+ void myinit(void)
+ {
+ /* caught signals */
+ signal(SIGINT, mysighandler);
+ signal(SIGTERM, mysighandler);
+ }
+
+ void myexit(int rc)
+ {
+ /* cleanup */
+ #ifndef DEBUG_ENABLED
+ remove_mytmpfiles();
+ #endif
+
+ /* restore signals */
+ signal(SIGINT, SIG_DFL);
+ signal(SIGTERM, SIG_DFL);
+
+ #ifdef DEBUG_ENABLED
+ #ifdef HAVE_DMALLOC
+ dmalloc_shutdown();
+ #endif
+ #endif
+
+ /* die gracefully */
+ exit(rc);
+ }
+
+ struct option options[] = {
+ { "define", 1, NULL, 'd' },
+ { "setenv", 1, NULL, 'D' },
+ { "includedir", 1, NULL, 'I' },
+ { "block-begin", 1, NULL, 'B' },
+ { "block-end", 1, NULL, 'E' },
+ { "nocase", 0, NULL, 'n' },
+ { "keepcwd", 0, NULL, 'k' },
+ { "preprocess", 0, NULL, 'P' },
+ { "convert-entity", 0, NULL, 'C' },
+ { "line-continue", 0, NULL, 'L' },
+ { "tainting", 0, NULL, 'T' },
+ { "warnings", 0, NULL, 'w' },
+ { "debug", 0, NULL, 'x' },
+ { "mode", 1, NULL, 'm' },
+ { "outputfile", 1, NULL, 'o' },
+ { "check", 0, NULL, 'c' },
+ { "readme", 0, NULL, 'r' },
+ { "license", 0, NULL, 'l' },
+ { "version", 0, NULL, 'v' },
+ { "ingredients", 0, NULL, 'V' },
+ { "help", 0, NULL, 'h' }
+ };
+
+ /*
+ * main procedure
+ */
+ int main(int argc, char **argv, char **env)
+ {
+ DECL_EXRC;
+ FILE *fp = NULL;
+ FILE *er = NULL;
+ FILE *out = NULL;
+ char *cpBuf = NULL;
+ char *cpBuf2 = NULL;
+ char *cpBuf3 = NULL;
+ char perlscript[1024] = "";
+ char perlstderr[1024] = "";
+ char perlstdout[1024] = "";
+ char dir_tmp[1024];
+ char *dir_home;
+ char *dir_script;
+ char ca[1024] = "";
+ int myargc;
+ char *myargv[20];
+ char *progname;
+ int nBuf;
+ int nOut;
+ char *source = NULL;
+ char sourcedir[2048];
+ char *cp;
+ static PerlInterpreter *my_perl = NULL;
+ struct stat st;
+ char *cpOut = NULL;
+ int size;
+ struct passwd *pw;
+ struct passwd *pw2;
+ struct group *gr;
+ int uid, gid;
+ int keepcwd = FALSE;
+ int c;
+ char *cpScript = NULL;
+ int allow;
+ int i, n, k;
+ char *outputfile = NULL;
+ char cwd[MAXPATHLEN];
+ int fCheck = FALSE;
+ int fTaint = FALSE;
+ int fWarn = FALSE;
+ int fNoCase = FALSE;
+ int fPP = FALSE;
+ char *cwd2;
+ int fOkSwitch;
+ char *cpHost;
+ char *cpPort;
+ char *cpPath;
+ char *cpCGIgi;
+ char *cpCGIpt;
+ char *cpCGIqs;
+ int fCGIqsEqualChar;
+
+ /* first step: our process initialisation */
+ myinit();
+
+ /* second step: canonicalize program name */
+ progname = argv[0];
+ if ((cp = strrchr(progname, '/')) != NULL) {
+ progname = cp+1;
+ }
+
+ /* parse the option arguments */
+ opterr = 0;
+ while ((c = getopt_long(argc, argv, ":d:D:I:B:E:nkPCLTwxm:o:crlvVh", options, NULL)) != -1) {
+ if (optarg == NULL)
+ optarg = "(null)";
+ switch (c) {
+ case 'd':
+ Perl5_RememberScalar(optarg);
+ break;
+ case 'D':
+ env = Perl5_SetEnvVar(env, optarg);
+ break;
+ case 'I':
+ RememberINC(optarg);
+ break;
+ case 'B':
+ ePerl_begin_delimiter = strdup(optarg);
+ break;
+ case 'E':
+ ePerl_end_delimiter = strdup(optarg);
+ break;
+ case 'n':
+ fNoCase = TRUE;
+ break;
+ case 'k':
+ keepcwd = TRUE;
+ break;
+ case 'P':
+ fPP = TRUE;
+ break;
+ case 'C':
+ ePerl_convert_entities = TRUE;
+ break;
+ case 'L':
+ ePerl_line_continuation = TRUE;
+ break;
+ case 'T':
+ fTaint = TRUE;
+ break;
+ case 'w':
+ fWarn = TRUE;
+ break;
+ case 'x':
+ fDebug = TRUE;
+ break;
+ case 'm':
+ if (strcasecmp(optarg, "f") == 0 ||
+ strcasecmp(optarg, "filter") == 0 ) {
+ mode = MODE_FILTER;
+ }
+ else if (strcasecmp(optarg, "c") == 0 ||
+ strcasecmp(optarg, "cgi") == 0 ) {
+ mode = MODE_CGI;
+ }
+ else if (strcasecmp(optarg, "n") == 0 ||
+ strcasecmp(optarg, "nph") == 0 ||
+ strcasecmp(optarg, "nphcgi") == 0 ||
+ strcasecmp(optarg, "nph-cgi") == 0 ) {
+ mode = MODE_NPHCGI;
+ }
+ else {
+ PrintError(mode, "", NULL, NULL, "Unknown runtime mode `%s'", optarg);
+ CU(EX_USAGE);
+ }
+ break;
+ case 'o':
+ outputfile = strdup(optarg);
+ break;
+ case 'c':
+ fCheck = TRUE;
+ break;
+ case 'r':
+ give_readme();
+ myexit(EX_OK);
+ case 'l':
+ give_license();
+ myexit(EX_OK);
+ case 'v':
+ give_version();
+ myexit(EX_OK);
+ case 'V':
+ give_version_extended();
+ myexit(EX_OK);
+ case 'h':
+ give_usage(progname);
+ myexit(EX_OK);
+ case '?':
+ if (isprint(optopt))
+ fprintf(stderr, "ePerl:Error: Unknown option `-%c'.\n", optopt);
+ else
+ fprintf(stderr, "ePerl:Error: Unknown option character `\\x%x'.\n", optopt);
+ fprintf(stderr, "Try `%s --help' for more information.\n", progname);
+ myexit(EX_USAGE);
+ case ':':
+ if (isprint(optopt))
+ fprintf(stderr, "ePerl:Error: Missing argument for option `-%c'.\n", optopt);
+ else
+ fprintf(stderr, "ePerl:Error: Missing argument for option character `\\x%x'.\n", optopt);
+ fprintf(stderr, "Try `%s --help' for more information.\n", progname);
+ myexit(EX_USAGE);
+ }
+ }
+
+ /*
+ * determine source filename and runtime mode
+ */
+
+ if ((cpCGIgi = getenv("GATEWAY_INTERFACE")) == NULL)
+ cpCGIgi = "";
+ if ((cpCGIpt = getenv("PATH_TRANSLATED")) == NULL)
+ cpCGIpt = "";
+ if ((cpCGIqs = getenv("QUERY_STRING")) == NULL)
+ cpCGIqs = "";
+ fCGIqsEqualChar = FALSE;
+ if (cpCGIqs != NULL && strchr(cpCGIqs, '=') != NULL)
+ fCGIqsEqualChar = TRUE;
+
+ /*
+ * Server-Side-Scripting-Language:
+ *
+ * Request:
+ * /url/to/nph-eperl/url/to/script.phtml[?query-string]
+ * Environment:
+ * GATEWAY_INTERFACE=CGI/1.1
+ * SCRIPT_NAME=/url/to/nph-eperl
+ * SCRIPT_FILENAME=/path/to/nph-eperl
+ * PATH_INFO=/url/to/script.phtml
+ * PATH_TRANSLATED=/path/to/script.phtml
+ * a) QUERY_STRING=""
+ * optind=argc
+ * b) QUERY_STRING=query-string (containing "=" char)
+ * optind=argc
+ * c) QUERY_STRING=query-string (containing NO "=" char)
+ * optind=argc-1
+ * argv[optind]=query-string
+ */
+ if ( cpCGIgi[0] != NUL
+ && cpCGIpt[0] != NUL
+ && ( ( optind == argc
+ && ( cpCGIqs[0] == NUL
+ || fCGIqsEqualChar ) )
+ || ( optind == argc-1
+ && !fCGIqsEqualChar
+ && stringEQ(argv[optind], cpCGIqs) ) ) ) {
+
+ if (strncasecmp(cpCGIgi, "CGI/1", 5) != 0) {
+ fprintf(stderr, "ePerl:Error: Unknown gateway interface: NOT CGI/1.x\n");
+ CU(EX_IOERR);
+ }
+
+ /* CGI/1.1 or NPH-CGI/1.1 script,
+ source in PATH_TRANSLATED. */
+ source = cpCGIpt;
+
+ /* determine whether pure CGI or NPH-CGI mode */
+ if ((cp = getenv("SCRIPT_FILENAME")) != NULL) {
+ strcpy(ca, cp);
+ if ((cp = strrchr(ca, '/')) != NULL)
+ *cp++ = NUL;
+ else
+ cp = ca;
+ if (strncasecmp(cp, "nph-", 4) == 0)
+ mode = (mode == MODE_UNKNOWN ? MODE_NPHCGI : mode);
+ else
+ mode = (mode == MODE_UNKNOWN ? MODE_CGI : mode);
+ }
+ else {
+ mode = (mode == MODE_UNKNOWN ? MODE_CGI : mode);
+ }
+
+ /* set the command line for ``ps'' output */
+ sprintf(ca, "%s %s [%sCGI/SSSL]", argv[0], source, mode == MODE_NPHCGI ? "NPH-" : "");
+ argv[0] = strdup(ca);
+ }
+ /*
+ * Stand-Alone inside Webserver environment:
+ *
+ * Request:
+ * /url/to/script.cgi[/path-info][?query-string]
+ * [script.cgi has shebang #!/path/to/eperl]
+ * Environment:
+ * GATEWAY_INTERFACE=CGI/1.1
+ * SCRIPT_NAME=/url/to/script.cgi
+ * SCRIPT_FILENAME=/path/to/script.cgi
+ * PATH_INFO=/path-info
+ * PATH_TRANSLATED=/path/to/docroot/path-info
+ * a) QUERY_STRING=""
+ * optind=argc-1
+ * argv[optind]=/path/to/script.cgi
+ * b) QUERY_STRING=query-string (containing "=" char)
+ * optind=argc-1
+ * argv[optind]=/path/to/script.cgi
+ * c) QUERY_STRING=query-string (containing NO "=" char)
+ * optind=argc-2
+ * argv[optind]=/path/to/script.cgi
+ * argv[optind+1]=query-string
+ */
+ else if ( cpCGIgi[0] != NUL
+ && ( ( optind == argc-1
+ && ( cpCGIqs[0] == NUL
+ || fCGIqsEqualChar ) ) ||
+ ( optind == argc-2
+ && !fCGIqsEqualChar
+ && stringEQ(argv[optind+1], cpCGIqs)) ) ) {
+
+ if (strncasecmp(cpCGIgi, "CGI/1", 5) != 0) {
+ fprintf(stderr, "ePerl:Error: Unknown gateway interface: NOT CGI/1.x\n");
+ CU(EX_IOERR);
+ }
+
+ /* CGI/1.1 or NPH-CGI/1.1 script,
+ source in ARGV */
+ source = argv[optind];
+
+ /* determine whether pure CGI or NPH-CGI mode */
+ if ((cp = getenv("SCRIPT_FILENAME")) != NULL) {
+ strcpy(ca, cp);
+ if ((cp = strrchr(ca, '/')) != NULL)
+ *cp++ = NUL;
+ else
+ cp = ca;
+ if (strncasecmp(cp, "nph-", 4) == 0)
+ mode = (mode == MODE_UNKNOWN ? MODE_NPHCGI : mode);
+ else
+ mode = (mode == MODE_UNKNOWN ? MODE_CGI : mode);
+ }
+ else {
+ mode = (mode == MODE_UNKNOWN ? MODE_CGI : mode);
+ }
+
+ /* set the command line for ``ps'' output */
+ sprintf(ca, "%s %s [%sCGI/stand-alone]", argv[0], source, mode == MODE_NPHCGI ? "NPH-" : "");
+ argv[0] = strdup(ca);
+ }
+ /*
+ * Stand-Alone outside Webserver environment:
+ *
+ * Request:
+ * eperl script
+ * Environment:
+ * GATEWAY_INTERFACE=""
+ * SCRIPT_NAME=""
+ * SCRIPT_FILENAME=""
+ * PATH_INFO=""
+ * PATH_TRANSLATED=""
+ * QUERY_STRING=""
+ * optind=argc-1
+ * argv[optind]=script
+ */
+ else if ( cpCGIgi[0] == NUL
+ && cpCGIpt[0] == NUL
+ && cpCGIqs[0] == NUL
+ && optind == argc-1 ) {
+
+ /* stand-alone filter, source as argument:
+ either manually on the console or via shebang */
+ source = argv[optind];
+ mode = (mode == MODE_UNKNOWN ? MODE_FILTER : mode);
+
+ /* provide flexibility by recognizing "-" for stdin */
+ if (stringEQ(source, "-")) {
+ /* store stdin to tmpfile */
+ source = mytmpfile("ePerl.stdin");
+ if ((fp = fopen(source, "w")) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open tmpfile `%s' for writing", source);
+ CU(EX_IOERR);
+ }
+ while ((c = fgetc(stdin)) != EOF) {
+ fputc(c, fp);
+ }
+ fclose(fp); fp = NULL;
+
+ /* stdin script implies keeping of cwd */
+ keepcwd = TRUE;
+ }
+ }
+ /*
+ * Any other calling environment is an error...
+ */
+ else {
+ fprintf(stderr, "ePerl:Error: Missing required file to process\n");
+ fprintf(stderr, "ePerl:Error: Use either a filename, `-' for STDIN or PATH_TRANSLATED.\n");
+ fprintf(stderr, "Try `%s --help' for more information.\n", progname);
+ myexit(EX_USAGE);
+ }
+
+ /* set default delimiters */
+ if (ePerl_begin_delimiter == NULL) {
+ if (mode == MODE_FILTER)
+ ePerl_begin_delimiter = BEGIN_DELIMITER_FILTER;
+ else
+ ePerl_begin_delimiter = BEGIN_DELIMITER_CGI;
+ }
+ if (ePerl_end_delimiter == NULL) {
+ if (mode == MODE_FILTER)
+ ePerl_end_delimiter = END_DELIMITER_FILTER;
+ else
+ ePerl_end_delimiter = END_DELIMITER_CGI;
+ }
+ if (fNoCase)
+ ePerl_case_sensitive_delimiters = FALSE;
+ else
+ ePerl_case_sensitive_delimiters = TRUE;
+
+ /* the built-in GIF images */
+ if ((mode == MODE_CGI || mode == MODE_NPHCGI) && (cp = getenv("PATH_INFO")) != NULL) {
+ if (stringEQ(cp, "/logo.gif")) {
+ give_img_logo();
+ myexit(0);
+ }
+ else if (stringEQ(cp, "/powered.gif")) {
+ give_img_powered();
+ myexit(0);
+ }
+ }
+
+ /* CGI modes imply
+ - Preprocessor usage
+ - HTML entity conversions
+ - adding of DOCUMENT_ROOT to include paths */
+ if (mode == MODE_CGI || mode == MODE_NPHCGI) {
+ fPP = TRUE;
+ ePerl_convert_entities = TRUE;
+ if ((cp = getenv("DOCUMENT_ROOT")) != NULL)
+ RememberINC(cp);
+ }
+
+ /* check for valid source file */
+ if (*source == NUL) {
+ PrintError(mode, "", NULL, NULL, "Filename is empty");
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+
+ /* check for existing source file */
+ if ((stat(source, &st)) != 0) {
+ PrintError(mode, source, NULL, NULL, "File `%s' not exists", source);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+
+ /*
+ * Security Checks for the CGI modes
+ */
+ if (mode == MODE_CGI || mode == MODE_NPHCGI) {
+
+ /*
+ *
+ * == General Security ==
+ *
+ */
+
+ /* general security check: allowed file extension */
+ if (CGI_NEEDS_ALLOWED_FILE_EXT) {
+ allow = FALSE;
+ n = strlen(source);
+ for (i = 0; allowed_file_ext[i] != NULL; i++) {
+ k = strlen(allowed_file_ext[i]);
+ if (stringEQ(source+n-k, allowed_file_ext[i]))
+ allow = TRUE;
+ }
+ if (!allow) {
+ PrintError(mode, source, NULL, NULL, "File `%s' is not allowed to be interpreted by ePerl (wrong extension!)", source);
+ CU(EX_OK);
+ }
+ }
+
+ /*
+ *
+ * == Perl Security ==
+ *
+ */
+
+ /* perhaps force Taint mode */
+ if (CGI_MODES_FORCE_TAINTING)
+ fTaint = TRUE;
+
+ /* perhaps force Warnings */
+ if (CGI_MODES_FORCE_WARNINGS)
+ fWarn = TRUE;
+
+ /*
+ *
+ * == UID/GID switching ==
+ *
+ */
+
+ /* we can only do a switching if we have euid == 0 (root) */
+ if (geteuid() == 0) {
+
+ fOkSwitch = TRUE;
+
+ /* get our real user id (= caller uid) */
+ uid = getuid();
+
+ /* security check: valid caller uid */
+ pw = getpwuid(uid);
+ if (SETUID_NEEDS_VALID_CALLER_UID && pw == NULL) {
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "Invalid UID %d of caller", uid);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ }
+ else {
+ /* security check: allowed caller uid */
+ if (SETUID_NEEDS_ALLOWED_CALLER_UID) {
+ allow = FALSE;
+ for (i = 0; allowed_caller_uid[i] != NULL; i++) {
+ if (isdigit(allowed_caller_uid[i][0]))
+ pw2 = getpwuid(atoi(allowed_caller_uid[i]));
+ else
+ pw2 = getpwnam(allowed_caller_uid[i]);
+ if (stringEQ(pw->pw_name, pw2->pw_name)) {
+ allow = TRUE;
+ break;
+ }
+ }
+ if (!allow) {
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "UID %d of caller not allowed", uid);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ }
+ }
+ }
+
+ /* security check: valid owner UID */
+ pw = getpwuid(st.st_uid);
+ if (SETUID_NEEDS_VALID_OWNER_UID && pw == NULL)
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "Invalid UID %d of owner", st.st_uid);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ else
+ uid = pw->pw_uid;
+
+ /* security check: valid owner GID */
+ gr = getgrgid(st.st_gid);
+ if (SETUID_NEEDS_VALID_OWNER_GID && gr == NULL)
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "Invalid GID %d of owner", st.st_gid);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ else
+ gid = gr->gr_gid;
+
+ /* security check: file has to stay below owner homedir */
+ if (fOkSwitch && SETUID_NEEDS_BELOW_OWNER_HOME) {
+ /* preserve current working directory */
+ cwd2 = getcwd(NULL, 1024);
+
+ /* determine physical homedir of owner */
+ pw = getpwuid(st.st_uid);
+ if (chdir(pw->pw_dir) == -1) {
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "Invalid homedir ``%s'' of file owner", pw->pw_dir);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ }
+ else {
+ dir_home = getcwd(NULL, 1024);
+
+ /* determine physical dir of file */
+ strcpy(dir_tmp, source);
+ if ((cp = strrchr(dir_tmp, '/')) == NULL) {
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "Invalid script ``%s'': no absolute path", source);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ }
+ else {
+ *cp = NUL;
+ if (chdir(dir_tmp) == -1) {
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "Invalid script ``%s'': cannot chdir to its location", source);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ }
+ else {
+ dir_script = getcwd(NULL, 1024);
+
+ /* dir_home has to be a prefix of dir_script */
+ if (strncmp(dir_script, dir_home, strlen(dir_home)) < 0) {
+ if (DO_FOR_FAILED_STEP == STOP_AND_ERROR) {
+ PrintError(mode, source, NULL, NULL, "Invalid script ``%s'': does not stay below homedir of owner", source);
+ CU(EX_OK);
+ }
+ else
+ fOkSwitch = FALSE;
+ }
+
+ free(dir_script);
+ }
+ }
+ free(dir_home);
+ }
+
+ /* restore original cwd */
+ chdir(cwd2);
+
+ free(cwd2);
+ }
+
+ if (fOkSwitch && uid != 0 && gid != 0) {
+ /* switch to new uid/gid */
+ if (((setgid(gid)) != 0) || (initgroups(pw->pw_name,gid) != 0)) {
+ PrintError(mode, source, NULL, NULL, "Unable to set GID %d: setgid/initgroups failed", gid);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ if ((setuid(uid)) != 0) {
+ PrintError(mode, source, NULL, NULL, "Unable to set UID %d: setuid failed", uid);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ }
+ }
+ }
+
+ /* Security! Eliminate effective root permissions if we are running setuid */
+ if (geteuid() == 0) {
+ uid = getuid();
+ gid = getgid();
+ #ifdef HAVE_SETEUID
+ seteuid(uid);
+ #else
+ /* HP/UX and others eliminate the effective UID with setuid(uid) ! */
+ setuid(uid);
+ #endif
+ #ifdef HAVE_SETEGID
+ setegid(uid);
+ #else
+ /* HP/UX and others eliminate the effective GID with setgid(gid) ! */
+ setgid(gid);
+ #endif
+ }
+
+ /* read source file into internal buffer */
+ if ((cpBuf = ePerl_ReadSourceFile(source, &cpBuf, &nBuf)) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open source file `%s' for reading\n%s", source, ePerl_GetError);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+
+ /* strip shebang prefix */
+ if (strncmp(cpBuf, "#!", 2) == 0) {
+ for (cpScript = cpBuf;
+ (*cpScript != ' ' && *cpScript != '\t' && *cpScript != '\n') && (cpScript-cpBuf < nBuf);
+ cpScript++)
+ ;
+ for (cpScript = cpBuf;
+ *cpScript != '\n' && (cpScript-cpBuf < nBuf);
+ cpScript++)
+ ;
+ cpScript++;
+ }
+ else
+ cpScript = cpBuf;
+
+ /* now set the additional env vars */
+ env = mysetenv(env, "SCRIPT_SRC_PATH", "%s", abspath(source));
+ env = mysetenv(env, "SCRIPT_SRC_PATH_FILE", "%s", filename(source));
+ env = mysetenv(env, "SCRIPT_SRC_PATH_DIR", "%s", abspath(dirname(source)));
+ if ((cpPath = getenv("PATH_INFO")) != NULL) {
+ if ((cpHost = getenv("SERVER_NAME")) == NULL)
+ cpHost = "localhost";
+ cpPort = getenv("SERVER_PORT");
+ if (stringEQ(cpPort, "80"))
+ cpPort = NULL;
+ sprintf(ca, "http://%s%s%s%s",
+ cpHost, cpPort != NULL ? ":" : "", cpPort != NULL ? cpPort : "", cpPath);
+ env = mysetenv(env, "SCRIPT_SRC_URL", "%s", ca);
+ env = mysetenv(env, "SCRIPT_SRC_URL_FILE", "%s", filename(ca));
+ env = mysetenv(env, "SCRIPT_SRC_URL_DIR", "%s", dirname(ca));
+ }
+ else {
+ env = mysetenv(env, "SCRIPT_SRC_URL", "file://%s", abspath(source));
+ env = mysetenv(env, "SCRIPT_SRC_URL_FILE", "%s", filename(source));
+ env = mysetenv(env, "SCRIPT_SRC_URL_DIR", "file://%s", abspath(source));
+ }
+
+ env = mysetenv(env, "SCRIPT_SRC_SIZE", "%d", nBuf);
+ stat(source, &st);
+ env = mysetenv(env, "SCRIPT_SRC_MODIFIED", "%d", st.st_mtime);
+ cp = ctime(&(st.st_mtime));
+ cp[strlen(cp)-1] = NUL;
+ env = mysetenv(env, "SCRIPT_SRC_MODIFIED_CTIME", "%s", cp);
+ env = mysetenv(env, "SCRIPT_SRC_MODIFIED_ISOTIME", "%s", isotime(&(st.st_mtime)));
+ if ((pw = getpwuid(st.st_uid)) != NULL)
+ env = mysetenv(env, "SCRIPT_SRC_OWNER", "%s", pw->pw_name);
+ else
+ env = mysetenv(env, "SCRIPT_SRC_OWNER", "unknown-uid-%d", st.st_uid);
+ env = mysetenv(env, "VERSION_INTERPRETER", "%s", eperl_version.v_web);
+ env = mysetenv(env, "VERSION_LANGUAGE", "Perl/%s", AC_perl_vers);
+
+ /* optionally run the ePerl preprocessor */
+ if (fPP) {
+ /* switch to directory where script stays */
+ getcwd(cwd, MAXPATHLEN);
+ strcpy(sourcedir, source);
+ for (cp = sourcedir+strlen(sourcedir); cp > sourcedir && *cp != '/'; cp--)
+ ;
+ *cp = NUL;
+ chdir(sourcedir);
+ /* run the preprocessor */
+ if ((cpBuf3 = ePerl_PP(cpScript, RememberedINC)) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Preprocessing failed for `%s': %s", source, ePerl_PP_GetError());
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ cpScript = cpBuf3;
+ /* switch to previous dir */
+ chdir(cwd);
+ }
+
+ /* convert bristled source to valid Perl code */
+ if ((cpBuf2 = ePerl_Bristled2Plain(cpScript)) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot convert bristled code file `%s' to pure HTML", source);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ cpScript = cpBuf2;
+
+ /* write buffer to temporary script file */
+ strcpy(perlscript, mytmpfile("ePerl.script"));
+ #ifndef DEBUG_ENABLED
+ unlink(perlscript);
+ #endif
+ if ((fp = fopen(perlscript, "w")) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open Perl script file `%s' for writing", perlscript);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ fwrite(cpScript, strlen(cpScript), 1, fp);
+ fclose(fp); fp = NULL;
+
+ /* in Debug mode output the script to the console */
+ if (fDebug) {
+ if ((fp = fopen("/dev/tty", "w")) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open /dev/tty for debugging message");
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ fprintf(fp, "----internally created Perl script-----------------------------------\n");
+ fwrite(cpScript, strlen(cpScript)-1, 1, fp);
+ if (cpScript[strlen(cpScript)-1] == '\n')
+ fprintf(fp, "%c", cpScript[strlen(cpScript)-1]);
+ else
+ fprintf(fp, "%c\n", cpScript[strlen(cpScript)-1]);
+ fprintf(fp, "----internally created Perl script-----------------------------------\n");
+ fclose(fp); fp = NULL;
+ }
+
+ /* open a file for Perl's STDOUT channel
+ and redirect stdout to the new channel */
+ strcpy(perlstdout, mytmpfile("ePerl.stdout"));
+ #ifndef DEBUG_ENABLED
+ unlink(perlstdout);
+ #endif
+ if ((out = fopen(perlstdout, "w")) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open STDOUT file `%s' for writing", perlstdout);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ IO_redirect_stdout(out);
+
+ /* open a file for Perl's STDERR channel
+ and redirect stderr to the new channel */
+ strcpy(perlstderr, mytmpfile("ePerl.stderr"));
+ #ifndef DEBUG_ENABLED
+ unlink(perlstderr);
+ #endif
+ if ((er = fopen(perlstderr, "w")) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open STDERR file `%s' for writing", perlstderr);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ IO_redirect_stderr(er);
+
+ /* now allocate the Perl interpreter */
+ my_perl = perl_alloc();
+ perl_construct(my_perl);
+ /* perl_destruct_level = 1; */
+
+ /* initialise the Perl Locale environment */
+ #if AC_perl_vnum < 500400
+ perl_init_i18nl14n(1); /* Perl 5.003 or lower */
+ #else
+ perl_init_i18nl10n(1); /* Perl 5.004 or higher */
+ #endif
+
+ /* create command line... */
+ myargc = 0;
+ /* - program name and possible -T -w options */
+ myargv[myargc++] = progname;
+ if (fTaint)
+ myargv[myargc++] = "-T";
+ if (fWarn)
+ myargv[myargc++] = "-w";
+ /* - previously remembered Perl 5 INC entries (option -I) */
+ for (i = 0; RememberedINC[i] != NULL; i++) {
+ myargv[myargc++] = "-I";
+ myargv[myargc++] = RememberedINC[i];
+ }
+ /* - and the script itself */
+ myargv[myargc++] = perlscript;
+
+ /* now parse the script!
+ NOTICE: At this point, the script gets
+ only _parsed_, not evaluated/executed! */
+ #ifdef HAVE_PERL_DYNALOADER
+ rc = perl_parse(my_perl, Perl5_XSInit, myargc, myargv, env);
+ #else
+ rc = perl_parse(my_perl, NULL, myargc, myargv, env);
+ #endif
+ if (rc != 0) {
+ if (fCheck && mode == MODE_FILTER) {
+ fclose(er); er = NULL;
+ IO_restore_stdout();
+ IO_restore_stderr();
+ if ((cpBuf = ePerl_ReadErrorFile(perlstderr, perlscript, source)) != NULL) {
+ fprintf(stderr, cpBuf);
+ }
+ CU(EX_IOERR);
+ }
+ else {
+ fclose(er); er = NULL;
+ PrintError(mode, source, perlscript, perlstderr, "Perl parsing error (interpreter rc=%d)", rc);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ }
+
+ /* Stop when we are just doing a syntax check */
+ if (fCheck && mode == MODE_FILTER) {
+ fclose(er); er = NULL;
+ IO_restore_stdout();
+ IO_restore_stderr();
+ fprintf(stderr, "%s syntax OK\n", source);
+ CU(EX_OK);
+ }
+
+ /* change to directory of script:
+ this actually is not important to us, but really useful
+ for the ePerl source file programmer!! */
+ cwd[0] = NUL;
+ if (!keepcwd) {
+ /* if running as a Unix filter remember the cwd for outputfile */
+ if (mode == MODE_FILTER)
+ getcwd(cwd, MAXPATHLEN);
+ /* determine dir of source file and switch to it */
+ strcpy(sourcedir, source);
+ for (cp = sourcedir+strlen(sourcedir); cp > sourcedir && *cp != '/'; cp--)
+ ;
+ *cp = NUL;
+ chdir(sourcedir);
+ }
+
+ /* Set the previously remembered Perl 5 scalars (option -d) */
+ Perl5_SetRememberedScalars();
+
+ /* Force unbuffered I/O */
+ Perl5_ForceUnbufferedStdout();
+
+ /* NOW IT IS TIME to evaluate/execute the script!!! */
+ rc = perl_run(my_perl);
+
+ /* pre-close the handles, to be able to check
+ its size and to be able to display the contents */
+ fclose(out); out = NULL;
+ fclose(er); er = NULL;
+
+ /* when the Perl interpreter failed or there
+ is data on stderr, we print a error page */
+ if (stat(perlstderr, &st) == 0)
+ size = st.st_size;
+ else
+ size = 0;
+ if (rc != 0 || size > 0) {
+ PrintError(mode, source, perlscript, perlstderr, "Perl runtime error (interpreter rc=%d)", rc);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+
+ /* else all processing was fine, so
+ we read in the stdout contents */
+ if ((cpOut = ePerl_ReadSourceFile(perlstdout, &cpOut, &nOut)) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open STDOUT file `%s' for reading", perlstdout);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ stat(perlstdout, &st);
+
+ /* ok, now recover the stdout and stderr and
+ print out the real contents on stdout or outputfile */
+ IO_restore_stdout();
+ IO_restore_stderr();
+
+ /* if we are running as a NPH-CGI/1.1 script
+ we had to provide the HTTP reponse headers ourself */
+ if (mode == MODE_NPHCGI) {
+ HTTP_PrintResponseHeaders(cpOut);
+
+ /* if there are no HTTP header lines, we print a basic
+ Content-Type header which should be ok */
+ if (!HTTP_HeadersExists(cpOut)) {
+ printf("Content-Type: text/html\n");
+ printf("Content-Length: %d\n", nOut);
+ printf("\n");
+ }
+ }
+ else if (mode == MODE_CGI) {
+ HTTP_StripResponseHeaders(&cpOut, &nOut);
+
+ /* if there are no HTTP header lines, we print a basic
+ Content-Type header which should be ok */
+ if (!HTTP_HeadersExists(cpOut)) {
+ printf("Content-Type: text/html\n");
+ printf("Content-Length: %d\n", nOut);
+ printf("\n");
+ }
+ }
+ else if (mode == MODE_FILTER) {
+ HTTP_StripResponseHeaders(&cpOut, &nOut);
+ }
+
+ /* now when the request was not a HEAD request we create the output */
+ cp = getenv("REQUEST_METHOD");
+ if (! ((mode == MODE_CGI || mode == MODE_NPHCGI) &&
+ cp != NULL && stringEQ(cp, "HEAD"))) {
+ if (outputfile != NULL && stringNE(outputfile, "-")) {
+ /* if we remembered current working dir, restore it now */
+ if (mode == MODE_FILTER && cwd[0] != NUL)
+ chdir(cwd);
+ /* open outputfile and write out the data */
+ if ((fp = fopen(outputfile, "w")) == NULL) {
+ PrintError(mode, source, NULL, NULL, "Cannot open output file `%s' for writing", outputfile);
+ CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
+ }
+ fwrite(cpOut, nOut, 1, fp);
+ fclose(fp); fp = NULL;
+ }
+ else {
+ /* data just goes to stdout */
+ fwrite(cpOut, nOut, 1, stdout);
+ /* make sure that the data is out before we exit */
+ fflush(stdout);
+ }
+ }
+
+ CUS: /* the Clean Up Sequence */
+
+ /* Ok, the script got evaluated. Now we can destroy
+ and de-allocate the Perl interpreter */
+ if (my_perl) {
+ perl_destruct(my_perl);
+ perl_free(my_perl);
+ }
+
+ /* close all still open file handles */
+ if (out)
+ fclose(out);
+ if (er)
+ fclose(er);
+ if (fp)
+ fclose(fp);
+
+ /* de-allocate the script buffer */
+ if (cpBuf)
+ free(cpBuf);
+ if (cpBuf2)
+ free(cpBuf2);
+ if (cpOut)
+ free(cpOut);
+
+ /* remove temporary files */
+ #ifndef DEBUG_ENABLED
+ if (*perlstderr != NUL)
+ unlink(perlstderr);
+ if (*perlstdout != NUL)
+ unlink(perlstdout);
+ if (*perlscript != NUL)
+ unlink(perlscript);
+ #endif
+
+ myexit(EXRC);
+ return EXRC; /* make -Wall happy ;-) */
+ }
+
+ /*EOF*/
|
