*** /dev/null Fri Apr 19 19:55:00 2024
--- - Fri Apr 19 19:55:56 2024
***************
*** 0 ****
--- 1,438 ----
+ /*
+ ** ____ _
+ ** ___| _ \ ___ _ __| |
+ ** / _ \ |_) / _ \ '__| |
+ ** | __/ __/ __/ | | |
+ ** \___|_| \___|_| |_|
+ **
+ ** 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_sys.c -- ePerl system functions
+ */
+
+ #include "eperl_config.h"
+ #include "eperl_global.h"
+ #include "eperl_proto.h"
+
+
+ /*
+ **
+ ** own setenv() function which works with Perl
+ **
+ */
+
+ extern char **environ;
+
+ char **mysetenv(char **env, char *var, char *str, ...)
+ {
+ va_list ap;
+ char ca[1024];
+ char ca2[1024];
+ char *cp;
+ int i;
+ char **envN;
+ static int stillcalled = FALSE;
+ int replaced = FALSE;
+
+ /* create the key=val string */
+ va_start(ap, str);
+ vsprintf(ca, str, ap);
+ va_end(ap);
+ sprintf(ca2, "%s=%s", var, ca);
+ cp = strdup(ca2);
+
+ /* now duplicate the old structure */
+ for (i = 0; env[i] != NULL; i++)
+ ;
+ if ((envN = (char **)malloc(sizeof(char *) * (i+2))) == NULL)
+ return environ;
+ for (i = 0; env[i] != NULL; i++) {
+ if (!replaced && (strncmp(env[i], var, strlen(var)) == 0)) {
+ envN[i] = cp;
+ replaced = TRUE;
+ }
+ else
+ envN[i] = env[i];
+ }
+
+ /* add the new entry if not replaced */
+ if (!replaced)
+ envN[i++] = cp;
+ envN[i] = NULL;
+
+ /* set the libc/exec variable which Perl uses */
+ if (stillcalled)
+ free(environ);
+ stillcalled = TRUE;
+ environ = envN;
+
+ return envN;
+ }
+
+
+ /*
+ **
+ ** I/O handle redirection
+ **
+ */
+
+ #define HANDLE_STDIN 0
+ #define HANDLE_STDOUT 1
+ #define HANDLE_STDERR 2
+ #define HANDLE_STORE_STDIN 10
+ #define HANDLE_STORE_STDOUT 11
+ #define HANDLE_STORE_STDERR 12
+
+ static int IO_redirected_stdin = FALSE;
+ static int IO_redirected_stdout = FALSE;
+ static int IO_redirected_stderr = FALSE;
+
+ void IO_redirect_stdin(FILE *fp)
+ {
+ if (IO_redirected_stdin)
+ IO_restore_stdin();
+
+ /* first copy the current stdin to the store handle */
+ (void)dup2(HANDLE_STDIN, HANDLE_STORE_STDIN);
+
+ /* then copy the new handle to stdin */
+ (void)dup2(fileno(fp), HANDLE_STDIN);
+
+ /* and remember the fact */
+ IO_redirected_stdin = TRUE;
+ }
+
+ void IO_redirect_stdout(FILE *fp)
+ {
+ if (IO_redirected_stdout)
+ IO_restore_stdout();
+
+ /* first copy the current stdout to the store handle */
+ (void)dup2(HANDLE_STDOUT, HANDLE_STORE_STDOUT);
+
+ /* then copy the new handle to stdout */
+ (void)dup2(fileno(fp), HANDLE_STDOUT);
+
+ /* and remember the fact */
+ IO_redirected_stdout = TRUE;
+ }
+
+ void IO_redirect_stderr(FILE *fp)
+ {
+ if (IO_redirected_stderr)
+ IO_restore_stderr();
+
+ /* first copy the current stderr to the store handle */
+ (void)dup2(HANDLE_STDERR, HANDLE_STORE_STDERR);
+
+ /* then copy the new handle to stderr */
+ (void)dup2(fileno(fp), HANDLE_STDERR);
+
+ /* and remember the fact */
+ IO_redirected_stderr = TRUE;
+ }
+
+ int IO_is_stdin_redirected(void)
+ {
+ return IO_redirected_stdin;
+ }
+
+ int IO_is_stdout_redirected(void)
+ {
+ return IO_redirected_stdout;
+ }
+
+ int IO_is_stderr_redirected(void)
+ {
+ return IO_redirected_stderr;
+ }
+
+ void IO_restore_stdin(void)
+ {
+ if (IO_redirected_stdin) {
+ dup2(HANDLE_STORE_STDIN, HANDLE_STDIN);
+ IO_redirected_stdin = FALSE;
+ }
+ }
+
+ void IO_restore_stdout(void)
+ {
+ if (IO_redirected_stdout) {
+ dup2(HANDLE_STORE_STDOUT, HANDLE_STDOUT);
+ IO_redirected_stdout = FALSE;
+ }
+ }
+
+ void IO_restore_stderr(void)
+ {
+ if (IO_redirected_stderr) {
+ dup2(HANDLE_STORE_STDERR, HANDLE_STDERR);
+ IO_redirected_stderr = FALSE;
+ }
+ }
+
+
+ /*
+ **
+ ** Temporary filename support
+ **
+ */
+
+ static char *mytmpfiles[100] = { NULL };
+ static int mytmpfilecnt = 0;
+
+ char *mytmpfile(char *id)
+ {
+ char ca[1024];
+ char *cp, *tmpdir;
+ int i;
+
+ if ((tmpdir = getenv("TMPDIR")) == NULL)
+ tmpdir = "/tmp";
+ sprintf(ca, "%s/%s.%d.tmp%d", tmpdir, id, (int)getpid(), mytmpfilecnt++);
+ cp = strdup(ca);
+ for (i = 0; mytmpfiles[i] != NULL; i++)
+ ;
+ mytmpfiles[i++] = cp;
+ mytmpfiles[i] = NULL;
+ return cp;
+ }
+
+ void remove_mytmpfiles(void)
+ {
+ int i;
+
+ for (i = 0; mytmpfiles[i] != NULL; i++) {
+ unlink(mytmpfiles[i]);
+ }
+ }
+
+
+ /*
+ **
+ ** ISO time
+ **
+ */
+
+ char *isotime(time_t *t)
+ {
+ struct tm *tm;
+ char timestr[128];
+
+ tm = localtime(t);
+ sprintf(timestr, "%02d-%02d-%04d %02d:%02d",
+ tm->tm_mday, tm->tm_mon+1, tm->tm_year+1900,
+ tm->tm_hour, tm->tm_min);
+ return strdup(timestr);
+ }
+
+
+ /*
+ **
+ ** read source file into internal buffer
+ **
+ */
+ char *ePerl_ReadSourceFile(char *filename, char **cpBufC, int *nBufC)
+ {
+ char *rc;
+ FILE *fp = NULL;
+ char *cpBuf = NULL;
+ int nBuf;
+ char tmpfile[256], *ptr_tmpfile;
+ int usetmp = 0;
+ int c;
+
+ if (stringEQ(filename, "-")) {
+ /* file is given on stdin */
+ ptr_tmpfile = mytmpfile("ePerl.source");
+ stcpy(tmpfile, ptr_tmpfile);
+ if ((fp = fopen(tmpfile, "w")) == NULL) {
+ ePerl_SetError("Cannot open temporary source file %s for writing", tmpfile);
+ CU(NULL);
+ }
+ nBuf = 0;
+ while ((c = fgetc(stdin)) != EOF) {
+ fprintf(fp, "%c", c);
+ }
+ fclose(fp);
+ fp = NULL;
+ filename = tmpfile;
+ usetmp = 1;
+ }
+
+ if ((fp = fopen(filename, "r")) == NULL) {
+ ePerl_SetError("Cannot open source file %s for reading", filename);
+ CU(NULL);
+ }
+ fseek(fp, 0, SEEK_END);
+ nBuf = ftell(fp);
+ if (nBuf == 0) {
+ cpBuf = (char *)malloc(sizeof(char) * 1);
+ *cpBuf = NUL;
+ }
+ else {
+ if ((cpBuf = (char *)malloc(sizeof(char) * nBuf+1)) == NULL) {
+ ePerl_SetError("Cannot allocate %d bytes of memory", nBuf);
+ CU(NULL);
+ }
+ fseek(fp, 0, SEEK_SET);
+ if (fread(cpBuf, nBuf, 1, fp) == 0) {
+ ePerl_SetError("Cannot read from file %s", filename);
+ CU(NULL);
+ }
+ cpBuf[nBuf] = '\0';
+ }
+ *cpBufC = cpBuf;
+ *nBufC = nBuf;
+ RETURN_WVAL(cpBuf);
+
+ CUS:
+ if (cpBuf)
+ free(cpBuf);
+ if (fp)
+ fclose(fp);
+ if (usetmp)
+ unlink(tmpfile);
+ RETURN_EXRC;
+ }
+
+ /*
+ **
+ ** read an error file to internal buffer and substitute the filename
+ **
+ */
+ char *ePerl_ReadErrorFile(char *filename, char *scriptfile, char *scripturl)
+ {
+ char *rc;
+ FILE *fp = NULL;
+ char *cpBuf = NULL;
+ int nBuf;
+ char *cp;
+
+ if ((fp = fopen(filename, "r")) == NULL) {
+ ePerl_SetError("Cannot open error file %s for reading", filename);
+ CU(NULL);
+ }
+ fseek(fp, 0, SEEK_END);
+ nBuf = ftell(fp);
+ if ((cpBuf = (char *)malloc(sizeof(char) * nBuf * 2)) == NULL) {
+ ePerl_SetError("Cannot allocate %d bytes of memory", nBuf * 2);
+ CU(NULL);
+ }
+ fseek(fp, 0, SEEK_SET);
+ if (fread(cpBuf, nBuf, 1, fp) == 0) {
+ ePerl_SetError("Cannot read from file %s", filename);
+ CU(NULL);
+ }
+ cpBuf[nBuf] = '\0';
+ for (cp = cpBuf; cp < cpBuf+nBuf; ) {
+ if ((cp = strstr(cp, scriptfile)) != NULL) {
+ #ifdef HAVE_MEMMOVE
+ (void)memmove(cp+strlen(scripturl), cp+strlen(scriptfile), strlen(cp+strlen(scriptfile))+1);
+ #else
+ (void)bcopy(cp+strlen(scriptfile), cp+strlen(scripturl), strlen(cp+strlen(scriptfile))+1);
+ #endif
+ (void)memcpy(cp, scripturl, strlen(scripturl));
+ cp += strlen(scripturl);
+ continue;
+ }
+ break;
+ }
+ RETURN_WVAL(cpBuf);
+
+ CUS:
+ if (cpBuf)
+ free(cpBuf);
+ if (fp)
+ fclose(fp);
+ RETURN_EXRC;
+ }
+
+ /*
+ **
+ ** path support
+ **
+ */
+
+ char *filename(char *path)
+ {
+ static char file[MAXPATHLEN];
+ char *cp;
+
+ if (path[strlen(path)-1] == '/')
+ return "";
+ else {
+ for (cp = path+strlen(path); cp > path && *(cp-1) != '/'; cp--)
+ ;
+ if (cp == path+1)
+ cp--;
+ strcpy(file, cp);
+ return file;
+ }
+ }
+
+ char *dirname(char *path)
+ {
+ static char dir[MAXPATHLEN];
+ char *cp;
+
+ if (path[strlen(path)-1] == '/')
+ return path;
+ else {
+ strcpy(dir, path);
+ for (cp = dir+strlen(dir); cp > dir && *(cp-1) != '/'; cp--)
+ ;
+ *cp = NUL;
+ return dir;
+ }
+ }
+
+ char *abspath(char *path)
+ {
+ static char apath[MAXPATHLEN];
+ static char cwd[MAXPATHLEN];
+ char *cp;
+
+ if (path[0] == '/')
+ return path;
+ else {
+ /* remember current working dir */
+ getcwd(cwd, MAXPATHLEN);
+ /* determine dir of path */
+ cp = dirname(path);
+ chdir(cp);
+ getcwd(apath, MAXPATHLEN);
+ /* restore cwd */
+ chdir(cwd);
+ /* add file part again */
+ if (apath[strlen(apath)-1] != '/')
+ strcpy(apath+strlen(apath), "/");
+ strcpy(apath+strlen(apath), path);
+ return apath;
+ }
+ }
+
+ /*EOF*/
|
