X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/acfe0abcedaf592fb4b9cb69ce3468308ae99d91..f2f78491bc610222b437dc1912ed4ab18db55da8:/NetWare/nw5.c diff --git a/NetWare/nw5.c b/NetWare/nw5.c index 44bb853..aac8031 100644 --- a/NetWare/nw5.c +++ b/NetWare/nw5.c @@ -31,6 +31,12 @@ #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 @@ -44,7 +50,6 @@ PTEMPPIPEFILE ptpf1[MAX_PIPE_RECURSION] = {'\0'}; int iPopenCount = 0; FILE* File1[MAX_PIPE_RECURSION] = {'\0'}; - /** General: @@ -104,8 +109,22 @@ nw_setbuf(FILE *pf, char *buf) 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 @@ -212,7 +231,7 @@ long 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; } @@ -298,7 +317,7 @@ nw_crypt(const char *txt, const char *salt) dTHR; return des_fcrypt(txt, salt, w32_crypt_buffer); #else - Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia."); + Perl_croak(aTHX_ "The crypt() function is not implemented on NetWare\n"); return Nullch; #endif } @@ -394,6 +413,8 @@ nw_fileno(FILE *pf) int nw_flock(int fd, int oper) { + dTHX; + Perl_croak(aTHX_ "The flock() function is not implemented on NetWare\n"); return 0; } @@ -546,7 +567,7 @@ nw_rmdir(const char *dir) } DIR * -nw_opendir(char *filename) +nw_opendir(const char *filename) { char *buff = NULL; int len = 0; @@ -580,7 +601,7 @@ nw_open(const char *path, int flag, ...) va_end(ap); if (stricmp(path, "/dev/null")==0) - path = "NUL"; + path = "NWNUL"; return open(path, flag, pmode); } @@ -753,7 +774,7 @@ void 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 @@ -767,7 +788,7 @@ 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 * @@ -879,7 +900,70 @@ do_aspawn(void *vreally, void **vmark, void **vsp) // 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 @@ -888,13 +972,145 @@ do_spawn2(char *cmd, int exectype) // 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 = Nullch; + 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] = Nullch; + 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 @@ -903,3 +1119,10 @@ fork(void) return 0; } + +// added to remove undefied symbol error in CodeWarrior compilation +int +Perl_Ireentrant_buffer_ptr(aTHX) +{ + return 0; +}