Perl: Support spaces in command arguments on MSWin32

On a native Windows build of Perl (where $^O equals 'MSWin32'), like
Strawberry or ActiveState Perl, the Git.pm module follows a unique code
path, one that alters the behavior of piped Git commands.  This special
path failed to handle spaces contained in an argument to Git.  Remove
that limitation by improving Windows command line support.

On Windows, the command line is part of the operating system; it is not
provided by a shell.  This system requires certain characters (\, ") to
be escaped (in certain cases).  The cmd.exe command prompt rests on top
of the command line and it has its own, additional escaping mechanism.
When creating pipes, an MSWin32 build of Perl will either use the system
call, CreateProcess (which takes the command line), or, if interpreted
characters are detected, the command prompt, cmd.exe.

Add a function to unescape command line arguments, one that will work
with CreateProcess or with cmd.exe, as appropriate.  This ensures any
Git command will have its arguments parsed correctly, regardless of
content.

Additionally, include tests to verify that Perl's system() behavior
remains unchanged -- notably, that the list of interpreted characters
(for selecting cmd.exe) does not change.  These tests need an MSWin32
build of Perl in the PATH to work; otherwise, they are skipped.

This change will improve commands (or batch scripts) run in CMD, where
native (MSWin32) builds of Perl are all that is available in the PATH
(unless the user opts to install Unix utils in the PATH, which is not
recommended in the Git for Windows installer).  Commands run in MSYS
Perl, which is included with Git for Windows, will not change (as it
never had a problem).

Closes: #1602
Signed-off-by: Chris Lindee <[email protected]>

Author: ColMelvin

perl/Git.pm

@@ -1692,12 +1692,8 @@ package Git::activestate_pipe;
 
 sub TIEHANDLE {
 	my ($class, @params) = @_;
-	# FIXME: This is probably horrible idea and the thing will explode
-	# at the moment you give it arguments that require some quoting,
-	# but I have no ActiveState clue... --pasky
-	# Let's just hope ActiveState Perl does at least the quoting
-	# correctly.
-	my @data = qx{git @params};
+	my $cmdline = make_windows_commandline('git', @params);
+	my @data = qx{$cmdline};
 	bless { i => 0, data => \@data }, $class;
 }
 
@@ -1726,5 +1722,35 @@ sub EOF {
 	return ($self->{i} >= scalar @{$self->{data}});
 }
 
+sub make_windows_commandline {
+	my $cmdline = join ' ', unescape_windows_commandline_args(@_);
+
+	# The set of meta-characters, as determined by Perl, was found in
+	# has_shell_metachars() in perl5/win32/win32.c
+	return unescape_cmd_commandline($cmdline) if $cmdline =~ m/[<>|%]/;
+	return $cmdline;
+}
+
+# See https://blogs.msdn.microsoft.com/twistylittlepassagesallalike/2011/04/23/everyone-quotes-command-line-arguments-the-wrong-way/
+sub unescape_windows_commandline_args {
+	my @out;
+	foreach (@_) {
+		my $value = $_;
+		$value =~ s{(\\*)"}{$1$1\\"}g;
+		if ($value =~ m/\W/) {
+			$value =~ s{(\\+)$}{$1$1};
+			$value = "\"$value\"";
+		}
+		push @out, $value;
+	}
+	return @out;
+}
+
+sub unescape_cmd_commandline {
+	my ($cmdline) = @_;
+	$cmdline =~ s{([()%!^"<>&|])}{^$1}g;
+	return $cmdline;
+}
+
 
 1; # Famous last words

t/t9701-perl-git-MSWin32.sh

@@ -0,0 +1,45 @@
+#!/bin/sh
+#
+# Copyright (c) 2018 Chris Lindee
+#
+
+test_description='perl interface (Git.pm) on MSWin32'
+. ./test-lib.sh
+
+find_MSWin32_perl() {
+	local perl
+	for perl in $(which -a perl); do
+		if "$perl" -e 'exit 1 if $^O ne q{MSWin32}'; then
+			echo "$perl"
+			return 0
+		fi
+	done
+	return 1
+}
+
+MSWin32_Perl="$(find_MSWin32_perl)"
+if [ $? -ne 0 ]; then
+	skip_all='skipping perl on MSWin32 interface tests, MSWin32 perl not available'
+	test_done
+fi
+
+"$MSWin32_Perl" -MTest::More -e 0 2>/dev/null || {
+	skip_all="MSWin32 Perl Test::More unavailable, skipping test"
+	test_done
+}
+
+# The external test will outputs its own plan
+test_external_has_tap=1
+
+# Ensure paths are recognized by Windows executables.
+perl_test_path="$TEST_DIRECTORY"/t9701/test.pl
+if test_have_prereq CYGWIN || test_have_prereq MINGW; then
+	perl_test_path="$(cygpath -w "$perl_test_path")"
+	GITPERLLIB="$(cygpath -w -p "$GITPERLLIB")"
+fi
+
+test_external_without_stderr \
+	'Windows command line (Perl API)' \
+	"$MSWin32_Perl" "$perl_test_path"
+
+test_done

t/t9701/test.pl

@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+use lib (split(/:/, $ENV{GITPERLLIB}));
+
+use 5.008;
+use strict;
+use warnings;
+
+use Test::More qw(no_plan);
+
+BEGIN {
+	# t9701-perl-git-MSWin32.sh kicks off our testing, so we have to go from
+	# there.
+	Test::More->builder->current_test(1);
+	Test::More->builder->no_ending(1);
+}
+
+my @tests = (
+	'\\\\',
+	'()%!^"<>&|',
+	'C:\\Windows\\system32\\',
+	map { chr } 32 .. 126, 160 .. 255	# printable ISO-8859-1, the base for Windows-1252
+);
+
+# Just in case
+plan skip_all => 'Test will not run on MSYS Perl (distributed with Git for Windows)' if $^O eq 'msys';
+plan skip_all => 'Test requires Microsoft Windows' if $^O ne 'MSWin32';
+
+require_ok('Git');
+
+foreach (@tests) {
+	my $cmdline = Git::activestate_pipe::make_windows_commandline($^X, '-e', 'print $ARGV[0]', $_);
+	is qx{$cmdline}, $_, $cmdline;
+}
+
+printf "1..%d\n", Test::More->builder->current_test;
+
+my $is_passing = eval { Test::More->is_passing };
+exit($is_passing ? 0 : 1) unless $@ =~ /Can't locate object method/;