eperl
view release on metacpan or search on metacpan
eperl_main.c view on Meta::CPAN
void give_version(void)
{
fprintf(stdout, "%s\n", ePerl_Hello);
fprintf(stdout, "\n");
fprintf(stdout, "Copyright (c) 1996,1997,1998 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;
eperl_main.c view on Meta::CPAN
/* 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 (strcmp(cpPort, "80") == 0)
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_WebID);
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);
( run in 0.810 second using v1.01-cache-2.11-cpan-39bf76dae61 )