X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=NetWare%2Fnw5.c;h=488111ce94f02afe40a0bbc29c5c3f4bb76b3be6;hb=2dfd8427393aecf9e4f0fdf1f999b249b467815c;hp=e32fdb6b2faf9a519fe1a0e6fb1bac0720407838;hpb=2986a63f7e513cf37f46db9f211b77071260031f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/NetWare/nw5.c b/NetWare/nw5.c index e32fdb6..488111c 100644 --- a/NetWare/nw5.c +++ b/NetWare/nw5.c @@ -17,7 +17,7 @@ -#include // For dTHXo, etc. +#include // For dTHX, etc. #include "nwpipe.h" @@ -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 @@ -211,8 +230,8 @@ nw_stdout() long nw_telldir(DIR *dirp) { - dTHXo; - Perl_croak(aTHX_ "telldir function is not implemented"); + dTHX; + Perl_croak(aTHX_ "The telldir() function is not implemented on NetWare\n"); return 0l; } @@ -292,13 +311,13 @@ nw_write(int fd, const void *buf, unsigned int cnt) char * nw_crypt(const char *txt, const char *salt) { - dTHXo; + dTHX; #ifdef HAVE_DES_FCRYPT 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; } @@ -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); } @@ -752,8 +773,8 @@ nw_rename(const char *oname, const char *newname) void nw_rewinddir(DIR *dirp) { - dTHXo; - Perl_croak(aTHX_ "rewinddir function is not implemented"); + dTHX; + Perl_croak(aTHX_ "The rewinddir() function is not implemented on NetWare\n"); } void @@ -766,8 +787,8 @@ nw_rewind(FILE *pf) void nw_seekdir(DIR *dirp, long loc) { - dTHXo; - Perl_croak(aTHX_ "seekdir function is not implemented"); + dTHX; + Perl_croak(aTHX_ "The seekdir() function is not implemented on NetWare\n"); } int * @@ -838,6 +859,15 @@ Perl_nw5_init(int *argcp, char ***argvp) MALLOC_INIT; } +#ifdef USE_ITHREADS +PerlInterpreter * +perl_clone_host(PerlInterpreter* proto_perl, UV flags) +{ + // Perl Clone is not implemented on NetWare. + return NULL; +} +#endif + // Some more functions: char * @@ -870,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 +// New(1306, argv, (sp - mark) + nw_perlshell_items + 3, char*); // In the old code of 5.6.1 + New(1306, 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 @@ -879,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)) { + New(1301,argv, strlen(cmd) / 2 + 2, char*); + New(1302,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; + + New(1306, 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 @@ -894,3 +1119,10 @@ fork(void) return 0; } + +// added to remove undefied symbol error in CodeWarrior compilation +int +Perl_Ireentrant_buffer_ptr(aTHX) +{ + return 0; +}