#include "eperl_config.h"
#include "eperl_global.h"
#include "eperl_security.h"
#include "eperl_getopt.h"
#include "eperl_perl5.h"
#include "eperl_proto.h"
int mode = MODE_UNKNOWN;
char *allowed_file_ext[] = LIST_OF_ALLOWED_FILE_EXT;
char *allowed_caller_uid[] = LIST_OF_ALLOWED_CALLER_UID;
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("<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);
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_Hello);
fprintf(stdout, "\n");
fprintf(stdout, "Copyright (c) 1996-1997 Ralf S. Engelschall, All rights reserved.\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)
{
signal(SIGINT, SIG_IGN);
signal(SIGTERM, SIG_IGN);
IO_restore_stdout();
IO_restore_stderr();
fprintf(stderr, "ePerl: **INTERRUPT**\n");
myexit(EX_FAIL);
}
void myinit(void)
{
signal(SIGINT, mysighandler);
signal(SIGTERM, mysighandler);
}
void myexit(int rc)
{
#ifndef DEBUG_ENABLED
remove_mytmpfiles();
#endif
signal(SIGINT, SIG_DFL);
signal(SIGTERM, SIG_DFL);
#ifdef DEBUG_ENABLED
#ifdef HAVE_DMALLOC
dmalloc_shutdown();
#endif
#endif
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' }
};
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;
myinit();
progname = argv[0];
if ((cp = strrchr(progname, '/')) != NULL) {
progname = cp+1;
}
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);
}
}
if (optind == argc &&
getenv("GATEWAY_INTERFACE") != NULL &&
getenv("PATH_TRANSLATED") != NULL ) {
cp = getenv("GATEWAY_INTERFACE");
if (strncasecmp(cp, "CGI/1", 5) != 0) {
fprintf(stderr, "ePerl:Error: Unknown gateway interface: NOT CGI/1.x\n");
CU(EX_IOERR);
}
source = getenv("PATH_TRANSLATED");
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);
}
sprintf(ca, "%s %s [%sCGI]", argv[0], source, mode == MODE_NPHCGI ? "NPH-" : "");
argv[0] = strdup(ca);
}
else if (optind == argc-1 &&
getenv("GATEWAY_INTERFACE") != NULL) {
cp = getenv("GATEWAY_INTERFACE");
if (strncasecmp(cp, "CGI/1", 5) != 0) {
fprintf(stderr, "ePerl:Error: Unknown gateway interface: NOT CGI/1.x\n");
CU(EX_IOERR);
}
source = argv[optind];
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);
}
sprintf(ca, "%s %s [%sCGI]", argv[0], source, mode == MODE_NPHCGI ? "NPH-" : "");
argv[0] = strdup(ca);
}
else if (optind == argc-1 &&
getenv("GATEWAY_INTERFACE") == NULL &&
getenv("PATH_TRANSLATED") == NULL &&
getenv("QUERY_STRING") == NULL ) {
source = argv[optind];
mode = (mode == MODE_UNKNOWN ? MODE_FILTER : mode);
if (strcmp(source, "-") == 0) {
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);
keepcwd = TRUE;
}
}
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);
}
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;
if ((mode == MODE_CGI || mode == MODE_NPHCGI) && (cp = getenv("PATH_INFO")) != NULL) {
if (strcmp(cp, "/logo.gif") == 0) {
give_img_logo();
myexit(0);
}
else if (strcmp(cp, "/powered.gif") == 0) {
give_img_powered();
myexit(0);
}
}
if (mode == MODE_CGI || mode == MODE_NPHCGI) {
fPP = TRUE;
ePerl_convert_entities = TRUE;
if ((cp = getenv("DOCUMENT_ROOT")) != NULL)
RememberINC(cp);
}
if (*source == NUL) {
PrintError(mode, "", NULL, NULL, "Filename is empty");
CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
}
if ((stat(source, &st)) != 0) {
PrintError(mode, source, NULL, NULL, "File `%s' not exists", source);
CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
}
if (mode == MODE_CGI || mode == MODE_NPHCGI) {
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 (strcmp(source+n-k, allowed_file_ext[i]) == 0)
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);
}
}
if (CGI_MODES_FORCE_TAINTING)
fTaint = TRUE;
if (CGI_MODES_FORCE_WARNINGS)
fWarn = TRUE;
if (geteuid() == 0) {
fOkSwitch = TRUE;
uid = getuid();
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 {
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 (strcmp(pw->pw_name, pw2->pw_name) == 0) {
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;
}
}
}
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;
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;
if (fOkSwitch && SETUID_NEEDS_BELOW_OWNER_HOME) {
cwd2 = getcwd(NULL, 1024);
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);
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);
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);
}
chdir(cwd2);
free(cwd2);
}
if (fOkSwitch && uid != 0 && gid != 0) {
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);
}
}
}
}
if (geteuid() == 0) {
uid = getuid();
gid = getgid();
#ifdef HAVE_SETEUID
seteuid(uid);
#else
setuid(uid);
#endif
#ifdef HAVE_SETEGID
setegid(uid);
#else
setgid(gid);
#endif
}
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);
}
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;
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 (strcmp(cpPort, "80") == 0)
cpPort = NULL;
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)));
pw = getpwuid(st.st_uid);
env = mysetenv(env, "SCRIPT_SRC_OWNER", "%s", pw->pw_name);
env = mysetenv(env, "VERSION_INTERPRETER", "%s", ePerl_WebID);
env = mysetenv(env, "VERSION_LANGUAGE", "Perl/%s", AC_perl_vers);
if (fPP) {
getcwd(cwd, MAXPATHLEN);
strcpy(sourcedir, source);
for (cp = sourcedir+strlen(sourcedir); cp > sourcedir && *cp != '/'; cp--)
;
*cp = NUL;
chdir(sourcedir);
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;
chdir(cwd);
}
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;
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);
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);
}
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);
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);
my_perl = perl_alloc();
perl_construct(my_perl);
myargc = 0;
myargv[myargc++] = progname;
if (fTaint)
myargv[myargc++] = "-T";
if (fWarn)
myargv[myargc++] = "-w";
for (i = 0; RememberedINC[i] != NULL; i++) {
myargv[myargc++] = "-I";
myargv[myargc++] = RememberedINC[i];
}
myargv[myargc++] = perlscript;
#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);
IO_restore_stdout();
IO_restore_stderr();
if ((cpBuf = ePerl_ReadErrorFile(perlstderr, perlscript, source)) != NULL) {
fprintf(stderr, cpBuf);
}
CU(EX_IOERR);
}
else {
fclose(er);
PrintError(mode, source, perlscript, perlstderr, "Perl parsing error (interpreter rc=%d)", rc);
CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
}
}
if (fCheck && mode == MODE_FILTER) {
fclose(er);
IO_restore_stdout();
IO_restore_stderr();
fprintf(stderr, "%s syntax OK\n", source);
CU(EX_OK);
}
cwd[0] = NUL;
if (!keepcwd) {
if (mode == MODE_FILTER)
getcwd(cwd, MAXPATHLEN);
strcpy(sourcedir, source);
for (cp = sourcedir+strlen(sourcedir); cp > sourcedir && *cp != '/'; cp--)
;
*cp = NUL;
chdir(sourcedir);
}
Perl5_SetRememberedScalars();
Perl5_ForceUnbufferedStdout();
rc = perl_run(my_perl);
fclose(out); out = NULL;
fclose(er); er = NULL;
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);
}
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);
IO_restore_stdout();
IO_restore_stderr();
if (mode == MODE_NPHCGI) {
HTTP_PrintResponseHeaders(cpOut);
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 (!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);
}
cp = getenv("REQUEST_METHOD");
if (! ((mode == MODE_CGI || mode == MODE_NPHCGI) &&
cp != NULL && strcmp(cp, "HEAD") == 0)) {
if (outputfile != NULL && strcmp(outputfile, "-") != 0) {
if (mode == MODE_FILTER && cwd[0] != NUL)
chdir(cwd);
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);
}
else {
fwrite(cpOut, nOut, 1, stdout);
fflush(stdout);
}
}
CUS:
if (my_perl) {
perl_destruct(my_perl);
perl_free(my_perl);
}
if (out)
fclose(out);
if (er)
fclose(er);
if (fp)
fclose(fp);
if (cpBuf)
free(cpBuf);
if (cpBuf2)
free(cpBuf2);
if (cpOut)
free(cpOut);
#ifndef DEBUG_ENABLED
if (*perlstderr != NUL)
unlink(perlstderr);
if (*perlstdout != NUL)
unlink(perlstdout);
if (*perlscript != NUL)
unlink(perlscript);
#endif
myexit(EXRC);
return EXRC;
}