From fff004002eeb456aa25f8304cc6032a258da190f Mon Sep 17 00:00:00 2001 From: Chris Lindee Date: Fri, 30 Mar 2018 23:22:26 -0500 Subject: [PATCH 1/3] 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 --- perl/Git.pm | 38 ++++++++++++++++++++++++++----- t/t9701-perl-git-MSWin32.sh | 45 +++++++++++++++++++++++++++++++++++++ t/t9701/test.pl | 38 +++++++++++++++++++++++++++++++ 3 files changed, 115 insertions(+), 6 deletions(-) create mode 100755 t/t9701-perl-git-MSWin32.sh create mode 100755 t/t9701/test.pl diff --git a/perl/Git.pm b/perl/Git.pm index d856930b2e5f31..0386fd3ec05da6 100644 --- a/perl/Git.pm +++ b/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 diff --git a/t/t9701-perl-git-MSWin32.sh b/t/t9701-perl-git-MSWin32.sh new file mode 100755 index 00000000000000..27dffa30cc5c1b --- /dev/null +++ b/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 $(type -ap 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 diff --git a/t/t9701/test.pl b/t/t9701/test.pl new file mode 100755 index 00000000000000..cdce5efc744d4a --- /dev/null +++ b/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/; From 5d4934a0eae6ce8924d37fb837eadebb80535b7b Mon Sep 17 00:00:00 2001 From: Chris Lindee Date: Sat, 31 Mar 2018 00:10:35 -0500 Subject: [PATCH 2/3] Perl: Support piping commands on MSWin32 Replace the legacy TIEHANDLE used to fake out a pipe and replace it with real pipes. As modern Perl seems to handle these simple pipes well, the need for a special-case object has evaporated. As a consequence of this change, input pipes are now supported. Closes: #1603 Signed-off-by: Chris Lindee --- perl/Git.pm | 50 +++++-------------------------------------------- t/t9701/test.pl | 2 +- 2 files changed, 6 insertions(+), 46 deletions(-) diff --git a/perl/Git.pm b/perl/Git.pm index 0386fd3ec05da6..fb9d33836338d4 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -1607,15 +1607,11 @@ sub _command_common_pipe { # ActiveState Perl #defined $opts{STDERR} and # warn 'ignoring STDERR option - running w/ ActiveState'; - $direction eq '-|' or - die 'input pipe for ActiveState not implemented'; - # the strange construction with *ACPIPE is just to - # explain the tie below that we want to bind to - # a handle class, not scalar. It is not known if - # it is something specific to ActiveState Perl or - # just a Perl quirk. - tie (*ACPIPE, 'Git::activestate_pipe', $cmd, @args); - $fh = *ACPIPE; + my $cmdline = make_windows_commandline('git', $cmd, @args); + my $pid = open($fh, $direction, $cmdline); + if (not defined $pid) { + throw Error::Simple("open failed: $!"); + } } else { my $pid = open($fh, $direction); @@ -1686,42 +1682,6 @@ sub DESTROY { } -# Pipe implementation for ActiveState Perl. - -package Git::activestate_pipe; - -sub TIEHANDLE { - my ($class, @params) = @_; - my $cmdline = make_windows_commandline('git', @params); - my @data = qx{$cmdline}; - bless { i => 0, data => \@data }, $class; -} - -sub READLINE { - my $self = shift; - if ($self->{i} >= scalar @{$self->{data}}) { - return undef; - } - my $i = $self->{i}; - if (wantarray) { - $self->{i} = $#{$self->{'data'}} + 1; - return splice(@{$self->{'data'}}, $i); - } - $self->{i} = $i + 1; - return $self->{'data'}->[ $i ]; -} - -sub CLOSE { - my $self = shift; - delete $self->{data}; - delete $self->{i}; -} - -sub EOF { - my $self = shift; - return ($self->{i} >= scalar @{$self->{data}}); -} - sub make_windows_commandline { my $cmdline = join ' ', unescape_windows_commandline_args(@_); diff --git a/t/t9701/test.pl b/t/t9701/test.pl index cdce5efc744d4a..2a57133f3a93c4 100755 --- a/t/t9701/test.pl +++ b/t/t9701/test.pl @@ -28,7 +28,7 @@ BEGIN require_ok('Git'); foreach (@tests) { - my $cmdline = Git::activestate_pipe::make_windows_commandline($^X, '-e', 'print $ARGV[0]', $_); + my $cmdline = Git::make_windows_commandline($^X, '-e', 'print $ARGV[0]', $_); is qx{$cmdline}, $_, $cmdline; } From f6033bee183f82004aee9410e3f4bedd8b5da23c Mon Sep 17 00:00:00 2001 From: Chris Lindee Date: Sat, 13 Oct 2018 13:03:02 -0500 Subject: [PATCH 3/3] Make MSWin32 Perl available to all tests Pull out the logic to find a MSWin32 build of Perl, so it can be used by all tests. Signed-off-by: Chris Lindee --- Makefile | 14 ++++++++++++++ t/t9701-perl-git-MSWin32.sh | 19 +++---------------- t/test-lib-functions.sh | 8 ++++++++ t/test-lib.sh | 10 +++++++++- 4 files changed, 34 insertions(+), 17 deletions(-) diff --git a/Makefile b/Makefile index 8b3868ed8b4cf5..de25b43a267bbb 100644 --- a/Makefile +++ b/Makefile @@ -2475,6 +2475,19 @@ LIB_PERL_GEN := $(patsubst perl/%.pm,perl/build/lib/%.pm,$(LIB_PERL)) LIB_CPAN := $(wildcard perl/FromCPAN/*.pm perl/FromCPAN/*/*.pm) LIB_CPAN_GEN := $(patsubst perl/%.pm,perl/build/lib/%.pm,$(LIB_CPAN)) +# Set MSWIN32_PERL_PATH=false to disable search +ifndef MSWIN32_PERL_PATH +MSWIN32_PERL_PATH = $(shell \ + for perl in $$(type -ap perl); do \ + if "$$perl" -e 'exit 1 if $$^O ne q{MSWin32}'; then \ + echo "$$perl"; \ + exit 0; \ + fi; \ + done \ +) +endif +MSWIN32_PERL_PATH_SQ = $(subst ','\'',$(MSWIN32_PERL_PATH)) + ifndef NO_PERL all:: $(LIB_PERL_GEN) ifndef NO_PERL_CPAN_FALLBACKS @@ -2573,6 +2586,7 @@ GIT-BUILD-OPTIONS: FORCE @echo PAGER_ENV=\''$(subst ','\'',$(subst ','\'',$(PAGER_ENV)))'\' >>$@+ @echo DC_SHA1=\''$(subst ','\'',$(subst ','\'',$(DC_SHA1)))'\' >>$@+ @echo X=\'$(X)\' >>$@+ + @echo MSWIN32_PERL_PATH=\''$(subst ','\'',$(MSWIN32_PERL_PATH_SQ))'\' >>$@+ ifdef TEST_OUTPUT_DIRECTORY @echo TEST_OUTPUT_DIRECTORY=\''$(subst ','\'',$(subst ','\'',$(TEST_OUTPUT_DIRECTORY)))'\' >>$@+ endif diff --git a/t/t9701-perl-git-MSWin32.sh b/t/t9701-perl-git-MSWin32.sh index 27dffa30cc5c1b..6ff96c4bd463a2 100755 --- a/t/t9701-perl-git-MSWin32.sh +++ b/t/t9701-perl-git-MSWin32.sh @@ -6,24 +6,12 @@ test_description='perl interface (Git.pm) on MSWin32' . ./test-lib.sh -find_MSWin32_perl() { - local perl - for perl in $(type -ap 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 +if ! test_have_prereq MSWIN32_PERL; 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 || { +mswin32_perl -MTest::More -e 0 2>/dev/null || { skip_all="MSWin32 Perl Test::More unavailable, skipping test" test_done } @@ -35,11 +23,10 @@ test_external_has_tap=1 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" + mswin32_perl "$perl_test_path" test_done diff --git a/t/test-lib-functions.sh b/t/test-lib-functions.sh index 11b81276917db5..1a883e93bbafc0 100644 --- a/t/test-lib-functions.sh +++ b/t/test-lib-functions.sh @@ -933,6 +933,14 @@ perl () { command "$PERL_PATH" "$@" 2>&7 } 7>&2 2>&4 +mswin32_perl () { + local GITPERLLIB="$GITPERLLIB" + if test_have_prereq CYGWIN || test_have_prereq MINGW; then + GITPERLLIB="$(cygpath -w -p "$GITPERLLIB")" + fi + command "$MSWIN32_PERL_PATH" "$@" 2>&7 +} 7>&2 2>&4 + # Is the value one of the various ways to spell a boolean true/false? test_normalize_bool () { git -c magic.variable="$1" config --bool magic.variable 2>/dev/null diff --git a/t/test-lib.sh b/t/test-lib.sh index f2bd4e6fb86fd4..9eb3a9f72d5923 100644 --- a/t/test-lib.sh +++ b/t/test-lib.sh @@ -64,7 +64,7 @@ then exit 1 fi . "$GIT_BUILD_DIR"/GIT-BUILD-OPTIONS -export PERL_PATH SHELL_PATH +export MSWIN32_PERL_PATH PERL_PATH SHELL_PATH ################################################################ # It appears that people try to run tests without building... @@ -1268,3 +1268,11 @@ test_lazy_prereq CURL ' test_lazy_prereq SHA1 ' test $(git hash-object /dev/null) = e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 ' + +# Some tests require a native Win32 Perl interpreter, such as Strawberry Perl +# or ActiveState Perl, which is not distributed with Git for Windows. These +# tests only run if an appropriate Perl is specified (via MSWIN32_PERL_PATH). +test_lazy_prereq MSWIN32_PERL ' + test -n "$MSWIN32_PERL_PATH" && + $MSWIN32_PERL_PATH -e "exit 1 if \$^O ne q{MSWin32}" +'