diff options
| -rw-r--r-- | MANIFEST | 2 | ||||
| -rw-r--r-- | pod/perltodo.pod | 5 | ||||
| -rw-r--r-- | t/op/system.t | 134 | ||||
| -rw-r--r-- | t/op/system_tests | 110 | ||||
| -rw-r--r-- | win32/win32.c | 134 |
5 files changed, 343 insertions, 42 deletions
@@ -2202,6 +2202,8 @@ t/op/subst_amp.t See if $&-related substitution works t/op/subst_wamp.t See if substitution works with $& present t/op/sub_lval.t See if lvalue subroutines work t/op/sysio.t See if sysread and syswrite work +t/op/system.t See if system works +t/op/system_tests Test runner for system.t t/op/taint.t See if tainting works t/op/tie.t See if tie/untie functions work t/op/tiearray.t See if tie for arrays works diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 5fae97ac99..9ee1144b06 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -189,11 +189,6 @@ Have a way to introduce user-defined opcodes without the subroutine call overhead of an XSUB; the user should be able to create PP code. Simon Cozens has some ideas on this. -=head2 spawnvp() on Win32 - -Win32 has problems spawning processes, particularly when the arguments -to the child process contain spaces, quotes or tab characters. - =head2 DLL Versioning Windows needs a way to know what version of a XS or C<libperl> DLL it's diff --git a/t/op/system.t b/t/op/system.t new file mode 100644 index 0000000000..22dcd8bbfa --- /dev/null +++ b/t/op/system.t @@ -0,0 +1,134 @@ +#!perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + # XXX this could be further munged to enable some parts on other + # platforms + unless ($^O =~ /^MSWin/) { + print "1..0 # skipped: windows specific test\n"; + exit 0; + } +} + +use File::Path; +use File::Copy; +use Config; +use Cwd; +use strict; + +$| = 1; + +my $cwd = cwd(); + +my $testdir = "t e s t"; +my $exename = "showav"; +my $plxname = "showargv"; +rmtree($testdir); +mkdir($testdir); + +open(my $F, ">$testdir/$exename.c") + or die "Can't create $testdir/$exename.c: $!"; +print $F <<'EOT'; +#include <stdio.h> +int +main(int ac, char **av) +{ + int i; + for (i = 0; i < ac; i++) + printf("[%s]", av[i]); + printf("\n"); + return 0; +} +EOT + +open($F, ">$testdir/$plxname.bat") + or die "Can't create $testdir/$plxname.bat: $!"; +print $F <<'EOT'; +@rem = '--*-Perl-*-- +@echo off +if "%OS%" == "Windows_NT" goto WinNT +EOT + +print $F <<EOT; +"$^X" -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9 +goto endofperl +:WinNT +"$^X" -x -S %0 %* +EOT +print $F <<'EOT'; +if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl +if %errorlevel% == 9009 echo You do not have Perl in your PATH. +if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul +goto endofperl +@rem '; +#!perl +#line 15 +print "[$_]" for ($0, @ARGV); +print "\n"; +__END__ +:endofperl +EOT + +close $F; + +# build the executable +chdir($testdir); +END { + chdir($cwd); + rmtree($testdir); +} +if (open(my $EIN, "$cwd/op/${exename}_exe.uu")) { + print "# Unpacking $exename.exe\n"; + my $e; + { + local $/; + $e = unpack "u", <$EIN>; + close $EIN; + } + open my $EOUT, ">$exename.exe" or die "Can't write $exename.exe: $!"; + binmode $EOUT; + print $EOUT $e; + close $EOUT; +} +else { + print "# Compiling $exename.c\n"; + if (system("$Config{cc} $Config{ccflags} $exename.c 2>&1 >nul") != 0) { + print "# Could not compile $exename.c, status $?\n" + ."# Where is your C compiler?\n" + ."1..0 # skipped: can't build test executable\n"; + } +} +copy("$plxname.bat","$plxname.cmd"); +chdir($cwd); + +open my $T, "$^X -I../lib -w op/system_tests |" + or die "Can't spawn op/system_tests: $!"; +my $expect; +my $comment = ""; +my $test = 0; +while (<$T>) { + chomp; + if (/^1\.\./) { + print "$_\n"; + } + elsif (/^#+\s(.*)$/) { + $comment = $1; + } + elsif (/^</) { + $expect = $_; + $expect =~ tr/<>/[]/; + $expect =~ s/\Q$plxname\E]/$plxname.bat]/; + } + else { + if ($expect ne $_) { + print "# $comment\n" if $comment; + print "# want: $expect\n"; + print "# got : $_\n"; + print "not "; + } + ++$test; + print "ok $test\n"; + } +} +close $T; diff --git a/t/op/system_tests b/t/op/system_tests new file mode 100644 index 0000000000..8df87707b0 --- /dev/null +++ b/t/op/system_tests @@ -0,0 +1,110 @@ +#!perl + +use Cwd; +use strict; + +$| = 1; + +my $cwdb = my $cwd = cwd(); +$cwd =~ s,\\,/,g; +$cwdb =~ s,/,\\,g; + +my $testdir = "t e s t"; +my $exename = "showav"; +my $plxname = "showargv"; + +my $exe = "$testdir/$exename"; +my $exex = $exe . ".exe"; +(my $exeb = $exe) =~ s,/,\\,g; +my $exebx = $exeb . ".exe"; + +my $bat = "$testdir/$plxname"; +my $batx = $bat . ".bat"; +(my $batb = $bat) =~ s,/,\\,g; +my $batbx = $batb . ".bat"; + +my $cmdx = $bat . ".cmd"; +my $cmdb = $batb; +my $cmdbx = $cmdb . ".cmd"; + +my @commands = ( + $exe, + $exex, + $exeb, + $exebx, + "./$exe", + "./$exex", + ".\\$exeb", + ".\\$exebx", + "$cwd/$exe", + "$cwd/$exex", + "$cwdb\\$exeb", + "$cwdb\\$exebx", + $bat, + $batx, + $batb, + $batbx, + "./$bat", + "./$batx", + ".\\$batb", + ".\\$batbx", + "$cwd/$bat", + "$cwd/$batx", + "$cwdb\\$batb", + "$cwdb\\$batbx", + $cmdx, + $cmdbx, + "./$cmdx", + ".\\$cmdbx", + "$cwd/$cmdx", + "$cwdb\\$cmdbx", + [$^X, $batx], + [$^X, $batbx], + [$^X, "./$batx"], + [$^X, ".\\$batbx"], + [$^X, "$cwd/$batx"], + [$^X, "$cwdb\\$batbx"], +); + +my @av = ( + undef, + "", + " ", + "abc", + "a b\tc", + "\tabc", + "abc\t", + " abc\t", + "\ta b c ", + ["\ta b c ", ""], + ["\ta b c ", " "], + ["", "\ta b c ", "abc"], + [" ", "\ta b c ", "abc"], +); + +print "1.." . (@commands * @av * 2) . "\n"; +for my $cmds (@commands) { + for my $args (@av) { + my @all_args; + my @cmds = defined($cmds) ? (ref($cmds) ? @$cmds : $cmds) : (); + my @args = defined($args) ? (ref($args) ? @$args : $args) : (); + print "######## [@cmds]\n"; + print "<", join('><', $cmds[$#cmds], @args), ">\n"; + if (system(@cmds,@args) != 0) { + print "Failed, status($?)\n"; +# print "Running again in debug mode\n"; +# $^D = 1; # -Dp +# system(@cmds,@args); + } + $^D = 0; + my $cmdstr = join " ", map { /\s|^$/ ? qq["$_"] : $_ } @cmds, @args; + print "######## '$cmdstr'\n"; + if (system($cmdstr) != 0) { + print "Failed, status($?)\n"; +# print "Running again in debug mode\n"; +# $^D = 1; # -Dp +# system($cmdstr); + } + $^D = 0; + } +} diff --git a/win32/win32.c b/win32/win32.c index f50436e6bf..b23ce65c36 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -586,6 +586,30 @@ do_aspawn(void *vreally, void **vmark, void **vsp) return (status); } +/* returns pointer to the next unquoted space or the end of the string */ +static char* +find_next_space(const char *s) +{ + bool in_quotes = FALSE; + 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)) + return (char*)s; + else + s++; + } + return (char*)s; +} + int do_spawn2(char *cmd, int exectype) { @@ -605,27 +629,11 @@ do_spawn2(char *cmd, int exectype) strcpy(cmd2, cmd); a = argv; for (s = cmd2; *s;) { - bool in_quotes = FALSE; while (*s && isSPACE(*s)) s++; if (*s) *(a++) = 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++; - } + s = find_next_space(s); if (*s) *s++ = '\0'; } @@ -3092,7 +3100,7 @@ win32_chmod(const char *path, int mode) static char * -create_command_line(const char *cmdname, const char * const *args) +create_command_line(char *cname, STRLEN clen, const char * const *args) { dTHX; int index, argc; @@ -3102,7 +3110,7 @@ create_command_line(const char *cmdname, const char * const *args) bool bat_file = FALSE; bool cmd_shell = FALSE; bool extra_quotes = FALSE; - char *cname = (char*)cmdname; + bool quote_next = FALSE; if (!cname) cname = (char*)args[0]; @@ -3119,9 +3127,13 @@ create_command_line(const char *cmdname, const char * const *args) * 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). + * XXX the above rules (from "cmd /?") don't seem to be applied + * always, making for the convolutions below :-( */ if (cname) { - STRLEN clen = strlen(cname); + if (!clen) + clen = strlen(cname); + if (clen > 4 && (stricmp(&cname[clen-4], ".bat") == 0 || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0))) @@ -3129,11 +3141,19 @@ create_command_line(const char *cmdname, const char * const *args) bat_file = TRUE; len += 3; } - else if (stricmp(cname, "cmd.exe") == 0 - || stricmp(cname, "cmd") == 0) - { - cmd_shell = TRUE; - len += 3; + else { + char *exe = strrchr(cname, '/'); + char *exe2 = strrchr(cname, '\\'); + if (exe2 > exe) + exe = exe2; + if (exe) + ++exe; + else + exe = cname; + if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) { + cmd_shell = TRUE; + len += 3; + } } } @@ -3175,6 +3195,13 @@ create_command_line(const char *cmdname, const char * const *args) i++; } } + else if (quote_next) { + /* ok, we know the argument already has quotes; see if it + * really is multiple arguments pretending to be one and + * force a set of quotes around it */ + if (*find_next_space(arg)) + do_quote = 1; + } if (do_quote) *ptr++ = '"'; @@ -3190,11 +3217,20 @@ create_command_line(const char *cmdname, const char * const *args) if (!extra_quotes && cmd_shell - && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0) - && (argc-1 > index+1)) /* two or more arguments to cmd.exe? */ + && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0)) { - *ptr++ = '"'; - extra_quotes = TRUE; + /* is there a next argument? */ + if (args[index+1]) { + /* are there two or more next arguments? */ + if (args[index+2]) { + *ptr++ = '"'; + extra_quotes = TRUE; + } + else { + /* single argument, force quoting if unquoted */ + quote_next = TRUE; + } + } } } @@ -3384,9 +3420,30 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) STARTUPINFO StartupInfo; PROCESS_INFORMATION ProcessInformation; DWORD create = 0; - - char *cmd = create_command_line(cmdname, argv); + char *cmd; char *fullcmd = Nullch; + char *cname = (char *)cmdname; + STRLEN clen = 0; + + if (cname) { + clen = strlen(cname); + /* if command name contains dquotes, must remove them */ + if (strchr(cname, '"')) { + cmd = cname; + New(0,cname,clen+1,char); + clen = 0; + while (*cmd) { + if (*cmd != '"') { + cname[clen] = *cmd; + ++clen; + } + ++cmd; + } + cname[clen] = '\0'; + } + } + + cmd = create_command_line(cname, clen, argv); env = PerlEnv_get_childenv(); dir = PerlEnv_get_childdir(); @@ -3433,9 +3490,9 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) } DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n", - cmdname,cmd)); + cname,cmd)); RETRY: - if (!CreateProcess(cmdname, /* search PATH to find executable */ + if (!CreateProcess(cname, /* search PATH to find executable */ cmd, /* executable, and its arguments */ NULL, /* process attributes */ NULL, /* thread attributes */ @@ -3453,12 +3510,14 @@ RETRY: * jump through our own hoops by picking out the path * we really want it to use. */ if (!fullcmd) { - fullcmd = qualified_path(cmdname); + fullcmd = qualified_path(cname); if (fullcmd) { - cmdname = fullcmd; + if (cname != cmdname) + Safefree(cname); + cname = fullcmd; DEBUG_p(PerlIO_printf(Perl_debug_log, "Retrying [%s] with same args\n", - cmdname)); + cname)); goto RETRY; } } @@ -3491,7 +3550,8 @@ RETVAL: PerlEnv_free_childenv(env); PerlEnv_free_childdir(dir); Safefree(cmd); - Safefree(fullcmd); + if (cname != cmdname) + Safefree(cname); return ret; #endif } |