Re: [PATCH 1/2] git-svn, perl/Git.pm: add central method for prompting passwords honoring GIT_ASKPASS and SSH_ASKPASS

["Ævar Arnfjörð Bjarmason" <avarab@gmail.com>]

On Wed, Dec 28, 2011 at 01:11, Sven Strickroth
<sven.strickroth@tu-clausthal.de> wrote:

Nom nom, some Perl. Thanks for tackling this. Reviewing it as
requested by Junio.

> diff --git a/git-svn.perl b/git-svn.perl
> index eeb83d3..bcee8aa 100755
> --- a/git-svn.perl
> +++ b/git-svn.perl
> @@ -4415,25 +4415,7 @@ sub username {
>
>  sub _read_password {
>        my ($prompt, $realm) = @_;
> -       my $password = '';
> -       if (exists $ENV{GIT_ASKPASS}) {
> -               open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
> -               $password = <PH>;
> -               $password =~ s/[\012\015]//; # \n\r
> -               close(PH);
> -       } else {
> -               print STDERR $prompt;
> -               STDERR->flush;
> -               require Term::ReadKey;
> -               Term::ReadKey::ReadMode('noecho');
> -               while (defined(my $key = Term::ReadKey::ReadKey(0))) {
> -                       last if $key =~ /[\012\015]/; # \n\r
> -                       $password .= $key;
> -               }
> -               Term::ReadKey::ReadMode('restore');
> -               print STDERR "\n";
> -               STDERR->flush;
> -       }
> +       my $password = Git->prompt($prompt);
>        $password;
>  }
>
> diff --git a/perl/Git.pm b/perl/Git.pm
> index f7ce511..b1c7c50 100644
> --- a/perl/Git.pm
> +++ b/perl/Git.pm
> @@ -58,7 +58,7 @@ require Exporter;
>                 command_output_pipe command_input_pipe command_close_pipe
>                 command_bidi_pipe command_close_bidi_pipe
>                 version exec_path html_path hash_object git_cmd_try
> -                remote_refs
> +                remote_refs prompt
>                 temp_acquire temp_release temp_reset temp_path);
>
>
> @@ -512,6 +512,55 @@ C<git --html-path>). Useful mostly only internally.
>  sub html_path { command_oneline('--html-path') }
>
>
> +=item prompt ( PROMPT )
> +
> +Query user C<PROMPT> and return answer from user.
> +
> +Check if GIT_ASKPASS or SSH_ASKPASS is set, use first matching for querying
> +user and return answer. If no *_ASKPASS variable is set, the variable is
> +empty or an error occoured, the terminal is tried as a fallback.
> +
> +=cut
> +
> +sub prompt {
> +       my ($self, $prompt) = _maybe_self(@_);
> +       my $ret;
> +       if (exists $ENV{'GIT_ASKPASS'}) {
> +               $ret = _prompt($ENV{'GIT_ASKPASS'}, $prompt);
> +       }
> +       if (!defined $ret && exists $ENV{'SSH_ASKPASS'}) {
> +               $ret = _prompt($ENV{'SSH_ASKPASS'}, $prompt);
> +       }
> +       if (!defined $ret) {
> +               print STDERR $prompt;
> +               STDERR->flush;
> +               require Term::ReadKey;
> +               Term::ReadKey::ReadMode('noecho');
> +               while (defined(my $key = Term::ReadKey::ReadKey(0))) {
> +                       last if $key =~ /[\012\015]/; # \n\r
> +                       $ret .= $key;
> +               }
> +               Term::ReadKey::ReadMode('restore');
> +               print STDERR "\n";
> +               STDERR->flush;
> +       }
> +       return $ret;
> +}

Personally I prefer not to write code I don't have to write. Here
you're doing:

    my ($self, $prompt) = _maybe_self(@_);

And then never using $self, so there's actually no reason for this to
be an object/class function. It could just be called as:

    my $password = Git::prompt($prompt);

Instead of:

    my $password = Git->prompt($prompt);

Which means you could change the first line to just:

    my ($prompt) = @_;

Which wouldn't leave the reader wondering why this needs to maybe
construct an object just to throw it away.

> +sub _prompt {
> +       my ($askpass, $prompt) = @_;
> +       unless ($askpass) {
> +               return undef;
> +       }

The empty list is false in Perl, so explicitly returning undef is
usually the wrong thing. It means that in list context you'll return a
true list (consisting of one undef element), instead of an empty false
one.

    $ perl -MData::Dump=dump -wle 'sub a { return } sub b { return
undef }; my @lists = ([a()], [b()]); for (@lists) { print @$_ ? "true"
: "false" }'
    false
    true

You're not running into that error here since you always use scalar
context. But it's better just to do:

    if (xyz) {
        return;
    }

Unless you want this behavior.

But aside from that I find this code a bit bizarre. The caller is
doing:

    if (exists $ENV{'GIT_ASKPASS'}) {
            $ret = _prompt($ENV{'GIT_ASKPASS'}, $prompt);
    }
    if (!defined $ret && exists $ENV{'SSH_ASKPASS'}) {
            $ret = _prompt($ENV{'SSH_ASKPASS'}, $prompt);
    }

Which means we check whether *_ASKPASS *exists* in the env hash, and
then the function checks whether that value is true or not.

Which means the code implicitly depends on Perl's idea of true/false
values for the names of those commands. E.g. you can't create a
command called "0" and put it in your $PATH.

I suppose the case you actually care about is someone being able to do:

    export GIT_ASKPASS=

Instead of the better:

    unset GIT_ASKPASS

> +       my $ret;
> +       open my $fh, "-|", $askpass, $prompt || return undef;

As pointed out already this is a logic error due to the ||.

But even if that worked I think this behavior is a bit
questionable. Why don't we just throw an error at this point? The way
I'd write this would be something like:

    my $pass = _prompt('GIT_ASKPASS', $prompt);

And then:

    sub _prompt {
        my ($env_var, $prompt) = @_;

        # or exists(), depending on whether we insist on "unset"
        return unless length $ENV{$env_var};

        my $command = $ENV{$env_var};
        open my $fh, "-|", $command or die "We can't get your password
from `$command' given in $env_var: $!";
        chomp(my $password = <$fh>);
        close $fh or die "We can't close() `$command' given in $env_var: $!";

        return $password;
    }

Which would give the user an error if his GIT_ASKPASS command
failed. Check the return value of close() too, and re-structure the
passing around of the env variable so we could give a sensible error
message.

> +       $ret = <$fh>;
> +       $ret =~ s/[\012\015]//g; # strip \n\r, chomp does not work on all systems (i.e. windows) as expected

Urm yes it does. \n in Perl is magical and doesn't mean \012 like it
does in some languages. It means "The Platform's Native
Newline".

Which is \012 on Unix, \015\012 on Windows, and was \015 on Mac OS
until support for it was removed. This is covered in the second
section of "perldoc perlport".

Can you show me a case where it fails, and under what environment
exactly? Maybe it's e.g.s some Cygwin-specific peculiarity, in which
case we could check for that platform specifically.