@@ -60,6 +60,7 @@ require Exporter;
6060 version exec_path html_path hash_object git_cmd_try
6161 remote_refs prompt
6262 get_tz_offset
63+ credential credential_read credential_write
6364 temp_acquire temp_release temp_reset temp_path) ;
6465
6566
@@ -269,13 +270,13 @@ sub command {
269270
270271 if (not defined wantarray ) {
271272 # Nothing to pepper the possible exception with.
272- _cmd_close($fh , $ctx );
273+ _cmd_close($ctx , $fh );
273274
274275 } elsif (not wantarray ) {
275276 local $/ ;
276277 my $text = <$fh >;
277278 try {
278- _cmd_close($fh , $ctx );
279+ _cmd_close($ctx , $fh );
279280 } catch Git::Error::Command with {
280281 # Pepper with the output:
281282 my $E = shift ;
@@ -288,7 +289,7 @@ sub command {
288289 my @lines = <$fh >;
289290 defined and chomp for @lines ;
290291 try {
291- _cmd_close($fh , $ctx );
292+ _cmd_close($ctx , $fh );
292293 } catch Git::Error::Command with {
293294 my $E = shift ;
294295 $E -> {' -outputref' } = \@lines ;
@@ -315,7 +316,7 @@ sub command_oneline {
315316 my $line = <$fh >;
316317 defined $line and chomp $line ;
317318 try {
318- _cmd_close($fh , $ctx );
319+ _cmd_close($ctx , $fh );
319320 } catch Git::Error::Command with {
320321 # Pepper with the output:
321322 my $E = shift ;
@@ -383,7 +384,7 @@ have more complicated structure.
383384sub command_close_pipe {
384385 my ($self , $fh , $ctx ) = _maybe_self(@_ );
385386 $ctx ||= ' <unknown>' ;
386- _cmd_close($fh , $ctx );
387+ _cmd_close($ctx , $fh );
387388}
388389
389390=item command_bidi_pipe ( COMMAND [, ARGUMENTS... ] )
@@ -420,31 +421,34 @@ and it is the fourth value returned by C<command_bidi_pipe()>. The call idiom
420421is:
421422
422423 my ($pid, $in, $out, $ctx) = $r->command_bidi_pipe('cat-file --batch-check');
423- print "000000000\n" $out ;
424+ print $out "000000000\n";
424425 while (<$in>) { ... }
425426 $r->command_close_bidi_pipe($pid, $in, $out, $ctx);
426427
427428Note that you should not rely on whatever actually is in C<CTX > ;
428429currently it is simply the command name but in future the context might
429430have more complicated structure.
430431
432+ C<PIPE_IN > and C<PIPE_OUT > may be C<undef > if they have been closed prior to
433+ calling this function. This may be useful in a query-response type of
434+ commands where caller first writes a query and later reads response, eg:
435+
436+ my ($pid, $in, $out, $ctx) = $r->command_bidi_pipe('cat-file --batch-check');
437+ print $out "000000000\n";
438+ close $out;
439+ while (<$in>) { ... }
440+ $r->command_close_bidi_pipe($pid, $in, undef, $ctx);
441+
442+ This idiom may prevent potential dead locks caused by data sent to the output
443+ pipe not being flushed and thus not reaching the executed command.
444+
431445=cut
432446
433447sub command_close_bidi_pipe {
434448 local $? ;
435- my ($pid , $in , $out , $ctx ) = @_ ;
436- foreach my $fh ($in , $out ) {
437- unless (close $fh ) {
438- if ($! ) {
439- carp " error closing pipe: $! " ;
440- } elsif ($? >> 8) {
441- throw Git::Error::Command($ctx , $? >>8);
442- }
443- }
444- }
445-
449+ my ($self , $pid , $in , $out , $ctx ) = _maybe_self(@_ );
450+ _cmd_close($ctx , (grep { defined } ($in , $out )));
446451 waitpid $pid , 0;
447-
448452 if ($? >> 8) {
449453 throw Git::Error::Command($ctx , $? >>8);
450454 }
@@ -1020,6 +1024,156 @@ sub _close_cat_blob {
10201024}
10211025
10221026
1027+ =item credential_read( FILEHANDLE )
1028+
1029+ Reads credential key-value pairs from C<FILEHANDLE > . Reading stops at EOF or
1030+ when an empty line is encountered. Each line must be of the form C<key=value >
1031+ with a non-empty key. Function returns hash with all read values. Any white
1032+ space (other than new-line character) is preserved.
1033+
1034+ =cut
1035+
1036+ sub credential_read {
1037+ my ($self , $reader ) = _maybe_self(@_ );
1038+ my %credential ;
1039+ while (<$reader >) {
1040+ chomp ;
1041+ if ($_ eq ' ' ) {
1042+ last ;
1043+ } elsif (!/^([^=]+)=(.*)$/ ) {
1044+ throw Error::Simple(" unable to parse git credential data:\n $_ " );
1045+ }
1046+ $credential {$1 } = $2 ;
1047+ }
1048+ return %credential ;
1049+ }
1050+
1051+ =item credential_write( FILEHANDLE, CREDENTIAL_HASHREF )
1052+
1053+ Writes credential key-value pairs from hash referenced by
1054+ C<CREDENTIAL_HASHREF > to C<FILEHANDLE > . Keys and values cannot contain
1055+ new-lines or NUL bytes characters, and key cannot contain equal signs nor be
1056+ empty (if they do Error::Simple is thrown). Any white space is preserved. If
1057+ value for a key is C<undef > , it will be skipped.
1058+
1059+ If C<'url' > key exists it will be written first. (All the other key-value
1060+ pairs are written in sorted order but you should not depend on that). Once
1061+ all lines are written, an empty line is printed.
1062+
1063+ =cut
1064+
1065+ sub credential_write {
1066+ my ($self , $writer , $credential ) = _maybe_self(@_ );
1067+ my ($key , $value );
1068+
1069+ # Check if $credential is valid prior to writing anything
1070+ while (($key , $value ) = each %$credential ) {
1071+ if (!defined $key || !length $key ) {
1072+ throw Error::Simple(" credential key empty or undefined" );
1073+ } elsif ($key =~ / [=\n\0 ]/ ) {
1074+ throw Error::Simple(" credential key contains invalid characters: $key " );
1075+ } elsif (defined $value && $value =~ / [\n\0 ]/ ) {
1076+ throw Error::Simple(" credential value for key=$key contains invalid characters: $value " );
1077+ }
1078+ }
1079+
1080+ for $key (sort {
1081+ # url overwrites other fields, so it must come first
1082+ return -1 if $a eq ' url' ;
1083+ return 1 if $b eq ' url' ;
1084+ return $a cmp $b ;
1085+ } keys %$credential ) {
1086+ if (defined $credential -> {$key }) {
1087+ print $writer $key , ' =' , $credential -> {$key }, " \n " ;
1088+ }
1089+ }
1090+ print $writer " \n " ;
1091+ }
1092+
1093+ sub _credential_run {
1094+ my ($self , $credential , $op ) = _maybe_self(@_ );
1095+ my ($pid , $reader , $writer , $ctx ) = command_bidi_pipe(' credential' , $op );
1096+
1097+ credential_write $writer , $credential ;
1098+ close $writer ;
1099+
1100+ if ($op eq " fill" ) {
1101+ %$credential = credential_read $reader ;
1102+ }
1103+ if (<$reader >) {
1104+ throw Error::Simple(" unexpected output from git credential $op response:\n $_ \n " );
1105+ }
1106+
1107+ command_close_bidi_pipe($pid , $reader , undef , $ctx );
1108+ }
1109+
1110+ =item credential( CREDENTIAL_HASHREF [, OPERATION ] )
1111+
1112+ =item credential( CREDENTIAL_HASHREF, CODE )
1113+
1114+ Executes C<git credential > for a given set of credentials and specified
1115+ operation. In both forms C<CREDENTIAL_HASHREF > needs to be a reference to
1116+ a hash which stores credentials. Under certain conditions the hash can
1117+ change.
1118+
1119+ In the first form, C<OPERATION > can be C<'fill' > , C<'approve' > or C<'reject' > ,
1120+ and function will execute corresponding C<git credential > sub-command. If
1121+ it's omitted C<'fill' > is assumed. In case of C<'fill' > the values stored in
1122+ C<CREDENTIAL_HASHREF > will be changed to the ones returned by the C<git
1123+ credential fill> command. The usual usage would look something like:
1124+
1125+ my %cred = (
1126+ 'protocol' => 'https',
1127+ 'host' => 'example.com',
1128+ 'username' => 'bob'
1129+ );
1130+ Git::credential \%cred;
1131+ if (try_to_authenticate($cred{'username'}, $cred{'password'})) {
1132+ Git::credential \%cred, 'approve';
1133+ ... do more stuff ...
1134+ } else {
1135+ Git::credential \%cred, 'reject';
1136+ }
1137+
1138+ In the second form, C<CODE > needs to be a reference to a subroutine. The
1139+ function will execute C<git credential fill > to fill the provided credential
1140+ hash, then call C<CODE > with C<CREDENTIAL_HASHREF > as the sole argument. If
1141+ C<CODE > 's return value is defined, the function will execute C<git credential
1142+ approve> (if return value yields true) or C<git credential reject > (if return
1143+ value is false). If the return value is undef, nothing at all is executed;
1144+ this is useful, for example, if the credential could neither be verified nor
1145+ rejected due to an unrelated network error. The return value is the same as
1146+ what C<CODE > returns. With this form, the usage might look as follows:
1147+
1148+ if (Git::credential {
1149+ 'protocol' => 'https',
1150+ 'host' => 'example.com',
1151+ 'username' => 'bob'
1152+ }, sub {
1153+ my $cred = shift;
1154+ return !!try_to_authenticate($cred->{'username'},
1155+ $cred->{'password'});
1156+ }) {
1157+ ... do more stuff ...
1158+ }
1159+
1160+ =cut
1161+
1162+ sub credential {
1163+ my ($self , $credential , $op_or_code ) = (_maybe_self(@_ ), ' fill' );
1164+
1165+ if (' CODE' eq ref $op_or_code ) {
1166+ _credential_run $credential , ' fill' ;
1167+ my $ret = $op_or_code -> ($credential );
1168+ if (defined $ret ) {
1169+ _credential_run $credential , $ret ? ' approve' : ' reject' ;
1170+ }
1171+ return $ret ;
1172+ } else {
1173+ _credential_run $credential , $op_or_code ;
1174+ }
1175+ }
1176+
10231177{ # %TEMP_* Lexical Context
10241178
10251179my (%TEMP_FILEMAP , %TEMP_FILES );
@@ -1375,9 +1529,11 @@ sub _execv_git_cmd { exec('git', @_); }
13751529
13761530# Close pipe to a subprocess.
13771531sub _cmd_close {
1378- my ($fh , $ctx ) = @_ ;
1379- if (not close $fh ) {
1380- if ($! ) {
1532+ my $ctx = shift @_ ;
1533+ foreach my $fh (@_ ) {
1534+ if (close $fh ) {
1535+ # nop
1536+ } elsif ($! ) {
13811537 # It's just close, no point in fatalities
13821538 carp " error closing pipe: $! " ;
13831539 } elsif ($? >> 8) {
0 commit comments