Using system or exec safely on Windows

Passing a list of arguments to another program on Windows in perl is much more complicated than it should be. There are several different issues that combine that lead to this.

(mostly copied from a post I made on PerlMonks)

First is that argument lists are always passed as a single string in Windows, as opposed to arrays like on other systems. This is less of a problem than it appears, because 95% of programs use the same rules for parsing that string into an array. Roughly speaking, the rules are that arguments can be quoted with double quotes, and backslashes can escape any character.

The second issue is that cmd.exe uses different quoting rules than the normal parsing routine. It uses a caret as the escape character instead of backslash.

The result of this is that you can't create a string that will be treated the same for both of these cases. This becomes a larger problem, because perl switches between using cmd.exe vs calling directly based on if they have shell meta-characters in them. And that involves a third, different set of quoting rules. There isn't any good way to check which way perl is going to treat a command without reimplementing the code to detect them that exists inside perl. So here is a routine that will quote arguments correctly to use with system on Windows:

sub quote_list {
    my (@args) = @_;

    my $args = join ' ', map { quote_literal($_) } @args;

    if (_has_shell_metachars($args)) {
        # cmd.exe treats quotes differently from standard
        # argument parsing. just escape everything using ^.
        $args =~ s/([()%!^"<>&|])/^$1/g;
    }
    return $args;
}

sub quote_literal {
    my ($text) = @_;

    # basic argument quoting.  uses backslashes and quotes to escape
    # everything.
    if ($text ne '' && $text !~ /[ \t\n\v"]/) {
        # no quoting needed
    }
    else {
        my @text = split '', $text;
        $text = q{"};
        for (my $i = 0; ; $i++) {
            my $bs_count = 0;
            while ( $i < @text && $text[$i] eq "\\" ) {
                $i++;
                $bs_count++;
            }
            if ($i > $#text) {
                $text .= "\\" x ($bs_count * 2);
                last;
            }
            elsif ($text[$i] eq q{"}) {
                $text .= "\\" x ($bs_count * 2 + 1);
            }
            else {
                $text .= "\\" x $bs_count;
            }
            $text .= $text[$i];
        }
        $text .= q{"};
    }

    return $text;
}

# direct port of code from win32.c
sub _has_shell_metachars {
    my $string = shift;
    my $inquote = 0;
    my $quote = '';

    my @string = split '', $string;
    for my $char (@string) {
        if ($char eq q{%}) {
            return 1;
        }
        elsif ($char eq q{'} || $char eq q{"}) {
            if ($inquote) {
                if ($char eq $quote) {
                    $inquote = 0;
                    $quote = '';
                }
            }
            else {
                $quote = $char;
                $inquote++;
            }
        }
        elsif ($char eq q{<} || $char eq q{>} || $char eq q{|}) {
            if ( ! $inquote) {
                return 1;
            }
        }
    }
    return;
}

The information about the quoting rules on Windows is from the article Everyone quotes command line arguments the wrong way. I attempted to use this to improve ExtUtils::MakeMaker's quoting, but that also has to deal with Makefile quoting rules. Additionally, other parts of the code (or at least tests) assume that you can generate a string and have it work both when passed to system and when placed in a Makefile. I almost never use perl on Windows, so I eventually gave up on the effort.

2 Comments

I use next function under win7:
my $exec_shell =
q{C:\Perl\bin\wperl.exe -x "C:\Perl\bin\perlcritic-gui" c:\Users\nmishin\Documents\git\perlcritic\perlcritic_profile.perlcriticrc }
      . $filename
      . q{ --run};
my $a = run_shell($exec_shell);
sub run_shell {
    my ($cmd) = @_;
    my @args  = ();
    my $EMPTY = q{};
    my $ret   = undef;
    my ( $HIS_IN, $HIS_OUT, $HIS_ERR ) = ( $EMPTY, $EMPTY, $EMPTY );
    my $childpid = open3( $HIS_IN, $HIS_OUT, $HIS_ERR, $cmd, @args );
    $ret = print {$HIS_IN} "stuff\n";
    close $HIS_IN or croak "unable to close: $HIS_IN $ERRNO";
    ;    # Give end of file to kid.

    if ($HIS_OUT) {
        my @outlines = ;    # Read till EOF.
        $ret = print " STDOUT:\n", @outlines, "\n";
    }
    if ($HIS_ERR) {
        my @errlines = ;    # XXX: block potential if massive
        $ret = print " STDERR:\n", @errlines, "\n";
    }
    close $HIS_OUT or croak "unable to close: $HIS_OUT $ERRNO";

    #close $HIS_ERR or croak "unable to close: $HIS_ERR $ERRNO";#bad..todo
    waitpid $childpid, 0;
    if ($CHILD_ERROR) {
        $ret = print "That child exited with wait status of $CHILD_ERROR\n";
    }
    return 1;
}

Have you considered merging your code with String::ShellQuote?


Leave a comment

About Graham Knop

user-pic