NetWare update from Ananth Kesari.

p4raw-id: //depot/perl@17376

5 files changed, 165 insertions, 30 deletions

diff --git a/NetWare/Makefile b/NetWare/Makefile
index 21136d86f7..8ae8f50d8c 100644
--- a/NetWare/Makefile
+++ b/NetWare/Makefile
@@ -360,8 +360,8 @@ EXTENSION_NLM	= 		\
 
 # Begin - Following is required to build NetWare specific extensions CGI2Perl, Perl2UCS and UCSExt
 CGI2PERL		= CGI2Perl\CGI2Perl
-PERL2UCS		= $(EXTDIR)\Perl2UCS\Perl2UCS
-UCSExt			= $(EXTDIR)\Perl2UCS\UCSExt
+PERL2UCS		= Perl2UCS\Perl2UCS
+UCSExt			= Perl2UCS\UCSExt
 
 CGI2PERL_NLM = \CGI2Perl\CGI2Perl.NLM
 PERL2UCS_NLM = $(AUTODIR)\Perl2UCS\Perl2UCS.NLM
@@ -1375,7 +1375,7 @@ $(CGI2PERL_NLM):
 
 $(PERL2UCS_NLM):
 !if "$(NW_EXTNS)"=="yes"
-	cd $(EXTDIR)\$(*B)
+	cd $(*B)
 	..\..\miniperl -I..\..\lib Makefile.PL "CCCDLFLAGS=-bool on -lang c++" PERL_CORE=1 INSTALLDIRS=perl
 	$(MAKE)
 	cd ..\..\netware
@@ -1383,7 +1383,7 @@ $(PERL2UCS_NLM):
 
 $(UCSExt_NLM):
 !if "$(NW_EXTNS)"=="yes"
-	cd $(EXTDIR)\$(*B)
+	cd $(*B)
 	..\..\miniperl -I..\..\lib Makefile.PL "CCCDLFLAGS=-bool on -lang c++" PERL_CORE=1 INSTALLDIRS=perl
 	$(MAKE)
 	cd ..\..\netware
@@ -1464,10 +1464,10 @@ distclean: clean nwclean
 	cd cgi2perl
 	-del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.def *.lib *.pdb
 	cd ..
-	cd $(EXTDIR)\Perl2UCS
+	cd Perl2UCS
 	-del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.def *.lib *.pdb
 	cd ..\..\netware
-	cd $(EXTDIR)\UCSExt
+	cd UCSExt
 	-del /f /q *.obj *.bs Makefile *$(o) *.c pm_to_blib *.xdc *.err *.sym *.map *.c
 	cd ..\..\netware
 !endif
diff --git a/NetWare/netware.h b/NetWare/netware.h
index 6f65560cbd..18089d58d5 100644
--- a/NetWare/netware.h
+++ b/NetWare/netware.h
@@ -49,6 +49,9 @@ struct tms {
 struct interp_intern {
     void *	internal_host;
     long	perlshell_items;	// For system() ;  Ananth, 3 Sept 2001
+
+    char *	perlshell_tokens;	// For system() ; From Win32 of Perl 5.8 on 24 June 2002
+    char **	perlshell_vec;	// For system() ; From Win32 of Perl 5.8 on 24 June 2002
 };
 
 /*
@@ -69,6 +72,9 @@ typedef u_int           SOCKET;
 #define nw_internal_host		(PL_sys_intern.internal_host)
 #define nw_perlshell_items	(PL_sys_intern.perlshell_items)		// For system() ;  Ananth, 3 Sept 2001
 
+#define nw_perlshell_tokens	(PL_sys_intern.perlshell_tokens)	// For system() ; From Win32 of Perl 5.8 on 24 June 2002
+#define nw_perlshell_vec	(PL_sys_intern.perlshell_vec)	// For system() ; From Win32 of Perl 5.8 on 24 June 2002
+
 EXTERN_C void	Perl_nw5_init(int *argcp, char ***argvp);
 
 #define PTHREAD_ATFORK(prepare,parent,child)	NOOP
diff --git a/NetWare/nw5.c b/NetWare/nw5.c
index fa57c6ea79..488111ce94 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:
 
@@ -917,7 +922,8 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
 	return -1;
 
 	nw_perlshell_items = 0;	// No Shell
-    New(1306, argv, (sp - mark) + nw_perlshell_items + 3, char*);
+//    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;
@@ -944,10 +950,9 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
 			   (char*)(really ? SvPV_nolen(really) : argv[0]),
 			   (char**)argv);
 
-
     if (flag != P_NOWAIT) {
 	if (status < 0) {
-    	    dTHR;
+//   	    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;
@@ -967,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
diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index 2bed9915e6..05fe3f7c65 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -237,6 +237,7 @@ sub bootstrap {
     # It may also edit @modparts if required.
     $modfname = &mod2fname(\@modparts) if defined &mod2fname;
 
+    # Truncate the module name to 8.3 format for NetWare
 	if (($^O eq 'NetWare') && (length($modfname) > 8)) {
 		$modfname = substr($modfname, 0, 8);
 	}
@@ -262,22 +263,13 @@ sub bootstrap {
 	} else {
 	    $dir = "$_/auto/$modpname";
 	}
-	if ($^O ne 'NetWare') {
-		next unless -d $dir; # skip over uninteresting directories
-	}
-	else {
-		next if -f $dir; # skip over uninteresting directories
-	}
-
+	
+	next unless -d $dir; # skip over uninteresting directories
+	
 	# check for common cases to avoid autoload of dl_findfile
 	my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext";
-	if ($^O ne 'NetWare') {
-		last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);
-	}
-	elsif (!(-d $try)) {
-		last if $file = ($do_expand) ? dl_expandspec($try) : ($try);
-	}
-
+	last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);
+	
 	# no luck here, save dir for possible later dl_findfile search
 	push @dirs, $dir;
     }
diff --git a/lib/ExtUtils/MM_NW5.pm b/lib/ExtUtils/MM_NW5.pm
index 03a565fb95..a91e09b595 100644
--- a/lib/ExtUtils/MM_NW5.pm
+++ b/lib/ExtUtils/MM_NW5.pm
@@ -124,10 +124,10 @@ XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\"
     # Copy this to makefile as INCLUDE = d:\...;d:\;
     (my $inc = $Config{'incpath'}) =~ s/([ ]*)-I/;/g;
 
-    # Get the additional include path and append to INCLUDE, keeping it
-    # in INC will give problems during compilation, hence reset it
-    # after getting the value
-    $self->{INC} = '';
+    # Get the additional include path from the user through the command prompt
+    # and append to INCLUDE
+#    $self->{INC} = '';
+    push @m, "INC = $self->{'INC'}\n";
 
     push @m, qq{
 INCLUDE = $inc;