PERFORCE change 12586 for review

Change 12586 by pudge@pudge-mobile on 2001/10/22 19:42:04

	Integrate with maintperl.

Affected files ...

... //depot/maint-5.6/macperl/win32/bin/pl2bat.pl#2 integrate
... //depot/maint-5.6/macperl/win32/win32.c#4 integrate

Differences ...

==== //depot/maint-5.6/macperl/win32/bin/pl2bat.pl#2 (text) ====
Index: perl/win32/bin/pl2bat.pl
--- perl/win32/bin/pl2bat.pl.~1~	Mon Oct 22 13:45:06 2001
+++ perl/win32/bin/pl2bat.pl	Mon Oct 22 13:45:06 2001
@@ -13,7 +13,7 @@
    or:  $0 [-w] [-u] [-n ntargs] [-o otherargs] [-s stripsuffix] [files]
         -n ntargs       arguments to invoke perl with in generated file
                             when run from Windows NT.  Defaults to
-                            '-x -S "%0" %*'.
+                            '-x -S %0 %*'.
         -o otherargs    arguments to invoke perl with in generated file
                             other than when run from Windows NT.  Defaults
                             to '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'.
@@ -33,7 +33,8 @@
 
 my %OPT = ();
 warn($usage), exit(0) if !getopts('whun:o:a:s:',\%OPT) or $OPT{'h'};
-$OPT{'n'} = '-x -S "%0" %*' unless exists $OPT{'n'};
+# NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate
+$OPT{'n'} = '-x -S %0 %*' unless exists $OPT{'n'};
 $OPT{'o'} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $OPT{'o'};
 $OPT{'s'} = '/\\.plx?/' unless exists $OPT{'s'};
 $OPT{'s'} = ($OPT{'s'} =~ m#^/([^/]*[^/\$]|)\$?/?$# ? $1 : "\Q$OPT{'s'}\E");
@@ -316,7 +317,7 @@
 =item B<-n> I<ntargs>
 
 Arguments to invoke perl with in generated batch file when run from
-Windows NT (or Windows 98, probably).  Defaults to S<'-x -S "%0" %*'>.
+Windows NT (or Windows 98, probably).  Defaults to S<'-x -S %0 %*'>.
 
 =item B<-o> I<otherargs>
 

==== //depot/maint-5.6/macperl/win32/win32.c#4 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c.~1~	Mon Oct 22 13:45:06 2001
+++ perl/win32/win32.c	Mon Oct 22 13:45:06 2001
@@ -609,12 +609,27 @@
 	strcpy(cmd2, cmd);
 	a = argv;
 	for (s = cmd2; *s;) {
+	    bool in_quotes = FALSE;
 	    while (*s && isSPACE(*s))
 		s++;
 	    if (*s)
 		*(a++) = s;
-	    while (*s && !isSPACE(*s))
-		s++;
+	    while (*s) {
+		/* ignore doubled backslashes, or backslash+quote */
+		if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) {
+		    s += 2;
+		}
+		/* keep track of when we're within quotes */
+		else if (*s == '"') {
+		    s++;
+		    in_quotes = !in_quotes;
+		}
+		/* break it up only at spaces that aren't in quotes */
+		else if (!in_quotes && isSPACE(*s))
+		    break;
+		else
+		    s++;
+	    }
 	    if (*s)
 		*s++ = '\0';
 	}
@@ -3012,26 +3027,94 @@
 
 
 static char *
-create_command_line(const char* command, const char * const *args)
+create_command_line(const char * const *args)
 {
     dTHXo;
-    int index;
-    char *cmd, *ptr, *arg;
-    STRLEN len = strlen(command) + 1;
+    int index, argc;
+    char *cmd, *ptr;
+    const char *arg;
+    STRLEN len = 0;
+    bool cmd_shell = FALSE;
+    bool extra_quotes = FALSE;
+
+    /* The NT cmd.exe shell has the following peculiarity that needs to be
+     * worked around.  It strips a leading and trailing dquote when any
+     * of the following is true:
+     *    1. the /S switch was used
+     *    2. there are more than two dquotes
+     *    3. there is a special character from this set: &<>()@^|
+     *    4. no whitespace characters within the two dquotes
+     *    5. string between two dquotes isn't an executable file
+     * To work around this, we always add a leading and trailing dquote
+     * to the string, if the first argument is either "cmd.exe" or "cmd",
+     * and there were at least two or more arguments passed to cmd.exe
+     * (not including switches).
+     */
+    if (args[0]
+	&& (stricmp(args[0], "cmd.exe") == 0
+	    || stricmp(args[0], "cmd") == 0))
+    {
+	cmd_shell = TRUE;
+	len += 3;
+    }
 
-    for (index = 0; (ptr = (char*)args[index]) != NULL; ++index)
-	len += strlen(ptr) + 1;
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "Args "));
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+	STRLEN curlen = strlen(arg);
+	if (!(arg[0] == '"' && arg[curlen-1] == '"'))
+	    len += 2;	/* assume quoting needed (worst case) */
+	len += curlen + 1;
+	DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg));
+    }
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
 
+    argc = index;
     New(1310, cmd, len, char);
     ptr = cmd;
-    strcpy(ptr, command);
 
     for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
-	ptr += strlen(ptr);
-	*ptr++ = ' ';
+	bool do_quote = 0;
+	STRLEN curlen = strlen(arg);
+
+	/* we want to protect arguments with spaces with dquotes,
+	 * but only if they aren't already there */
+	if (!(arg[0] == '"' && arg[curlen-1] == '"')) {
+	    STRLEN i = 0;
+	    while (i < curlen) {
+		if (isSPACE(arg[i])) {
+		    do_quote = 1;
+		    break;
+		}
+		i++;
+	    }
+	}
+
+	if (do_quote)
+	    *ptr++ = '"';
+
 	strcpy(ptr, arg);
+	ptr += curlen;
+
+	if (do_quote)
+	    *ptr++ = '"';
+
+	if (args[index+1])
+	    *ptr++ = ' ';
+
+    	if (cmd_shell && !extra_quotes
+	    && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0)
+	    && (argc-1 > index+1))   /* two or more arguments to cmd.exe? */
+	{
+	    *ptr++ = '"';
+	    extra_quotes = TRUE;
+	}
     }
 
+    if (extra_quotes)
+	*ptr++ = '"';
+
+    *ptr = '\0';
+
     return cmd;
 }
 
@@ -3194,8 +3277,7 @@
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
 
-    char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0
-			     	             ? &argv[1] : argv);
+    char *cmd = create_command_line(argv);
     char *fullcmd = Nullch;
 
     env = PerlEnv_get_childenv();
@@ -3242,6 +3324,8 @@
 	create |= CREATE_NEW_CONSOLE;
     }
 
+    DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n",
+			  cmdname,cmd));
 RETRY:
     if (!CreateProcess(cmdname,		/* search PATH to find executable */
 		       cmd,		/* executable, and its arguments */
@@ -3264,6 +3348,9 @@
 	    fullcmd = qualified_path(cmdname);
 	    if (fullcmd) {
 		cmdname = fullcmd;
+		DEBUG_p(PerlIO_printf(Perl_debug_log,
+				      "Retrying [%s] with same args\n",
+				      cmdname));
 		goto RETRY;
 	    }
 	}
End of Patch.

• PERFORCE change 12586 for review by Chris Nandor