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.
