Merge branch 'tr/perl-keep-stderr-open'
authorJunio C Hamano <gitster@pobox.com>
Mon, 15 Apr 2013 19:40:41 +0000 (12:40 -0700)
committerJunio C Hamano <gitster@pobox.com>
Mon, 15 Apr 2013 19:40:41 +0000 (12:40 -0700)
Closing (not redirecting to /dev/null) the standard error stream is
not a very smart thing to do. Later open may return file
descriptor #2 for unrelated purpose, and error reporting code may
write into them.

* tr/perl-keep-stderr-open:
t9700: do not close STDERR
perl: redirect stderr to /dev/null instead of closing

1  2 
perl/Git.pm
diff --combined perl/Git.pm
index 650db90853c6ff2a769e981afd2954ffbb97469c,4778428830a5eaf6fb9773b18a18f02f934c8820..dc48159ccab1cf2f888a6169460c5fc60d0d1bab
@@@ -60,7 -60,6 +60,7 @@@ require Exporter
                  version exec_path html_path hash_object git_cmd_try
                  remote_refs prompt
                  get_tz_offset
 +                credential credential_read credential_write
                  temp_acquire temp_release temp_reset temp_path);
  
  
@@@ -270,13 -269,13 +270,13 @@@ sub command 
  
        if (not defined wantarray) {
                # Nothing to pepper the possible exception with.
 -              _cmd_close($fh, $ctx);
 +              _cmd_close($ctx, $fh);
  
        } elsif (not wantarray) {
                local $/;
                my $text = <$fh>;
                try {
 -                      _cmd_close($fh, $ctx);
 +                      _cmd_close($ctx, $fh);
                } catch Git::Error::Command with {
                        # Pepper with the output:
                        my $E = shift;
                my @lines = <$fh>;
                defined and chomp for @lines;
                try {
 -                      _cmd_close($fh, $ctx);
 +                      _cmd_close($ctx, $fh);
                } catch Git::Error::Command with {
                        my $E = shift;
                        $E->{'-outputref'} = \@lines;
@@@ -316,7 -315,7 +316,7 @@@ sub command_oneline 
        my $line = <$fh>;
        defined $line and chomp $line;
        try {
 -              _cmd_close($fh, $ctx);
 +              _cmd_close($ctx, $fh);
        } catch Git::Error::Command with {
                # Pepper with the output:
                my $E = shift;
@@@ -384,7 -383,7 +384,7 @@@ have more complicated structure
  sub command_close_pipe {
        my ($self, $fh, $ctx) = _maybe_self(@_);
        $ctx ||= '<unknown>';
 -      _cmd_close($fh, $ctx);
 +      _cmd_close($ctx, $fh);
  }
  
  =item command_bidi_pipe ( COMMAND [, ARGUMENTS... ] )
@@@ -421,7 -420,7 +421,7 @@@ and it is the fourth value returned by 
  is:
  
        my ($pid, $in, $out, $ctx) = $r->command_bidi_pipe('cat-file --batch-check');
 -      print "000000000\n" $out;
 +      print $out "000000000\n";
        while (<$in>) { ... }
        $r->command_close_bidi_pipe($pid, $in, $out, $ctx);
  
@@@ -429,26 -428,23 +429,26 @@@ Note that you should not rely on whatev
  currently it is simply the command name but in future the context might
  have more complicated structure.
  
 +C<PIPE_IN> and C<PIPE_OUT> may be C<undef> if they have been closed prior to
 +calling this function.  This may be useful in a query-response type of
 +commands where caller first writes a query and later reads response, eg:
 +
 +      my ($pid, $in, $out, $ctx) = $r->command_bidi_pipe('cat-file --batch-check');
 +      print $out "000000000\n";
 +      close $out;
 +      while (<$in>) { ... }
 +      $r->command_close_bidi_pipe($pid, $in, undef, $ctx);
 +
 +This idiom may prevent potential dead locks caused by data sent to the output
 +pipe not being flushed and thus not reaching the executed command.
 +
  =cut
  
  sub command_close_bidi_pipe {
        local $?;
 -      my ($pid, $in, $out, $ctx) = @_;
 -      foreach my $fh ($in, $out) {
 -              unless (close $fh) {
 -                      if ($!) {
 -                              carp "error closing pipe: $!";
 -                      } elsif ($? >> 8) {
 -                              throw Git::Error::Command($ctx, $? >>8);
 -                      }
 -              }
 -      }
 -
 +      my ($self, $pid, $in, $out, $ctx) = _maybe_self(@_);
 +      _cmd_close($ctx, (grep { defined } ($in, $out)));
        waitpid $pid, 0;
 -
        if ($? >> 8) {
                throw Git::Error::Command($ctx, $? >>8);
        }
@@@ -1024,163 -1020,13 +1024,163 @@@ sub _close_cat_blob 
  }
  
  
 +=item credential_read( FILEHANDLE )
 +
 +Reads credential key-value pairs from C<FILEHANDLE>.  Reading stops at EOF or
 +when an empty line is encountered.  Each line must be of the form C<key=value>
 +with a non-empty key.  Function returns hash with all read values.  Any white
 +space (other than new-line character) is preserved.
 +
 +=cut
 +
 +sub credential_read {
 +      my ($self, $reader) = _maybe_self(@_);
 +      my %credential;
 +      while (<$reader>) {
 +              chomp;
 +              if ($_ eq '') {
 +                      last;
 +              } elsif (!/^([^=]+)=(.*)$/) {
 +                      throw Error::Simple("unable to parse git credential data:\n$_");
 +              }
 +              $credential{$1} = $2;
 +      }
 +      return %credential;
 +}
 +
 +=item credential_write( FILEHANDLE, CREDENTIAL_HASHREF )
 +
 +Writes credential key-value pairs from hash referenced by
 +C<CREDENTIAL_HASHREF> to C<FILEHANDLE>.  Keys and values cannot contain
 +new-lines or NUL bytes characters, and key cannot contain equal signs nor be
 +empty (if they do Error::Simple is thrown).  Any white space is preserved.  If
 +value for a key is C<undef>, it will be skipped.
 +
 +If C<'url'> key exists it will be written first.  (All the other key-value
 +pairs are written in sorted order but you should not depend on that).  Once
 +all lines are written, an empty line is printed.
 +
 +=cut
 +
 +sub credential_write {
 +      my ($self, $writer, $credential) = _maybe_self(@_);
 +      my ($key, $value);
 +
 +      # Check if $credential is valid prior to writing anything
 +      while (($key, $value) = each %$credential) {
 +              if (!defined $key || !length $key) {
 +                      throw Error::Simple("credential key empty or undefined");
 +              } elsif ($key =~ /[=\n\0]/) {
 +                      throw Error::Simple("credential key contains invalid characters: $key");
 +              } elsif (defined $value && $value =~ /[\n\0]/) {
 +                      throw Error::Simple("credential value for key=$key contains invalid characters: $value");
 +              }
 +      }
 +
 +      for $key (sort {
 +              # url overwrites other fields, so it must come first
 +              return -1 if $a eq 'url';
 +              return  1 if $b eq 'url';
 +              return $a cmp $b;
 +      } keys %$credential) {
 +              if (defined $credential->{$key}) {
 +                      print $writer $key, '=', $credential->{$key}, "\n";
 +              }
 +      }
 +      print $writer "\n";
 +}
 +
 +sub _credential_run {
 +      my ($self, $credential, $op) = _maybe_self(@_);
 +      my ($pid, $reader, $writer, $ctx) = command_bidi_pipe('credential', $op);
 +
 +      credential_write $writer, $credential;
 +      close $writer;
 +
 +      if ($op eq "fill") {
 +              %$credential = credential_read $reader;
 +      }
 +      if (<$reader>) {
 +              throw Error::Simple("unexpected output from git credential $op response:\n$_\n");
 +      }
 +
 +      command_close_bidi_pipe($pid, $reader, undef, $ctx);
 +}
 +
 +=item credential( CREDENTIAL_HASHREF [, OPERATION ] )
 +
 +=item credential( CREDENTIAL_HASHREF, CODE )
 +
 +Executes C<git credential> for a given set of credentials and specified
 +operation.  In both forms C<CREDENTIAL_HASHREF> needs to be a reference to
 +a hash which stores credentials.  Under certain conditions the hash can
 +change.
 +
 +In the first form, C<OPERATION> can be C<'fill'>, C<'approve'> or C<'reject'>,
 +and function will execute corresponding C<git credential> sub-command.  If
 +it's omitted C<'fill'> is assumed.  In case of C<'fill'> the values stored in
 +C<CREDENTIAL_HASHREF> will be changed to the ones returned by the C<git
 +credential fill> command.  The usual usage would look something like:
 +
 +      my %cred = (
 +              'protocol' => 'https',
 +              'host' => 'example.com',
 +              'username' => 'bob'
 +      );
 +      Git::credential \%cred;
 +      if (try_to_authenticate($cred{'username'}, $cred{'password'})) {
 +              Git::credential \%cred, 'approve';
 +              ... do more stuff ...
 +      } else {
 +              Git::credential \%cred, 'reject';
 +      }
 +
 +In the second form, C<CODE> needs to be a reference to a subroutine.  The
 +function will execute C<git credential fill> to fill the provided credential
 +hash, then call C<CODE> with C<CREDENTIAL_HASHREF> as the sole argument.  If
 +C<CODE>'s return value is defined, the function will execute C<git credential
 +approve> (if return value yields true) or C<git credential reject> (if return
 +value is false).  If the return value is undef, nothing at all is executed;
 +this is useful, for example, if the credential could neither be verified nor
 +rejected due to an unrelated network error.  The return value is the same as
 +what C<CODE> returns.  With this form, the usage might look as follows:
 +
 +      if (Git::credential {
 +              'protocol' => 'https',
 +              'host' => 'example.com',
 +              'username' => 'bob'
 +      }, sub {
 +              my $cred = shift;
 +              return !!try_to_authenticate($cred->{'username'},
 +                                           $cred->{'password'});
 +      }) {
 +              ... do more stuff ...
 +      }
 +
 +=cut
 +
 +sub credential {
 +      my ($self, $credential, $op_or_code) = (_maybe_self(@_), 'fill');
 +
 +      if ('CODE' eq ref $op_or_code) {
 +              _credential_run $credential, 'fill';
 +              my $ret = $op_or_code->($credential);
 +              if (defined $ret) {
 +                      _credential_run $credential, $ret ? 'approve' : 'reject';
 +              }
 +              return $ret;
 +      } else {
 +              _credential_run $credential, $op_or_code;
 +      }
 +}
 +
  { # %TEMP_* Lexical Context
  
  my (%TEMP_FILEMAP, %TEMP_FILES);
  
  =item temp_acquire ( NAME )
  
 -Attempts to retreive the temporary file mapped to the string C<NAME>. If an
 +Attempts to retrieve the temporary file mapped to the string C<NAME>. If an
  associated temp file has not been created this session or was closed, it is
  created, cached, and set for autoflush and binmode.
  
@@@ -1489,12 -1335,12 +1489,12 @@@ sub _command_common_pipe 
                if (not defined $pid) {
                        throw Error::Simple("open failed: $!");
                } elsif ($pid == 0) {
-                       if (defined $opts{STDERR}) {
-                               close STDERR;
-                       }
                        if ($opts{STDERR}) {
                                open (STDERR, '>&', $opts{STDERR})
                                        or die "dup failed: $!";
+                       } elsif (defined $opts{STDERR}) {
+                               open (STDERR, '>', '/dev/null')
+                                       or die "opening /dev/null failed: $!";
                        }
                        _cmd_exec($self, $cmd, @args);
                }
@@@ -1529,11 -1375,9 +1529,11 @@@ sub _execv_git_cmd { exec('git', @_); 
  
  # Close pipe to a subprocess.
  sub _cmd_close {
 -      my ($fh, $ctx) = @_;
 -      if (not close $fh) {
 -              if ($!) {
 +      my $ctx = shift @_;
 +      foreach my $fh (@_) {
 +              if (close $fh) {
 +                      # nop
 +              } elsif ($!) {
                        # It's just close, no point in fatalities
                        carp "error closing pipe: $!";
                } elsif ($? >> 8) {