@@ -59,6 +59,7 @@ require Exporter;
5959 command_bidi_pipe command_close_bidi_pipe
6060 version exec_path html_path hash_object git_cmd_try
6161 remote_refs prompt
62+ credential credential_read credential_write
6263 temp_acquire temp_release temp_reset temp_path) ;
6364
6465
@@ -1003,6 +1004,156 @@ sub _close_cat_blob {
10031004}
10041005
10051006
1007+ =item credential_read( FILEHANDLE )
1008+
1009+ Reads credential key-value pairs from C<FILEHANDLE > . Reading stops at EOF or
1010+ when an empty line is encountered. Each line must be of the form C<key=value >
1011+ with a non-empty key. Function returns hash with all read values. Any white
1012+ space (other than new-line character) is preserved.
1013+
1014+ =cut
1015+
1016+ sub credential_read {
1017+ my ($self , $reader ) = _maybe_self(@_ );
1018+ my %credential ;
1019+ while (<$reader >) {
1020+ chomp ;
1021+ if ($_ eq ' ' ) {
1022+ last ;
1023+ } elsif (!/^([^=]+)=(.*)$/ ) {
1024+ throw Error::Simple(" unable to parse git credential data:\n $_ " );
1025+ }
1026+ $credential {$1 } = $2 ;
1027+ }
1028+ return %credential ;
1029+ }
1030+
1031+ =item credential_write( FILEHANDLE, CREDENTIAL_HASHREF )
1032+
1033+ Writes credential key-value pairs from hash referenced by
1034+ C<CREDENTIAL_HASHREF > to C<FILEHANDLE > . Keys and values cannot contain
1035+ new-lines or NUL bytes characters, and key cannot contain equal signs nor be
1036+ empty (if they do Error::Simple is thrown). Any white space is preserved. If
1037+ value for a key is C<undef > , it will be skipped.
1038+
1039+ If C<'url' > key exists it will be written first. (All the other key-value
1040+ pairs are written in sorted order but you should not depend on that). Once
1041+ all lines are written, an empty line is printed.
1042+
1043+ =cut
1044+
1045+ sub credential_write {
1046+ my ($self , $writer , $credential ) = _maybe_self(@_ );
1047+ my ($key , $value );
1048+
1049+ # Check if $credential is valid prior to writing anything
1050+ while (($key , $value ) = each %$credential ) {
1051+ if (!defined $key || !length $key ) {
1052+ throw Error::Simple(" credential key empty or undefined" );
1053+ } elsif ($key =~ / [=\n\0 ]/ ) {
1054+ throw Error::Simple(" credential key contains invalid characters: $key " );
1055+ } elsif (defined $value && $value =~ / [\n\0 ]/ ) {
1056+ throw Error::Simple(" credential value for key=$key contains invalid characters: $value " );
1057+ }
1058+ }
1059+
1060+ for $key (sort {
1061+ # url overwrites other fields, so it must come first
1062+ return -1 if $a eq ' url' ;
1063+ return 1 if $b eq ' url' ;
1064+ return $a cmp $b ;
1065+ } keys %$credential ) {
1066+ if (defined $credential -> {$key }) {
1067+ print $writer $key , ' =' , $credential -> {$key }, " \n " ;
1068+ }
1069+ }
1070+ print $writer " \n " ;
1071+ }
1072+
1073+ sub _credential_run {
1074+ my ($self , $credential , $op ) = _maybe_self(@_ );
1075+ my ($pid , $reader , $writer , $ctx ) = command_bidi_pipe(' credential' , $op );
1076+
1077+ credential_write $writer , $credential ;
1078+ close $writer ;
1079+
1080+ if ($op eq " fill" ) {
1081+ %$credential = credential_read $reader ;
1082+ }
1083+ if (<$reader >) {
1084+ throw Error::Simple(" unexpected output from git credential $op response:\n $_ \n " );
1085+ }
1086+
1087+ command_close_bidi_pipe($pid , $reader , undef , $ctx );
1088+ }
1089+
1090+ =item credential( CREDENTIAL_HASHREF [, OPERATION ] )
1091+
1092+ =item credential( CREDENTIAL_HASHREF, CODE )
1093+
1094+ Executes C<git credential > for a given set of credentials and specified
1095+ operation. In both forms C<CREDENTIAL_HASHREF > needs to be a reference to
1096+ a hash which stores credentials. Under certain conditions the hash can
1097+ change.
1098+
1099+ In the first form, C<OPERATION > can be C<'fill' > , C<'approve' > or C<'reject' > ,
1100+ and function will execute corresponding C<git credential > sub-command. If
1101+ it's omitted C<'fill' > is assumed. In case of C<'fill' > the values stored in
1102+ C<CREDENTIAL_HASHREF > will be changed to the ones returned by the C<git
1103+ credential fill> command. The usual usage would look something like:
1104+
1105+ my %cred = (
1106+ 'protocol' => 'https',
1107+ 'host' => 'example.com',
1108+ 'username' => 'bob'
1109+ );
1110+ Git::credential \%cred;
1111+ if (try_to_authenticate($cred{'username'}, $cred{'password'})) {
1112+ Git::credential \%cred, 'approve';
1113+ ... do more stuff ...
1114+ } else {
1115+ Git::credential \%cred, 'reject';
1116+ }
1117+
1118+ In the second form, C<CODE > needs to be a reference to a subroutine. The
1119+ function will execute C<git credential fill > to fill the provided credential
1120+ hash, then call C<CODE > with C<CREDENTIAL_HASHREF > as the sole argument. If
1121+ C<CODE > 's return value is defined, the function will execute C<git credential
1122+ approve> (if return value yields true) or C<git credential reject > (if return
1123+ value is false). If the return value is undef, nothing at all is executed;
1124+ this is useful, for example, if the credential could neither be verified nor
1125+ rejected due to an unrelated network error. The return value is the same as
1126+ what C<CODE > returns. With this form, the usage might look as follows:
1127+
1128+ if (Git::credential {
1129+ 'protocol' => 'https',
1130+ 'host' => 'example.com',
1131+ 'username' => 'bob'
1132+ }, sub {
1133+ my $cred = shift;
1134+ return !!try_to_authenticate($cred->{'username'},
1135+ $cred->{'password'});
1136+ }) {
1137+ ... do more stuff ...
1138+ }
1139+
1140+ =cut
1141+
1142+ sub credential {
1143+ my ($self , $credential , $op_or_code ) = (_maybe_self(@_ ), ' fill' );
1144+
1145+ if (' CODE' eq ref $op_or_code ) {
1146+ _credential_run $credential , ' fill' ;
1147+ my $ret = $op_or_code -> ($credential );
1148+ if (defined $ret ) {
1149+ _credential_run $credential , $ret ? ' approve' : ' reject' ;
1150+ }
1151+ return $ret ;
1152+ } else {
1153+ _credential_run $credential , $op_or_code ;
1154+ }
1155+ }
1156+
10061157{ # %TEMP_* Lexical Context
10071158
10081159my (%TEMP_FILEMAP , %TEMP_FILES );
0 commit comments