/*
- * Copyright © 2001 Novell, Inc. All Rights Reserved.
+ * Copyright © 2001 Novell, Inc. All Rights Reserved.
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#define P_NOWAIT 1
#endif
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+#define EXECF_SPAWN_NOWAIT 3
+
+static BOOL has_shell_metachars(char *ptr);
+
// The array is used to store pointer to the memory allocated to the TempPipeFile structure everytime
// a call to the function, nw_Popen. If a simple variable is used, everytime the memory is allocated before
// the previously allocated memory is freed, the pointer will get overwritten and the previous memory allocations
int iPopenCount = 0;
FILE* File1[MAX_PIPE_RECURSION] = {'\0'};
-
/**
General:
int
nw_setmode(FILE *fp, int mode)
{
+/**
+ // Commented since a few abends were happening in fnFpSetMode
int *dummy = 0;
return(fnFpSetMode(fp, mode, dummy));
+**/
+
+ int handle = -1;
+ errno = 0;
+
+ handle = fileno(fp);
+ if (errno)
+ {
+ errno = 0;
+ return -1;
+ }
+ return setmode(handle, mode);
}
int
nw_telldir(DIR *dirp)
{
dTHX;
- Perl_croak(aTHX_ "telldir function is not implemented");
+ Perl_croak(aTHX_ "The telldir() function is not implemented on NetWare\n");
return 0l;
}
dTHR;
return des_fcrypt(txt, salt, w32_crypt_buffer);
#else
- Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
- return Nullch;
+ Perl_croak(aTHX_ "The crypt() function is not implemented on NetWare\n");
+ return NULL;
#endif
}
int
nw_flock(int fd, int oper)
{
+ dTHX;
+ Perl_croak(aTHX_ "The flock() function is not implemented on NetWare\n");
return 0;
}
}
DIR *
-nw_opendir(char *filename)
+nw_opendir(const char *filename)
{
char *buff = NULL;
int len = 0;
va_end(ap);
if (stricmp(path, "/dev/null")==0)
- path = "NUL";
+ path = "NWNUL";
return open(path, flag, pmode);
}
nw_rewinddir(DIR *dirp)
{
dTHX;
- Perl_croak(aTHX_ "rewinddir function is not implemented");
+ Perl_croak(aTHX_ "The rewinddir() function is not implemented on NetWare\n");
}
void
nw_seekdir(DIR *dirp, long loc)
{
dTHX;
- Perl_croak(aTHX_ "seekdir function is not implemented");
+ Perl_croak(aTHX_ "The seekdir() function is not implemented on NetWare\n");
}
int *
void
sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
{
-
+ PERL_ARGS_ASSERT_SYS_INTERN_DUP;
}
#endif /* HAVE_INTERP_INTERN */
// Some more functions:
-char *
-nw_get_sitelib(const char *pl)
-{
- return (NULL);
-}
-
int
execv(char *cmdname, char **argv)
{
// This feature needs to be implemented.
// _asm is commented out since it goes into the internal debugger.
// _asm {int 3};
- return(0);
+//// return(0);
+
+
+ // This below code is required for system() call.
+ // Otherwise system() does not work on NetWare.
+ // Ananth, 3 Sept 2001
+
+ dTHX;
+ SV *really = (SV*)vreally;
+ SV **mark = (SV**)vmark;
+ SV **sp = (SV**)vsp;
+ char **argv;
+ char *str;
+ int status;
+ int flag = P_WAIT;
+ int index = 0;
+
+
+ if (sp <= mark)
+ return -1;
+
+ nw_perlshell_items = 0; // No Shell
+// Newx(argv, (sp - mark) + nw_perlshell_items + 3, char*); // In the old code of 5.6.1
+ Newx(argv, (sp - mark) + nw_perlshell_items + 2, char*);
+
+ if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
+ ++mark;
+ flag = SvIVx(*mark);
+ }
+
+ while (++mark <= sp) {
+ if (*mark && (str = (char *)SvPV_nolen(*mark)))
+ {
+ argv[index] = str;
+ index++;
+ }
+ else
+ {
+ argv[index] = "";
+// argv[index] = '\0';
+ index++;
+ }
+ }
+ argv[index] = '\0';
+ index++;
+
+ status = nw_spawnvp(flag,
+ (char*)(really ? SvPV_nolen(really) : argv[0]),
+ (char**)argv);
+
+ if (flag != P_NOWAIT) {
+ if (status < 0) {
+// dTHR; // Only in old code of 5.6.1
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno));
+ status = 255 * 256;
+ }
+ else
+ status *= 256;
+ PL_statusvalue = status;
+ }
+
+ Safefree(argv);
+ return (status);
}
int
// This feature needs to be implemented.
// _asm is commented out since it goes into the internal debugger.
// _asm {int 3};
- return(0);
+//// return(0);
+
+ // Below added to make system() work for NetWare
+
+ dTHX;
+ char **a;
+ char *s;
+ char **argv;
+ int status = -1;
+ BOOL needToTry = TRUE;
+ char *cmd2;
+
+ /* Save an extra exec if possible. See if there are shell
+ * metacharacters in it */
+ if (!has_shell_metachars(cmd)) {
+ Newx(argv, strlen(cmd) / 2 + 2, char*);
+ Newx(cmd2, strlen(cmd) + 1, char);
+ strcpy(cmd2, cmd);
+ a = argv;
+ for (s = cmd2; *s;) {
+ while (*s && isSPACE(*s))
+ s++;
+ if (*s)
+ *(a++) = s;
+ while (*s && !isSPACE(*s))
+ s++;
+ if (*s)
+ *s++ = '\0';
+ }
+ *a = NULL;
+ if (argv[0]) {
+ switch (exectype) {
+ case EXECF_SPAWN:
+ status = nw_spawnvp(P_WAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_SPAWN_NOWAIT:
+ status = nw_spawnvp(P_NOWAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_EXEC:
+ status = nw_execvp(argv[0], (char **)argv);
+ break;
+ }
+ if (status != -1 || errno == 0)
+ needToTry = FALSE;
+ }
+ Safefree(argv);
+ Safefree(cmd2);
+ }
+
+ if (needToTry) {
+ char **argv = NULL;
+ int i = -1;
+
+ Newx(argv, nw_perlshell_items + 2, char*);
+ while (++i < nw_perlshell_items)
+ argv[i] = nw_perlshell_vec[i];
+ argv[i++] = cmd;
+ argv[i] = NULL;
+ switch (exectype) {
+ case EXECF_SPAWN:
+ status = nw_spawnvp(P_WAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_SPAWN_NOWAIT:
+ status = nw_spawnvp(P_NOWAIT, argv[0], (char **)argv);
+ break;
+
+ case EXECF_EXEC:
+ status = nw_execvp(argv[0], (char **)argv);
+ break;
+ }
+ cmd = argv[0];
+ Safefree(argv);
+ }
+
+ if (exectype != EXECF_SPAWN_NOWAIT) {
+ if (status < 0) {
+ dTHR;
+ if (ckWARN(WARN_EXEC))
+ Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s",
+ (exectype == EXECF_EXEC ? "exec" : "spawn"),
+ cmd, strerror(errno));
+ status = 255 * 256;
+ }
+ else
+ status *= 256;
+ PL_statusvalue = status;
+ }
+ return (status);
}
int
do_spawn(char *cmd)
{
- return do_spawn2(cmd, 2);
+ return do_spawn2(cmd, EXECF_SPAWN);
+}
+
+// Added to make system() work for NetWare
+static BOOL
+has_shell_metachars(char *ptr)
+{
+ int inquote = 0;
+ char quote = '\0';
+
+ /*
+ * Scan string looking for redirection (< or >) or pipe
+ * characters (|) that are not in a quoted string.
+ * Shell variable interpolation (%VAR%) can also happen inside strings.
+ */
+ while (*ptr) {
+ switch(*ptr) {
+ case '%':
+ return TRUE;
+ case '\'':
+ case '\"':
+ if (inquote) {
+ if (quote == *ptr) {
+ inquote = 0;
+ quote = '\0';
+ }
+ }
+ else {
+ quote = *ptr;
+ inquote++;
+ }
+ break;
+ case '>':
+ case '<':
+ case '|':
+ if (!inquote)
+ return TRUE;
+ default:
+ break;
+ }
+ ++ptr;
+ }
+ return FALSE;
}
int
return 0;
}
+
+// added to remove undefied symbol error in CodeWarrior compilation
+int
+Perl_Ireentrant_buffer_ptr(aTHX)
+{
+ return 0;
+}
https://perl5.git.perl.org / perl5.git / blobdiff