Merge branch 'mn/send-email-works-with-credential'
authorJunio C Hamano <gitster@pobox.com>
Thu, 21 Mar 2013 21:03:02 +0000 (14:03 -0700)
committerJunio C Hamano <gitster@pobox.com>
Thu, 21 Mar 2013 21:03:02 +0000 (14:03 -0700)
Hooks the credential system to send-email.

* mn/send-email-works-with-credential:
git-send-email: use git credential to obtain password
Git.pm: add interface for git credential command
Git.pm: allow pipes to be closed prior to calling command_close_bidi_pipe
Git.pm: refactor command_close_bidi_pipe to use _cmd_close
Git.pm: fix example in command_close_bidi_pipe documentation
Git.pm: allow command_close_bidi_pipe to be called as method

1  2 
perl/Git.pm
diff --combined perl/Git.pm
index 57a17160f9decb7879b8d6cba741ddb6d593be47,377f7bafb779aeb7228419048d3f746179eda841..96cac39a4c8ebc0ce4e111271429fdf68b03bf97
@@@ -59,7 -59,7 +59,8 @@@ require Exporter
                  command_bidi_pipe command_close_bidi_pipe
                  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);
  
  
@@@ -103,7 -103,6 +104,7 @@@ use Error qw(:try)
  use Cwd qw(abs_path cwd);
  use IPC::Open2 qw(open2);
  use Fcntl qw(SEEK_SET SEEK_CUR);
 +use Time::Local qw(timegm);
  }
  
  
@@@ -269,13 -268,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;
@@@ -315,7 -314,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;
@@@ -383,7 -382,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... ] )
@@@ -420,7 -419,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);
  
@@@ -428,23 -427,26 +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);
        }
@@@ -513,27 -515,6 +517,27 @@@ C<git --html-path>). Useful mostly onl
  
  sub html_path { command_oneline('--html-path') }
  
 +
 +=item get_tz_offset ( TIME )
 +
 +Return the time zone offset from GMT in the form +/-HHMM where HH is
 +the number of hours from GMT and MM is the number of minutes.  This is
 +the equivalent of what strftime("%z", ...) would provide on a GNU
 +platform.
 +
 +If TIME is not supplied, the current local time is used.
 +
 +=cut
 +
 +sub get_tz_offset {
 +      # some systmes don't handle or mishandle %z, so be creative.
 +      my $t = shift || time;
 +      my $gm = timegm(localtime($t));
 +      my $sign = qw( + + - )[ $gm <=> $t ];
 +      return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
 +}
 +
 +
  =item prompt ( PROMPT , ISPASSWORD  )
  
  Query user C<PROMPT> and return answer from user.
@@@ -965,22 -946,20 +969,22 @@@ sub cat_blob 
        my $size = $1;
  
        my $blob;
 -      my $bytesRead = 0;
 +      my $bytesLeft = $size;
  
        while (1) {
 -              my $bytesLeft = $size - $bytesRead;
                last unless $bytesLeft;
  
                my $bytesToRead = $bytesLeft < 1024 ? $bytesLeft : 1024;
 -              my $read = read($in, $blob, $bytesToRead, $bytesRead);
 +              my $read = read($in, $blob, $bytesToRead);
                unless (defined($read)) {
                        $self->_close_cat_blob();
                        throw Error::Simple("in pipe went bad");
                }
 -
 -              $bytesRead += $read;
 +              unless (print $fh $blob) {
 +                      $self->_close_cat_blob();
 +                      throw Error::Simple("couldn't write to passed in filehandle");
 +              }
 +              $bytesLeft -= $read;
        }
  
        # Skip past the trailing newline.
                throw Error::Simple("didn't find newline after blob");
        }
  
 -      unless (print $fh $blob) {
 -              $self->_close_cat_blob();
 -              throw Error::Simple("couldn't write to passed in filehandle");
 -      }
 -
        return $size;
  }
  
@@@ -1020,6 -1004,156 +1024,156 @@@ 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);
@@@ -1375,9 -1509,11 +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) {